gitkon commit send-email: discard blank around address in extract_valid_address as well. (689b4d5)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2005-2006 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10proc gitdir {} {
  11    global env
  12    if {[info exists env(GIT_DIR)]} {
  13        return $env(GIT_DIR)
  14    } else {
  15        return [exec git rev-parse --git-dir]
  16    }
  17}
  18
  19# A simple scheduler for compute-intensive stuff.
  20# The aim is to make sure that event handlers for GUI actions can
  21# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  22# run before X event handlers, so reading from a fast source can
  23# make the GUI completely unresponsive.
  24proc run args {
  25    global isonrunq runq
  26
  27    set script $args
  28    if {[info exists isonrunq($script)]} return
  29    if {$runq eq {}} {
  30        after idle dorunq
  31    }
  32    lappend runq [list {} $script]
  33    set isonrunq($script) 1
  34}
  35
  36proc filerun {fd script} {
  37    fileevent $fd readable [list filereadable $fd $script]
  38}
  39
  40proc filereadable {fd script} {
  41    global runq
  42
  43    fileevent $fd readable {}
  44    if {$runq eq {}} {
  45        after idle dorunq
  46    }
  47    lappend runq [list $fd $script]
  48}
  49
  50proc dorunq {} {
  51    global isonrunq runq
  52
  53    set tstart [clock clicks -milliseconds]
  54    set t0 $tstart
  55    while {$runq ne {}} {
  56        set fd [lindex $runq 0 0]
  57        set script [lindex $runq 0 1]
  58        set repeat [eval $script]
  59        set t1 [clock clicks -milliseconds]
  60        set t [expr {$t1 - $t0}]
  61        set runq [lrange $runq 1 end]
  62        if {$repeat ne {} && $repeat} {
  63            if {$fd eq {} || $repeat == 2} {
  64                # script returns 1 if it wants to be readded
  65                # file readers return 2 if they could do more straight away
  66                lappend runq [list $fd $script]
  67            } else {
  68                fileevent $fd readable [list filereadable $fd $script]
  69            }
  70        } elseif {$fd eq {}} {
  71            unset isonrunq($script)
  72        }
  73        set t0 $t1
  74        if {$t1 - $tstart >= 80} break
  75    }
  76    if {$runq ne {}} {
  77        after idle dorunq
  78    }
  79}
  80
  81# Start off a git rev-list process and arrange to read its output
  82proc start_rev_list {view} {
  83    global startmsecs
  84    global commfd leftover tclencoding datemode
  85    global viewargs viewfiles commitidx
  86    global lookingforhead showlocalchanges
  87
  88    set startmsecs [clock clicks -milliseconds]
  89    set commitidx($view) 0
  90    set order "--topo-order"
  91    if {$datemode} {
  92        set order "--date-order"
  93    }
  94    if {[catch {
  95        set fd [open [concat | git log -z --pretty=raw $order --parents \
  96                         --boundary $viewargs($view) "--" $viewfiles($view)] r]
  97    } err]} {
  98        error_popup "Error executing git rev-list: $err"
  99        exit 1
 100    }
 101    set commfd($view) $fd
 102    set leftover($view) {}
 103    set lookingforhead $showlocalchanges
 104    fconfigure $fd -blocking 0 -translation lf
 105    if {$tclencoding != {}} {
 106        fconfigure $fd -encoding $tclencoding
 107    }
 108    filerun $fd [list getcommitlines $fd $view]
 109    nowbusy $view
 110}
 111
 112proc stop_rev_list {} {
 113    global commfd curview
 114
 115    if {![info exists commfd($curview)]} return
 116    set fd $commfd($curview)
 117    catch {
 118        set pid [pid $fd]
 119        exec kill $pid
 120    }
 121    catch {close $fd}
 122    unset commfd($curview)
 123}
 124
 125proc getcommits {} {
 126    global phase canv mainfont curview
 127
 128    set phase getcommits
 129    initlayout
 130    start_rev_list $curview
 131    show_status "Reading commits..."
 132}
 133
 134proc getcommitlines {fd view}  {
 135    global commitlisted
 136    global leftover commfd
 137    global displayorder commitidx commitrow commitdata
 138    global parentlist children curview hlview
 139    global vparentlist vdisporder vcmitlisted
 140
 141    set stuff [read $fd 500000]
 142    if {$stuff == {}} {
 143        if {![eof $fd]} {
 144            return 1
 145        }
 146        global viewname
 147        unset commfd($view)
 148        notbusy $view
 149        # set it blocking so we wait for the process to terminate
 150        fconfigure $fd -blocking 1
 151        if {[catch {close $fd} err]} {
 152            set fv {}
 153            if {$view != $curview} {
 154                set fv " for the \"$viewname($view)\" view"
 155            }
 156            if {[string range $err 0 4] == "usage"} {
 157                set err "Gitk: error reading commits$fv:\
 158                        bad arguments to git rev-list."
 159                if {$viewname($view) eq "Command line"} {
 160                    append err \
 161                        "  (Note: arguments to gitk are passed to git rev-list\
 162                         to allow selection of commits to be displayed.)"
 163                }
 164            } else {
 165                set err "Error reading commits$fv: $err"
 166            }
 167            error_popup $err
 168        }
 169        if {$view == $curview} {
 170            run chewcommits $view
 171        }
 172        return 0
 173    }
 174    set start 0
 175    set gotsome 0
 176    while 1 {
 177        set i [string first "\0" $stuff $start]
 178        if {$i < 0} {
 179            append leftover($view) [string range $stuff $start end]
 180            break
 181        }
 182        if {$start == 0} {
 183            set cmit $leftover($view)
 184            append cmit [string range $stuff 0 [expr {$i - 1}]]
 185            set leftover($view) {}
 186        } else {
 187            set cmit [string range $stuff $start [expr {$i - 1}]]
 188        }
 189        set start [expr {$i + 1}]
 190        set j [string first "\n" $cmit]
 191        set ok 0
 192        set listed 1
 193        if {$j >= 0 && [string match "commit *" $cmit]} {
 194            set ids [string range $cmit 7 [expr {$j - 1}]]
 195            if {[string match {[-<>]*} $ids]} {
 196                switch -- [string index $ids 0] {
 197                    "-" {set listed 0}
 198                    "<" {set listed 2}
 199                    ">" {set listed 3}
 200                }
 201                set ids [string range $ids 1 end]
 202            }
 203            set ok 1
 204            foreach id $ids {
 205                if {[string length $id] != 40} {
 206                    set ok 0
 207                    break
 208                }
 209            }
 210        }
 211        if {!$ok} {
 212            set shortcmit $cmit
 213            if {[string length $shortcmit] > 80} {
 214                set shortcmit "[string range $shortcmit 0 80]..."
 215            }
 216            error_popup "Can't parse git log output: {$shortcmit}"
 217            exit 1
 218        }
 219        set id [lindex $ids 0]
 220        if {$listed} {
 221            set olds [lrange $ids 1 end]
 222            set i 0
 223            foreach p $olds {
 224                if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 225                    lappend children($view,$p) $id
 226                }
 227                incr i
 228            }
 229        } else {
 230            set olds {}
 231        }
 232        if {![info exists children($view,$id)]} {
 233            set children($view,$id) {}
 234        }
 235        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 236        set commitrow($view,$id) $commitidx($view)
 237        incr commitidx($view)
 238        if {$view == $curview} {
 239            lappend parentlist $olds
 240            lappend displayorder $id
 241            lappend commitlisted $listed
 242        } else {
 243            lappend vparentlist($view) $olds
 244            lappend vdisporder($view) $id
 245            lappend vcmitlisted($view) $listed
 246        }
 247        set gotsome 1
 248    }
 249    if {$gotsome} {
 250        run chewcommits $view
 251    }
 252    return 2
 253}
 254
 255proc chewcommits {view} {
 256    global curview hlview commfd
 257    global selectedline pending_select
 258
 259    set more 0
 260    if {$view == $curview} {
 261        set allread [expr {![info exists commfd($view)]}]
 262        set tlimit [expr {[clock clicks -milliseconds] + 50}]
 263        set more [layoutmore $tlimit $allread]
 264        if {$allread && !$more} {
 265            global displayorder nullid commitidx phase
 266            global numcommits startmsecs
 267
 268            if {[info exists pending_select]} {
 269                set row [expr {[lindex $displayorder 0] eq $nullid}]
 270                selectline $row 1
 271            }
 272            if {$commitidx($curview) > 0} {
 273                #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
 274                #puts "overall $ms ms for $numcommits commits"
 275            } else {
 276                show_status "No commits selected"
 277            }
 278            notbusy layout
 279            set phase {}
 280        }
 281    }
 282    if {[info exists hlview] && $view == $hlview} {
 283        vhighlightmore
 284    }
 285    return $more
 286}
 287
 288proc readcommit {id} {
 289    if {[catch {set contents [exec git cat-file commit $id]}]} return
 290    parsecommit $id $contents 0
 291}
 292
 293proc updatecommits {} {
 294    global viewdata curview phase displayorder
 295    global children commitrow selectedline thickerline
 296
 297    if {$phase ne {}} {
 298        stop_rev_list
 299        set phase {}
 300    }
 301    set n $curview
 302    foreach id $displayorder {
 303        catch {unset children($n,$id)}
 304        catch {unset commitrow($n,$id)}
 305    }
 306    set curview -1
 307    catch {unset selectedline}
 308    catch {unset thickerline}
 309    catch {unset viewdata($n)}
 310    readrefs
 311    changedrefs
 312    regetallcommits
 313    showview $n
 314}
 315
 316proc parsecommit {id contents listed} {
 317    global commitinfo cdate
 318
 319    set inhdr 1
 320    set comment {}
 321    set headline {}
 322    set auname {}
 323    set audate {}
 324    set comname {}
 325    set comdate {}
 326    set hdrend [string first "\n\n" $contents]
 327    if {$hdrend < 0} {
 328        # should never happen...
 329        set hdrend [string length $contents]
 330    }
 331    set header [string range $contents 0 [expr {$hdrend - 1}]]
 332    set comment [string range $contents [expr {$hdrend + 2}] end]
 333    foreach line [split $header "\n"] {
 334        set tag [lindex $line 0]
 335        if {$tag == "author"} {
 336            set audate [lindex $line end-1]
 337            set auname [lrange $line 1 end-2]
 338        } elseif {$tag == "committer"} {
 339            set comdate [lindex $line end-1]
 340            set comname [lrange $line 1 end-2]
 341        }
 342    }
 343    set headline {}
 344    # take the first non-blank line of the comment as the headline
 345    set headline [string trimleft $comment]
 346    set i [string first "\n" $headline]
 347    if {$i >= 0} {
 348        set headline [string range $headline 0 $i]
 349    }
 350    set headline [string trimright $headline]
 351    set i [string first "\r" $headline]
 352    if {$i >= 0} {
 353        set headline [string trimright [string range $headline 0 $i]]
 354    }
 355    if {!$listed} {
 356        # git rev-list indents the comment by 4 spaces;
 357        # if we got this via git cat-file, add the indentation
 358        set newcomment {}
 359        foreach line [split $comment "\n"] {
 360            append newcomment "    "
 361            append newcomment $line
 362            append newcomment "\n"
 363        }
 364        set comment $newcomment
 365    }
 366    if {$comdate != {}} {
 367        set cdate($id) $comdate
 368    }
 369    set commitinfo($id) [list $headline $auname $audate \
 370                             $comname $comdate $comment]
 371}
 372
 373proc getcommit {id} {
 374    global commitdata commitinfo
 375
 376    if {[info exists commitdata($id)]} {
 377        parsecommit $id $commitdata($id) 1
 378    } else {
 379        readcommit $id
 380        if {![info exists commitinfo($id)]} {
 381            set commitinfo($id) {"No commit information available"}
 382        }
 383    }
 384    return 1
 385}
 386
 387proc readrefs {} {
 388    global tagids idtags headids idheads tagobjid
 389    global otherrefids idotherrefs mainhead mainheadid
 390
 391    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 392        catch {unset $v}
 393    }
 394    set refd [open [list | git show-ref -d] r]
 395    while {[gets $refd line] >= 0} {
 396        if {[string index $line 40] ne " "} continue
 397        set id [string range $line 0 39]
 398        set ref [string range $line 41 end]
 399        if {![string match "refs/*" $ref]} continue
 400        set name [string range $ref 5 end]
 401        if {[string match "remotes/*" $name]} {
 402            if {![string match "*/HEAD" $name]} {
 403                set headids($name) $id
 404                lappend idheads($id) $name
 405            }
 406        } elseif {[string match "heads/*" $name]} {
 407            set name [string range $name 6 end]
 408            set headids($name) $id
 409            lappend idheads($id) $name
 410        } elseif {[string match "tags/*" $name]} {
 411            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
 412            # which is what we want since the former is the commit ID
 413            set name [string range $name 5 end]
 414            if {[string match "*^{}" $name]} {
 415                set name [string range $name 0 end-3]
 416            } else {
 417                set tagobjid($name) $id
 418            }
 419            set tagids($name) $id
 420            lappend idtags($id) $name
 421        } else {
 422            set otherrefids($name) $id
 423            lappend idotherrefs($id) $name
 424        }
 425    }
 426    close $refd
 427    set mainhead {}
 428    set mainheadid {}
 429    catch {
 430        set thehead [exec git symbolic-ref HEAD]
 431        if {[string match "refs/heads/*" $thehead]} {
 432            set mainhead [string range $thehead 11 end]
 433            if {[info exists headids($mainhead)]} {
 434                set mainheadid $headids($mainhead)
 435            }
 436        }
 437    }
 438}
 439
 440# update things for a head moved to a child of its previous location
 441proc movehead {id name} {
 442    global headids idheads
 443
 444    removehead $headids($name) $name
 445    set headids($name) $id
 446    lappend idheads($id) $name
 447}
 448
 449# update things when a head has been removed
 450proc removehead {id name} {
 451    global headids idheads
 452
 453    if {$idheads($id) eq $name} {
 454        unset idheads($id)
 455    } else {
 456        set i [lsearch -exact $idheads($id) $name]
 457        if {$i >= 0} {
 458            set idheads($id) [lreplace $idheads($id) $i $i]
 459        }
 460    }
 461    unset headids($name)
 462}
 463
 464proc show_error {w top msg} {
 465    message $w.m -text $msg -justify center -aspect 400
 466    pack $w.m -side top -fill x -padx 20 -pady 20
 467    button $w.ok -text OK -command "destroy $top"
 468    pack $w.ok -side bottom -fill x
 469    bind $top <Visibility> "grab $top; focus $top"
 470    bind $top <Key-Return> "destroy $top"
 471    tkwait window $top
 472}
 473
 474proc error_popup msg {
 475    set w .error
 476    toplevel $w
 477    wm transient $w .
 478    show_error $w $w $msg
 479}
 480
 481proc confirm_popup msg {
 482    global confirm_ok
 483    set confirm_ok 0
 484    set w .confirm
 485    toplevel $w
 486    wm transient $w .
 487    message $w.m -text $msg -justify center -aspect 400
 488    pack $w.m -side top -fill x -padx 20 -pady 20
 489    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
 490    pack $w.ok -side left -fill x
 491    button $w.cancel -text Cancel -command "destroy $w"
 492    pack $w.cancel -side right -fill x
 493    bind $w <Visibility> "grab $w; focus $w"
 494    tkwait window $w
 495    return $confirm_ok
 496}
 497
 498proc makewindow {} {
 499    global canv canv2 canv3 linespc charspc ctext cflist
 500    global textfont mainfont uifont tabstop
 501    global findtype findtypemenu findloc findstring fstring geometry
 502    global entries sha1entry sha1string sha1but
 503    global maincursor textcursor curtextcursor
 504    global rowctxmenu fakerowmenu mergemax wrapcomment
 505    global highlight_files gdttype
 506    global searchstring sstring
 507    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
 508    global headctxmenu
 509
 510    menu .bar
 511    .bar add cascade -label "File" -menu .bar.file
 512    .bar configure -font $uifont
 513    menu .bar.file
 514    .bar.file add command -label "Update" -command updatecommits
 515    .bar.file add command -label "Reread references" -command rereadrefs
 516    .bar.file add command -label "Quit" -command doquit
 517    .bar.file configure -font $uifont
 518    menu .bar.edit
 519    .bar add cascade -label "Edit" -menu .bar.edit
 520    .bar.edit add command -label "Preferences" -command doprefs
 521    .bar.edit configure -font $uifont
 522
 523    menu .bar.view -font $uifont
 524    .bar add cascade -label "View" -menu .bar.view
 525    .bar.view add command -label "New view..." -command {newview 0}
 526    .bar.view add command -label "Edit view..." -command editview \
 527        -state disabled
 528    .bar.view add command -label "Delete view" -command delview -state disabled
 529    .bar.view add separator
 530    .bar.view add radiobutton -label "All files" -command {showview 0} \
 531        -variable selectedview -value 0
 532
 533    menu .bar.help
 534    .bar add cascade -label "Help" -menu .bar.help
 535    .bar.help add command -label "About gitk" -command about
 536    .bar.help add command -label "Key bindings" -command keys
 537    .bar.help configure -font $uifont
 538    . configure -menu .bar
 539
 540    # the gui has upper and lower half, parts of a paned window.
 541    panedwindow .ctop -orient vertical
 542
 543    # possibly use assumed geometry
 544    if {![info exists geometry(pwsash0)]} {
 545        set geometry(topheight) [expr {15 * $linespc}]
 546        set geometry(topwidth) [expr {80 * $charspc}]
 547        set geometry(botheight) [expr {15 * $linespc}]
 548        set geometry(botwidth) [expr {50 * $charspc}]
 549        set geometry(pwsash0) "[expr {40 * $charspc}] 2"
 550        set geometry(pwsash1) "[expr {60 * $charspc}] 2"
 551    }
 552
 553    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
 554    frame .tf -height $geometry(topheight) -width $geometry(topwidth)
 555    frame .tf.histframe
 556    panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
 557
 558    # create three canvases
 559    set cscroll .tf.histframe.csb
 560    set canv .tf.histframe.pwclist.canv
 561    canvas $canv \
 562        -selectbackground $selectbgcolor \
 563        -background $bgcolor -bd 0 \
 564        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 565    .tf.histframe.pwclist add $canv
 566    set canv2 .tf.histframe.pwclist.canv2
 567    canvas $canv2 \
 568        -selectbackground $selectbgcolor \
 569        -background $bgcolor -bd 0 -yscrollincr $linespc
 570    .tf.histframe.pwclist add $canv2
 571    set canv3 .tf.histframe.pwclist.canv3
 572    canvas $canv3 \
 573        -selectbackground $selectbgcolor \
 574        -background $bgcolor -bd 0 -yscrollincr $linespc
 575    .tf.histframe.pwclist add $canv3
 576    eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
 577    eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
 578
 579    # a scroll bar to rule them
 580    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 581    pack $cscroll -side right -fill y
 582    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
 583    lappend bglist $canv $canv2 $canv3
 584    pack .tf.histframe.pwclist -fill both -expand 1 -side left
 585
 586    # we have two button bars at bottom of top frame. Bar 1
 587    frame .tf.bar
 588    frame .tf.lbar -height 15
 589
 590    set sha1entry .tf.bar.sha1
 591    set entries $sha1entry
 592    set sha1but .tf.bar.sha1label
 593    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 594        -command gotocommit -width 8 -font $uifont
 595    $sha1but conf -disabledforeground [$sha1but cget -foreground]
 596    pack .tf.bar.sha1label -side left
 597    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 598    trace add variable sha1string write sha1change
 599    pack $sha1entry -side left -pady 2
 600
 601    image create bitmap bm-left -data {
 602        #define left_width 16
 603        #define left_height 16
 604        static unsigned char left_bits[] = {
 605        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 606        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 607        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 608    }
 609    image create bitmap bm-right -data {
 610        #define right_width 16
 611        #define right_height 16
 612        static unsigned char right_bits[] = {
 613        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 614        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 615        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 616    }
 617    button .tf.bar.leftbut -image bm-left -command goback \
 618        -state disabled -width 26
 619    pack .tf.bar.leftbut -side left -fill y
 620    button .tf.bar.rightbut -image bm-right -command goforw \
 621        -state disabled -width 26
 622    pack .tf.bar.rightbut -side left -fill y
 623
 624    button .tf.bar.findbut -text "Find" -command dofind -font $uifont
 625    pack .tf.bar.findbut -side left
 626    set findstring {}
 627    set fstring .tf.bar.findstring
 628    lappend entries $fstring
 629    entry $fstring -width 30 -font $textfont -textvariable findstring
 630    trace add variable findstring write find_change
 631    pack $fstring -side left -expand 1 -fill x -in .tf.bar
 632    set findtype Exact
 633    set findtypemenu [tk_optionMenu .tf.bar.findtype \
 634                      findtype Exact IgnCase Regexp]
 635    trace add variable findtype write find_change
 636    .tf.bar.findtype configure -font $uifont
 637    .tf.bar.findtype.menu configure -font $uifont
 638    set findloc "All fields"
 639    tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
 640        Comments Author Committer
 641    trace add variable findloc write find_change
 642    .tf.bar.findloc configure -font $uifont
 643    .tf.bar.findloc.menu configure -font $uifont
 644    pack .tf.bar.findloc -side right
 645    pack .tf.bar.findtype -side right
 646
 647    # build up the bottom bar of upper window
 648    label .tf.lbar.flabel -text "Highlight:  Commits " \
 649    -font $uifont
 650    pack .tf.lbar.flabel -side left -fill y
 651    set gdttype "touching paths:"
 652    set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
 653        "adding/removing string:"]
 654    trace add variable gdttype write hfiles_change
 655    $gm conf -font $uifont
 656    .tf.lbar.gdttype conf -font $uifont
 657    pack .tf.lbar.gdttype -side left -fill y
 658    entry .tf.lbar.fent -width 25 -font $textfont \
 659        -textvariable highlight_files
 660    trace add variable highlight_files write hfiles_change
 661    lappend entries .tf.lbar.fent
 662    pack .tf.lbar.fent -side left -fill x -expand 1
 663    label .tf.lbar.vlabel -text " OR in view" -font $uifont
 664    pack .tf.lbar.vlabel -side left -fill y
 665    global viewhlmenu selectedhlview
 666    set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
 667    $viewhlmenu entryconf None -command delvhighlight
 668    $viewhlmenu conf -font $uifont
 669    .tf.lbar.vhl conf -font $uifont
 670    pack .tf.lbar.vhl -side left -fill y
 671    label .tf.lbar.rlabel -text " OR " -font $uifont
 672    pack .tf.lbar.rlabel -side left -fill y
 673    global highlight_related
 674    set m [tk_optionMenu .tf.lbar.relm highlight_related None \
 675        "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
 676    $m conf -font $uifont
 677    .tf.lbar.relm conf -font $uifont
 678    trace add variable highlight_related write vrel_change
 679    pack .tf.lbar.relm -side left -fill y
 680
 681    # Finish putting the upper half of the viewer together
 682    pack .tf.lbar -in .tf -side bottom -fill x
 683    pack .tf.bar -in .tf -side bottom -fill x
 684    pack .tf.histframe -fill both -side top -expand 1
 685    .ctop add .tf
 686    .ctop paneconfigure .tf -height $geometry(topheight)
 687    .ctop paneconfigure .tf -width $geometry(topwidth)
 688
 689    # now build up the bottom
 690    panedwindow .pwbottom -orient horizontal
 691
 692    # lower left, a text box over search bar, scroll bar to the right
 693    # if we know window height, then that will set the lower text height, otherwise
 694    # we set lower text height which will drive window height
 695    if {[info exists geometry(main)]} {
 696        frame .bleft -width $geometry(botwidth)
 697    } else {
 698        frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
 699    }
 700    frame .bleft.top
 701    frame .bleft.mid
 702
 703    button .bleft.top.search -text "Search" -command dosearch \
 704        -font $uifont
 705    pack .bleft.top.search -side left -padx 5
 706    set sstring .bleft.top.sstring
 707    entry $sstring -width 20 -font $textfont -textvariable searchstring
 708    lappend entries $sstring
 709    trace add variable searchstring write incrsearch
 710    pack $sstring -side left -expand 1 -fill x
 711    radiobutton .bleft.mid.diff -text "Diff" \
 712        -command changediffdisp -variable diffelide -value {0 0}
 713    radiobutton .bleft.mid.old -text "Old version" \
 714        -command changediffdisp -variable diffelide -value {0 1}
 715    radiobutton .bleft.mid.new -text "New version" \
 716        -command changediffdisp -variable diffelide -value {1 0}
 717    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
 718    set ctext .bleft.ctext
 719    text $ctext -background $bgcolor -foreground $fgcolor \
 720        -tabs "[expr {$tabstop * $charspc}]" \
 721        -state disabled -font $textfont \
 722        -yscrollcommand scrolltext -wrap none
 723    scrollbar .bleft.sb -command "$ctext yview"
 724    pack .bleft.top -side top -fill x
 725    pack .bleft.mid -side top -fill x
 726    pack .bleft.sb -side right -fill y
 727    pack $ctext -side left -fill both -expand 1
 728    lappend bglist $ctext
 729    lappend fglist $ctext
 730
 731    $ctext tag conf comment -wrap $wrapcomment
 732    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 733    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 734    $ctext tag conf d0 -fore [lindex $diffcolors 0]
 735    $ctext tag conf d1 -fore [lindex $diffcolors 1]
 736    $ctext tag conf m0 -fore red
 737    $ctext tag conf m1 -fore blue
 738    $ctext tag conf m2 -fore green
 739    $ctext tag conf m3 -fore purple
 740    $ctext tag conf m4 -fore brown
 741    $ctext tag conf m5 -fore "#009090"
 742    $ctext tag conf m6 -fore magenta
 743    $ctext tag conf m7 -fore "#808000"
 744    $ctext tag conf m8 -fore "#009000"
 745    $ctext tag conf m9 -fore "#ff0080"
 746    $ctext tag conf m10 -fore cyan
 747    $ctext tag conf m11 -fore "#b07070"
 748    $ctext tag conf m12 -fore "#70b0f0"
 749    $ctext tag conf m13 -fore "#70f0b0"
 750    $ctext tag conf m14 -fore "#f0b070"
 751    $ctext tag conf m15 -fore "#ff70b0"
 752    $ctext tag conf mmax -fore darkgrey
 753    set mergemax 16
 754    $ctext tag conf mresult -font [concat $textfont bold]
 755    $ctext tag conf msep -font [concat $textfont bold]
 756    $ctext tag conf found -back yellow
 757
 758    .pwbottom add .bleft
 759    .pwbottom paneconfigure .bleft -width $geometry(botwidth)
 760
 761    # lower right
 762    frame .bright
 763    frame .bright.mode
 764    radiobutton .bright.mode.patch -text "Patch" \
 765        -command reselectline -variable cmitmode -value "patch"
 766    .bright.mode.patch configure -font $uifont
 767    radiobutton .bright.mode.tree -text "Tree" \
 768        -command reselectline -variable cmitmode -value "tree"
 769    .bright.mode.tree configure -font $uifont
 770    grid .bright.mode.patch .bright.mode.tree -sticky ew
 771    pack .bright.mode -side top -fill x
 772    set cflist .bright.cfiles
 773    set indent [font measure $mainfont "nn"]
 774    text $cflist \
 775        -selectbackground $selectbgcolor \
 776        -background $bgcolor -foreground $fgcolor \
 777        -font $mainfont \
 778        -tabs [list $indent [expr {2 * $indent}]] \
 779        -yscrollcommand ".bright.sb set" \
 780        -cursor [. cget -cursor] \
 781        -spacing1 1 -spacing3 1
 782    lappend bglist $cflist
 783    lappend fglist $cflist
 784    scrollbar .bright.sb -command "$cflist yview"
 785    pack .bright.sb -side right -fill y
 786    pack $cflist -side left -fill both -expand 1
 787    $cflist tag configure highlight \
 788        -background [$cflist cget -selectbackground]
 789    $cflist tag configure bold -font [concat $mainfont bold]
 790
 791    .pwbottom add .bright
 792    .ctop add .pwbottom
 793
 794    # restore window position if known
 795    if {[info exists geometry(main)]} {
 796        wm geometry . "$geometry(main)"
 797    }
 798
 799    bind .pwbottom <Configure> {resizecdetpanes %W %w}
 800    pack .ctop -fill both -expand 1
 801    bindall <1> {selcanvline %W %x %y}
 802    #bindall <B1-Motion> {selcanvline %W %x %y}
 803    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 804    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 805    bindall <2> "canvscan mark %W %x %y"
 806    bindall <B2-Motion> "canvscan dragto %W %x %y"
 807    bindkey <Home> selfirstline
 808    bindkey <End> sellastline
 809    bind . <Key-Up> "selnextline -1"
 810    bind . <Key-Down> "selnextline 1"
 811    bind . <Shift-Key-Up> "next_highlight -1"
 812    bind . <Shift-Key-Down> "next_highlight 1"
 813    bindkey <Key-Right> "goforw"
 814    bindkey <Key-Left> "goback"
 815    bind . <Key-Prior> "selnextpage -1"
 816    bind . <Key-Next> "selnextpage 1"
 817    bind . <Control-Home> "allcanvs yview moveto 0.0"
 818    bind . <Control-End> "allcanvs yview moveto 1.0"
 819    bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
 820    bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
 821    bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
 822    bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
 823    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 824    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 825    bindkey <Key-space> "$ctext yview scroll 1 pages"
 826    bindkey p "selnextline -1"
 827    bindkey n "selnextline 1"
 828    bindkey z "goback"
 829    bindkey x "goforw"
 830    bindkey i "selnextline -1"
 831    bindkey k "selnextline 1"
 832    bindkey j "goback"
 833    bindkey l "goforw"
 834    bindkey b "$ctext yview scroll -1 pages"
 835    bindkey d "$ctext yview scroll 18 units"
 836    bindkey u "$ctext yview scroll -18 units"
 837    bindkey / {findnext 1}
 838    bindkey <Key-Return> {findnext 0}
 839    bindkey ? findprev
 840    bindkey f nextfile
 841    bindkey <F5> updatecommits
 842    bind . <Control-q> doquit
 843    bind . <Control-f> dofind
 844    bind . <Control-g> {findnext 0}
 845    bind . <Control-r> dosearchback
 846    bind . <Control-s> dosearch
 847    bind . <Control-equal> {incrfont 1}
 848    bind . <Control-KP_Add> {incrfont 1}
 849    bind . <Control-minus> {incrfont -1}
 850    bind . <Control-KP_Subtract> {incrfont -1}
 851    wm protocol . WM_DELETE_WINDOW doquit
 852    bind . <Button-1> "click %W"
 853    bind $fstring <Key-Return> dofind
 854    bind $sha1entry <Key-Return> gotocommit
 855    bind $sha1entry <<PasteSelection>> clearsha1
 856    bind $cflist <1> {sel_flist %W %x %y; break}
 857    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 858    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 859
 860    set maincursor [. cget -cursor]
 861    set textcursor [$ctext cget -cursor]
 862    set curtextcursor $textcursor
 863
 864    set rowctxmenu .rowctxmenu
 865    menu $rowctxmenu -tearoff 0
 866    $rowctxmenu add command -label "Diff this -> selected" \
 867        -command {diffvssel 0}
 868    $rowctxmenu add command -label "Diff selected -> this" \
 869        -command {diffvssel 1}
 870    $rowctxmenu add command -label "Make patch" -command mkpatch
 871    $rowctxmenu add command -label "Create tag" -command mktag
 872    $rowctxmenu add command -label "Write commit to file" -command writecommit
 873    $rowctxmenu add command -label "Create new branch" -command mkbranch
 874    $rowctxmenu add command -label "Cherry-pick this commit" \
 875        -command cherrypick
 876    $rowctxmenu add command -label "Reset HEAD branch to here" \
 877        -command resethead
 878
 879    set fakerowmenu .fakerowmenu
 880    menu $fakerowmenu -tearoff 0
 881    $fakerowmenu add command -label "Diff this -> selected" \
 882        -command {diffvssel 0}
 883    $fakerowmenu add command -label "Diff selected -> this" \
 884        -command {diffvssel 1}
 885    $fakerowmenu add command -label "Make patch" -command mkpatch
 886#    $fakerowmenu add command -label "Commit" -command {mkcommit 0}
 887#    $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
 888#    $fakerowmenu add command -label "Revert local changes" -command revertlocal
 889
 890    set headctxmenu .headctxmenu
 891    menu $headctxmenu -tearoff 0
 892    $headctxmenu add command -label "Check out this branch" \
 893        -command cobranch
 894    $headctxmenu add command -label "Remove this branch" \
 895        -command rmbranch
 896}
 897
 898# mouse-2 makes all windows scan vertically, but only the one
 899# the cursor is in scans horizontally
 900proc canvscan {op w x y} {
 901    global canv canv2 canv3
 902    foreach c [list $canv $canv2 $canv3] {
 903        if {$c == $w} {
 904            $c scan $op $x $y
 905        } else {
 906            $c scan $op 0 $y
 907        }
 908    }
 909}
 910
 911proc scrollcanv {cscroll f0 f1} {
 912    $cscroll set $f0 $f1
 913    drawfrac $f0 $f1
 914    flushhighlights
 915}
 916
 917# when we make a key binding for the toplevel, make sure
 918# it doesn't get triggered when that key is pressed in the
 919# find string entry widget.
 920proc bindkey {ev script} {
 921    global entries
 922    bind . $ev $script
 923    set escript [bind Entry $ev]
 924    if {$escript == {}} {
 925        set escript [bind Entry <Key>]
 926    }
 927    foreach e $entries {
 928        bind $e $ev "$escript; break"
 929    }
 930}
 931
 932# set the focus back to the toplevel for any click outside
 933# the entry widgets
 934proc click {w} {
 935    global entries
 936    foreach e $entries {
 937        if {$w == $e} return
 938    }
 939    focus .
 940}
 941
 942proc savestuff {w} {
 943    global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
 944    global stuffsaved findmergefiles maxgraphpct
 945    global maxwidth showneartags showlocalchanges
 946    global viewname viewfiles viewargs viewperm nextviewnum
 947    global cmitmode wrapcomment
 948    global colors bgcolor fgcolor diffcolors selectbgcolor
 949
 950    if {$stuffsaved} return
 951    if {![winfo viewable .]} return
 952    catch {
 953        set f [open "~/.gitk-new" w]
 954        puts $f [list set mainfont $mainfont]
 955        puts $f [list set textfont $textfont]
 956        puts $f [list set uifont $uifont]
 957        puts $f [list set tabstop $tabstop]
 958        puts $f [list set findmergefiles $findmergefiles]
 959        puts $f [list set maxgraphpct $maxgraphpct]
 960        puts $f [list set maxwidth $maxwidth]
 961        puts $f [list set cmitmode $cmitmode]
 962        puts $f [list set wrapcomment $wrapcomment]
 963        puts $f [list set showneartags $showneartags]
 964        puts $f [list set showlocalchanges $showlocalchanges]
 965        puts $f [list set bgcolor $bgcolor]
 966        puts $f [list set fgcolor $fgcolor]
 967        puts $f [list set colors $colors]
 968        puts $f [list set diffcolors $diffcolors]
 969        puts $f [list set selectbgcolor $selectbgcolor]
 970
 971        puts $f "set geometry(main) [wm geometry .]"
 972        puts $f "set geometry(topwidth) [winfo width .tf]"
 973        puts $f "set geometry(topheight) [winfo height .tf]"
 974        puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
 975        puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
 976        puts $f "set geometry(botwidth) [winfo width .bleft]"
 977        puts $f "set geometry(botheight) [winfo height .bleft]"
 978
 979        puts -nonewline $f "set permviews {"
 980        for {set v 0} {$v < $nextviewnum} {incr v} {
 981            if {$viewperm($v)} {
 982                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
 983            }
 984        }
 985        puts $f "}"
 986        close $f
 987        file rename -force "~/.gitk-new" "~/.gitk"
 988    }
 989    set stuffsaved 1
 990}
 991
 992proc resizeclistpanes {win w} {
 993    global oldwidth
 994    if {[info exists oldwidth($win)]} {
 995        set s0 [$win sash coord 0]
 996        set s1 [$win sash coord 1]
 997        if {$w < 60} {
 998            set sash0 [expr {int($w/2 - 2)}]
 999            set sash1 [expr {int($w*5/6 - 2)}]
1000        } else {
1001            set factor [expr {1.0 * $w / $oldwidth($win)}]
1002            set sash0 [expr {int($factor * [lindex $s0 0])}]
1003            set sash1 [expr {int($factor * [lindex $s1 0])}]
1004            if {$sash0 < 30} {
1005                set sash0 30
1006            }
1007            if {$sash1 < $sash0 + 20} {
1008                set sash1 [expr {$sash0 + 20}]
1009            }
1010            if {$sash1 > $w - 10} {
1011                set sash1 [expr {$w - 10}]
1012                if {$sash0 > $sash1 - 20} {
1013                    set sash0 [expr {$sash1 - 20}]
1014                }
1015            }
1016        }
1017        $win sash place 0 $sash0 [lindex $s0 1]
1018        $win sash place 1 $sash1 [lindex $s1 1]
1019    }
1020    set oldwidth($win) $w
1021}
1022
1023proc resizecdetpanes {win w} {
1024    global oldwidth
1025    if {[info exists oldwidth($win)]} {
1026        set s0 [$win sash coord 0]
1027        if {$w < 60} {
1028            set sash0 [expr {int($w*3/4 - 2)}]
1029        } else {
1030            set factor [expr {1.0 * $w / $oldwidth($win)}]
1031            set sash0 [expr {int($factor * [lindex $s0 0])}]
1032            if {$sash0 < 45} {
1033                set sash0 45
1034            }
1035            if {$sash0 > $w - 15} {
1036                set sash0 [expr {$w - 15}]
1037            }
1038        }
1039        $win sash place 0 $sash0 [lindex $s0 1]
1040    }
1041    set oldwidth($win) $w
1042}
1043
1044proc allcanvs args {
1045    global canv canv2 canv3
1046    eval $canv $args
1047    eval $canv2 $args
1048    eval $canv3 $args
1049}
1050
1051proc bindall {event action} {
1052    global canv canv2 canv3
1053    bind $canv $event $action
1054    bind $canv2 $event $action
1055    bind $canv3 $event $action
1056}
1057
1058proc about {} {
1059    global uifont
1060    set w .about
1061    if {[winfo exists $w]} {
1062        raise $w
1063        return
1064    }
1065    toplevel $w
1066    wm title $w "About gitk"
1067    message $w.m -text {
1068Gitk - a commit viewer for git
1069
1070Copyright © 2005-2006 Paul Mackerras
1071
1072Use and redistribute under the terms of the GNU General Public License} \
1073            -justify center -aspect 400 -border 2 -bg white -relief groove
1074    pack $w.m -side top -fill x -padx 2 -pady 2
1075    $w.m configure -font $uifont
1076    button $w.ok -text Close -command "destroy $w" -default active
1077    pack $w.ok -side bottom
1078    $w.ok configure -font $uifont
1079    bind $w <Visibility> "focus $w.ok"
1080    bind $w <Key-Escape> "destroy $w"
1081    bind $w <Key-Return> "destroy $w"
1082}
1083
1084proc keys {} {
1085    global uifont
1086    set w .keys
1087    if {[winfo exists $w]} {
1088        raise $w
1089        return
1090    }
1091    toplevel $w
1092    wm title $w "Gitk key bindings"
1093    message $w.m -text {
1094Gitk key bindings:
1095
1096<Ctrl-Q>                Quit
1097<Home>          Move to first commit
1098<End>           Move to last commit
1099<Up>, p, i      Move up one commit
1100<Down>, n, k    Move down one commit
1101<Left>, z, j    Go back in history list
1102<Right>, x, l   Go forward in history list
1103<PageUp>        Move up one page in commit list
1104<PageDown>      Move down one page in commit list
1105<Ctrl-Home>     Scroll to top of commit list
1106<Ctrl-End>      Scroll to bottom of commit list
1107<Ctrl-Up>       Scroll commit list up one line
1108<Ctrl-Down>     Scroll commit list down one line
1109<Ctrl-PageUp>   Scroll commit list up one page
1110<Ctrl-PageDown> Scroll commit list down one page
1111<Shift-Up>      Move to previous highlighted line
1112<Shift-Down>    Move to next highlighted line
1113<Delete>, b     Scroll diff view up one page
1114<Backspace>     Scroll diff view up one page
1115<Space>         Scroll diff view down one page
1116u               Scroll diff view up 18 lines
1117d               Scroll diff view down 18 lines
1118<Ctrl-F>                Find
1119<Ctrl-G>                Move to next find hit
1120<Return>        Move to next find hit
1121/               Move to next find hit, or redo find
1122?               Move to previous find hit
1123f               Scroll diff view to next file
1124<Ctrl-S>                Search for next hit in diff view
1125<Ctrl-R>                Search for previous hit in diff view
1126<Ctrl-KP+>      Increase font size
1127<Ctrl-plus>     Increase font size
1128<Ctrl-KP->      Decrease font size
1129<Ctrl-minus>    Decrease font size
1130<F5>            Update
1131} \
1132            -justify left -bg white -border 2 -relief groove
1133    pack $w.m -side top -fill both -padx 2 -pady 2
1134    $w.m configure -font $uifont
1135    button $w.ok -text Close -command "destroy $w" -default active
1136    pack $w.ok -side bottom
1137    $w.ok configure -font $uifont
1138    bind $w <Visibility> "focus $w.ok"
1139    bind $w <Key-Escape> "destroy $w"
1140    bind $w <Key-Return> "destroy $w"
1141}
1142
1143# Procedures for manipulating the file list window at the
1144# bottom right of the overall window.
1145
1146proc treeview {w l openlevs} {
1147    global treecontents treediropen treeheight treeparent treeindex
1148
1149    set ix 0
1150    set treeindex() 0
1151    set lev 0
1152    set prefix {}
1153    set prefixend -1
1154    set prefendstack {}
1155    set htstack {}
1156    set ht 0
1157    set treecontents() {}
1158    $w conf -state normal
1159    foreach f $l {
1160        while {[string range $f 0 $prefixend] ne $prefix} {
1161            if {$lev <= $openlevs} {
1162                $w mark set e:$treeindex($prefix) "end -1c"
1163                $w mark gravity e:$treeindex($prefix) left
1164            }
1165            set treeheight($prefix) $ht
1166            incr ht [lindex $htstack end]
1167            set htstack [lreplace $htstack end end]
1168            set prefixend [lindex $prefendstack end]
1169            set prefendstack [lreplace $prefendstack end end]
1170            set prefix [string range $prefix 0 $prefixend]
1171            incr lev -1
1172        }
1173        set tail [string range $f [expr {$prefixend+1}] end]
1174        while {[set slash [string first "/" $tail]] >= 0} {
1175            lappend htstack $ht
1176            set ht 0
1177            lappend prefendstack $prefixend
1178            incr prefixend [expr {$slash + 1}]
1179            set d [string range $tail 0 $slash]
1180            lappend treecontents($prefix) $d
1181            set oldprefix $prefix
1182            append prefix $d
1183            set treecontents($prefix) {}
1184            set treeindex($prefix) [incr ix]
1185            set treeparent($prefix) $oldprefix
1186            set tail [string range $tail [expr {$slash+1}] end]
1187            if {$lev <= $openlevs} {
1188                set ht 1
1189                set treediropen($prefix) [expr {$lev < $openlevs}]
1190                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1191                $w mark set d:$ix "end -1c"
1192                $w mark gravity d:$ix left
1193                set str "\n"
1194                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1195                $w insert end $str
1196                $w image create end -align center -image $bm -padx 1 \
1197                    -name a:$ix
1198                $w insert end $d [highlight_tag $prefix]
1199                $w mark set s:$ix "end -1c"
1200                $w mark gravity s:$ix left
1201            }
1202            incr lev
1203        }
1204        if {$tail ne {}} {
1205            if {$lev <= $openlevs} {
1206                incr ht
1207                set str "\n"
1208                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1209                $w insert end $str
1210                $w insert end $tail [highlight_tag $f]
1211            }
1212            lappend treecontents($prefix) $tail
1213        }
1214    }
1215    while {$htstack ne {}} {
1216        set treeheight($prefix) $ht
1217        incr ht [lindex $htstack end]
1218        set htstack [lreplace $htstack end end]
1219        set prefixend [lindex $prefendstack end]
1220        set prefendstack [lreplace $prefendstack end end]
1221        set prefix [string range $prefix 0 $prefixend]
1222    }
1223    $w conf -state disabled
1224}
1225
1226proc linetoelt {l} {
1227    global treeheight treecontents
1228
1229    set y 2
1230    set prefix {}
1231    while {1} {
1232        foreach e $treecontents($prefix) {
1233            if {$y == $l} {
1234                return "$prefix$e"
1235            }
1236            set n 1
1237            if {[string index $e end] eq "/"} {
1238                set n $treeheight($prefix$e)
1239                if {$y + $n > $l} {
1240                    append prefix $e
1241                    incr y
1242                    break
1243                }
1244            }
1245            incr y $n
1246        }
1247    }
1248}
1249
1250proc highlight_tree {y prefix} {
1251    global treeheight treecontents cflist
1252
1253    foreach e $treecontents($prefix) {
1254        set path $prefix$e
1255        if {[highlight_tag $path] ne {}} {
1256            $cflist tag add bold $y.0 "$y.0 lineend"
1257        }
1258        incr y
1259        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1260            set y [highlight_tree $y $path]
1261        }
1262    }
1263    return $y
1264}
1265
1266proc treeclosedir {w dir} {
1267    global treediropen treeheight treeparent treeindex
1268
1269    set ix $treeindex($dir)
1270    $w conf -state normal
1271    $w delete s:$ix e:$ix
1272    set treediropen($dir) 0
1273    $w image configure a:$ix -image tri-rt
1274    $w conf -state disabled
1275    set n [expr {1 - $treeheight($dir)}]
1276    while {$dir ne {}} {
1277        incr treeheight($dir) $n
1278        set dir $treeparent($dir)
1279    }
1280}
1281
1282proc treeopendir {w dir} {
1283    global treediropen treeheight treeparent treecontents treeindex
1284
1285    set ix $treeindex($dir)
1286    $w conf -state normal
1287    $w image configure a:$ix -image tri-dn
1288    $w mark set e:$ix s:$ix
1289    $w mark gravity e:$ix right
1290    set lev 0
1291    set str "\n"
1292    set n [llength $treecontents($dir)]
1293    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1294        incr lev
1295        append str "\t"
1296        incr treeheight($x) $n
1297    }
1298    foreach e $treecontents($dir) {
1299        set de $dir$e
1300        if {[string index $e end] eq "/"} {
1301            set iy $treeindex($de)
1302            $w mark set d:$iy e:$ix
1303            $w mark gravity d:$iy left
1304            $w insert e:$ix $str
1305            set treediropen($de) 0
1306            $w image create e:$ix -align center -image tri-rt -padx 1 \
1307                -name a:$iy
1308            $w insert e:$ix $e [highlight_tag $de]
1309            $w mark set s:$iy e:$ix
1310            $w mark gravity s:$iy left
1311            set treeheight($de) 1
1312        } else {
1313            $w insert e:$ix $str
1314            $w insert e:$ix $e [highlight_tag $de]
1315        }
1316    }
1317    $w mark gravity e:$ix left
1318    $w conf -state disabled
1319    set treediropen($dir) 1
1320    set top [lindex [split [$w index @0,0] .] 0]
1321    set ht [$w cget -height]
1322    set l [lindex [split [$w index s:$ix] .] 0]
1323    if {$l < $top} {
1324        $w yview $l.0
1325    } elseif {$l + $n + 1 > $top + $ht} {
1326        set top [expr {$l + $n + 2 - $ht}]
1327        if {$l < $top} {
1328            set top $l
1329        }
1330        $w yview $top.0
1331    }
1332}
1333
1334proc treeclick {w x y} {
1335    global treediropen cmitmode ctext cflist cflist_top
1336
1337    if {$cmitmode ne "tree"} return
1338    if {![info exists cflist_top]} return
1339    set l [lindex [split [$w index "@$x,$y"] "."] 0]
1340    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1341    $cflist tag add highlight $l.0 "$l.0 lineend"
1342    set cflist_top $l
1343    if {$l == 1} {
1344        $ctext yview 1.0
1345        return
1346    }
1347    set e [linetoelt $l]
1348    if {[string index $e end] ne "/"} {
1349        showfile $e
1350    } elseif {$treediropen($e)} {
1351        treeclosedir $w $e
1352    } else {
1353        treeopendir $w $e
1354    }
1355}
1356
1357proc setfilelist {id} {
1358    global treefilelist cflist
1359
1360    treeview $cflist $treefilelist($id) 0
1361}
1362
1363image create bitmap tri-rt -background black -foreground blue -data {
1364    #define tri-rt_width 13
1365    #define tri-rt_height 13
1366    static unsigned char tri-rt_bits[] = {
1367       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1368       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1369       0x00, 0x00};
1370} -maskdata {
1371    #define tri-rt-mask_width 13
1372    #define tri-rt-mask_height 13
1373    static unsigned char tri-rt-mask_bits[] = {
1374       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1375       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1376       0x08, 0x00};
1377}
1378image create bitmap tri-dn -background black -foreground blue -data {
1379    #define tri-dn_width 13
1380    #define tri-dn_height 13
1381    static unsigned char tri-dn_bits[] = {
1382       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1383       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1384       0x00, 0x00};
1385} -maskdata {
1386    #define tri-dn-mask_width 13
1387    #define tri-dn-mask_height 13
1388    static unsigned char tri-dn-mask_bits[] = {
1389       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1390       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1391       0x00, 0x00};
1392}
1393
1394proc init_flist {first} {
1395    global cflist cflist_top selectedline difffilestart
1396
1397    $cflist conf -state normal
1398    $cflist delete 0.0 end
1399    if {$first ne {}} {
1400        $cflist insert end $first
1401        set cflist_top 1
1402        $cflist tag add highlight 1.0 "1.0 lineend"
1403    } else {
1404        catch {unset cflist_top}
1405    }
1406    $cflist conf -state disabled
1407    set difffilestart {}
1408}
1409
1410proc highlight_tag {f} {
1411    global highlight_paths
1412
1413    foreach p $highlight_paths {
1414        if {[string match $p $f]} {
1415            return "bold"
1416        }
1417    }
1418    return {}
1419}
1420
1421proc highlight_filelist {} {
1422    global cmitmode cflist
1423
1424    $cflist conf -state normal
1425    if {$cmitmode ne "tree"} {
1426        set end [lindex [split [$cflist index end] .] 0]
1427        for {set l 2} {$l < $end} {incr l} {
1428            set line [$cflist get $l.0 "$l.0 lineend"]
1429            if {[highlight_tag $line] ne {}} {
1430                $cflist tag add bold $l.0 "$l.0 lineend"
1431            }
1432        }
1433    } else {
1434        highlight_tree 2 {}
1435    }
1436    $cflist conf -state disabled
1437}
1438
1439proc unhighlight_filelist {} {
1440    global cflist
1441
1442    $cflist conf -state normal
1443    $cflist tag remove bold 1.0 end
1444    $cflist conf -state disabled
1445}
1446
1447proc add_flist {fl} {
1448    global cflist
1449
1450    $cflist conf -state normal
1451    foreach f $fl {
1452        $cflist insert end "\n"
1453        $cflist insert end $f [highlight_tag $f]
1454    }
1455    $cflist conf -state disabled
1456}
1457
1458proc sel_flist {w x y} {
1459    global ctext difffilestart cflist cflist_top cmitmode
1460
1461    if {$cmitmode eq "tree"} return
1462    if {![info exists cflist_top]} return
1463    set l [lindex [split [$w index "@$x,$y"] "."] 0]
1464    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1465    $cflist tag add highlight $l.0 "$l.0 lineend"
1466    set cflist_top $l
1467    if {$l == 1} {
1468        $ctext yview 1.0
1469    } else {
1470        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1471    }
1472}
1473
1474# Functions for adding and removing shell-type quoting
1475
1476proc shellquote {str} {
1477    if {![string match "*\['\"\\ \t]*" $str]} {
1478        return $str
1479    }
1480    if {![string match "*\['\"\\]*" $str]} {
1481        return "\"$str\""
1482    }
1483    if {![string match "*'*" $str]} {
1484        return "'$str'"
1485    }
1486    return "\"[string map {\" \\\" \\ \\\\} $str]\""
1487}
1488
1489proc shellarglist {l} {
1490    set str {}
1491    foreach a $l {
1492        if {$str ne {}} {
1493            append str " "
1494        }
1495        append str [shellquote $a]
1496    }
1497    return $str
1498}
1499
1500proc shelldequote {str} {
1501    set ret {}
1502    set used -1
1503    while {1} {
1504        incr used
1505        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1506            append ret [string range $str $used end]
1507            set used [string length $str]
1508            break
1509        }
1510        set first [lindex $first 0]
1511        set ch [string index $str $first]
1512        if {$first > $used} {
1513            append ret [string range $str $used [expr {$first - 1}]]
1514            set used $first
1515        }
1516        if {$ch eq " " || $ch eq "\t"} break
1517        incr used
1518        if {$ch eq "'"} {
1519            set first [string first "'" $str $used]
1520            if {$first < 0} {
1521                error "unmatched single-quote"
1522            }
1523            append ret [string range $str $used [expr {$first - 1}]]
1524            set used $first
1525            continue
1526        }
1527        if {$ch eq "\\"} {
1528            if {$used >= [string length $str]} {
1529                error "trailing backslash"
1530            }
1531            append ret [string index $str $used]
1532            continue
1533        }
1534        # here ch == "\""
1535        while {1} {
1536            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1537                error "unmatched double-quote"
1538            }
1539            set first [lindex $first 0]
1540            set ch [string index $str $first]
1541            if {$first > $used} {
1542                append ret [string range $str $used [expr {$first - 1}]]
1543                set used $first
1544            }
1545            if {$ch eq "\""} break
1546            incr used
1547            append ret [string index $str $used]
1548            incr used
1549        }
1550    }
1551    return [list $used $ret]
1552}
1553
1554proc shellsplit {str} {
1555    set l {}
1556    while {1} {
1557        set str [string trimleft $str]
1558        if {$str eq {}} break
1559        set dq [shelldequote $str]
1560        set n [lindex $dq 0]
1561        set word [lindex $dq 1]
1562        set str [string range $str $n end]
1563        lappend l $word
1564    }
1565    return $l
1566}
1567
1568# Code to implement multiple views
1569
1570proc newview {ishighlight} {
1571    global nextviewnum newviewname newviewperm uifont newishighlight
1572    global newviewargs revtreeargs
1573
1574    set newishighlight $ishighlight
1575    set top .gitkview
1576    if {[winfo exists $top]} {
1577        raise $top
1578        return
1579    }
1580    set newviewname($nextviewnum) "View $nextviewnum"
1581    set newviewperm($nextviewnum) 0
1582    set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1583    vieweditor $top $nextviewnum "Gitk view definition"
1584}
1585
1586proc editview {} {
1587    global curview
1588    global viewname viewperm newviewname newviewperm
1589    global viewargs newviewargs
1590
1591    set top .gitkvedit-$curview
1592    if {[winfo exists $top]} {
1593        raise $top
1594        return
1595    }
1596    set newviewname($curview) $viewname($curview)
1597    set newviewperm($curview) $viewperm($curview)
1598    set newviewargs($curview) [shellarglist $viewargs($curview)]
1599    vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1600}
1601
1602proc vieweditor {top n title} {
1603    global newviewname newviewperm viewfiles
1604    global uifont
1605
1606    toplevel $top
1607    wm title $top $title
1608    label $top.nl -text "Name" -font $uifont
1609    entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1610    grid $top.nl $top.name -sticky w -pady 5
1611    checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1612        -font $uifont
1613    grid $top.perm - -pady 5 -sticky w
1614    message $top.al -aspect 1000 -font $uifont \
1615        -text "Commits to include (arguments to git rev-list):"
1616    grid $top.al - -sticky w -pady 5
1617    entry $top.args -width 50 -textvariable newviewargs($n) \
1618        -background white -font $uifont
1619    grid $top.args - -sticky ew -padx 5
1620    message $top.l -aspect 1000 -font $uifont \
1621        -text "Enter files and directories to include, one per line:"
1622    grid $top.l - -sticky w
1623    text $top.t -width 40 -height 10 -background white -font $uifont
1624    if {[info exists viewfiles($n)]} {
1625        foreach f $viewfiles($n) {
1626            $top.t insert end $f
1627            $top.t insert end "\n"
1628        }
1629        $top.t delete {end - 1c} end
1630        $top.t mark set insert 0.0
1631    }
1632    grid $top.t - -sticky ew -padx 5
1633    frame $top.buts
1634    button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1635        -font $uifont
1636    button $top.buts.can -text "Cancel" -command [list destroy $top] \
1637        -font $uifont
1638    grid $top.buts.ok $top.buts.can
1639    grid columnconfigure $top.buts 0 -weight 1 -uniform a
1640    grid columnconfigure $top.buts 1 -weight 1 -uniform a
1641    grid $top.buts - -pady 10 -sticky ew
1642    focus $top.t
1643}
1644
1645proc doviewmenu {m first cmd op argv} {
1646    set nmenu [$m index end]
1647    for {set i $first} {$i <= $nmenu} {incr i} {
1648        if {[$m entrycget $i -command] eq $cmd} {
1649            eval $m $op $i $argv
1650            break
1651        }
1652    }
1653}
1654
1655proc allviewmenus {n op args} {
1656    global viewhlmenu
1657
1658    doviewmenu .bar.view 5 [list showview $n] $op $args
1659    doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1660}
1661
1662proc newviewok {top n} {
1663    global nextviewnum newviewperm newviewname newishighlight
1664    global viewname viewfiles viewperm selectedview curview
1665    global viewargs newviewargs viewhlmenu
1666
1667    if {[catch {
1668        set newargs [shellsplit $newviewargs($n)]
1669    } err]} {
1670        error_popup "Error in commit selection arguments: $err"
1671        wm raise $top
1672        focus $top
1673        return
1674    }
1675    set files {}
1676    foreach f [split [$top.t get 0.0 end] "\n"] {
1677        set ft [string trim $f]
1678        if {$ft ne {}} {
1679            lappend files $ft
1680        }
1681    }
1682    if {![info exists viewfiles($n)]} {
1683        # creating a new view
1684        incr nextviewnum
1685        set viewname($n) $newviewname($n)
1686        set viewperm($n) $newviewperm($n)
1687        set viewfiles($n) $files
1688        set viewargs($n) $newargs
1689        addviewmenu $n
1690        if {!$newishighlight} {
1691            run showview $n
1692        } else {
1693            run addvhighlight $n
1694        }
1695    } else {
1696        # editing an existing view
1697        set viewperm($n) $newviewperm($n)
1698        if {$newviewname($n) ne $viewname($n)} {
1699            set viewname($n) $newviewname($n)
1700            doviewmenu .bar.view 5 [list showview $n] \
1701                entryconf [list -label $viewname($n)]
1702            doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1703                entryconf [list -label $viewname($n) -value $viewname($n)]
1704        }
1705        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1706            set viewfiles($n) $files
1707            set viewargs($n) $newargs
1708            if {$curview == $n} {
1709                run updatecommits
1710            }
1711        }
1712    }
1713    catch {destroy $top}
1714}
1715
1716proc delview {} {
1717    global curview viewdata viewperm hlview selectedhlview
1718
1719    if {$curview == 0} return
1720    if {[info exists hlview] && $hlview == $curview} {
1721        set selectedhlview None
1722        unset hlview
1723    }
1724    allviewmenus $curview delete
1725    set viewdata($curview) {}
1726    set viewperm($curview) 0
1727    showview 0
1728}
1729
1730proc addviewmenu {n} {
1731    global viewname viewhlmenu
1732
1733    .bar.view add radiobutton -label $viewname($n) \
1734        -command [list showview $n] -variable selectedview -value $n
1735    $viewhlmenu add radiobutton -label $viewname($n) \
1736        -command [list addvhighlight $n] -variable selectedhlview
1737}
1738
1739proc flatten {var} {
1740    global $var
1741
1742    set ret {}
1743    foreach i [array names $var] {
1744        lappend ret $i [set $var\($i\)]
1745    }
1746    return $ret
1747}
1748
1749proc unflatten {var l} {
1750    global $var
1751
1752    catch {unset $var}
1753    foreach {i v} $l {
1754        set $var\($i\) $v
1755    }
1756}
1757
1758proc showview {n} {
1759    global curview viewdata viewfiles
1760    global displayorder parentlist rowidlist rowoffsets
1761    global colormap rowtextx commitrow nextcolor canvxmax
1762    global numcommits rowrangelist commitlisted idrowranges rowchk
1763    global selectedline currentid canv canvy0
1764    global treediffs
1765    global pending_select phase
1766    global commitidx rowlaidout rowoptim
1767    global commfd
1768    global selectedview selectfirst
1769    global vparentlist vdisporder vcmitlisted
1770    global hlview selectedhlview
1771
1772    if {$n == $curview} return
1773    set selid {}
1774    if {[info exists selectedline]} {
1775        set selid $currentid
1776        set y [yc $selectedline]
1777        set ymax [lindex [$canv cget -scrollregion] 3]
1778        set span [$canv yview]
1779        set ytop [expr {[lindex $span 0] * $ymax}]
1780        set ybot [expr {[lindex $span 1] * $ymax}]
1781        if {$ytop < $y && $y < $ybot} {
1782            set yscreen [expr {$y - $ytop}]
1783        } else {
1784            set yscreen [expr {($ybot - $ytop) / 2}]
1785        }
1786    } elseif {[info exists pending_select]} {
1787        set selid $pending_select
1788        unset pending_select
1789    }
1790    unselectline
1791    normalline
1792    if {$curview >= 0} {
1793        set vparentlist($curview) $parentlist
1794        set vdisporder($curview) $displayorder
1795        set vcmitlisted($curview) $commitlisted
1796        if {$phase ne {}} {
1797            set viewdata($curview) \
1798                [list $phase $rowidlist $rowoffsets $rowrangelist \
1799                     [flatten idrowranges] [flatten idinlist] \
1800                     $rowlaidout $rowoptim $numcommits]
1801        } elseif {![info exists viewdata($curview)]
1802                  || [lindex $viewdata($curview) 0] ne {}} {
1803            set viewdata($curview) \
1804                [list {} $rowidlist $rowoffsets $rowrangelist]
1805        }
1806    }
1807    catch {unset treediffs}
1808    clear_display
1809    if {[info exists hlview] && $hlview == $n} {
1810        unset hlview
1811        set selectedhlview None
1812    }
1813
1814    set curview $n
1815    set selectedview $n
1816    .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1817    .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1818
1819    if {![info exists viewdata($n)]} {
1820        if {$selid ne {}} {
1821            set pending_select $selid
1822        }
1823        getcommits
1824        return
1825    }
1826
1827    set v $viewdata($n)
1828    set phase [lindex $v 0]
1829    set displayorder $vdisporder($n)
1830    set parentlist $vparentlist($n)
1831    set commitlisted $vcmitlisted($n)
1832    set rowidlist [lindex $v 1]
1833    set rowoffsets [lindex $v 2]
1834    set rowrangelist [lindex $v 3]
1835    if {$phase eq {}} {
1836        set numcommits [llength $displayorder]
1837        catch {unset idrowranges}
1838    } else {
1839        unflatten idrowranges [lindex $v 4]
1840        unflatten idinlist [lindex $v 5]
1841        set rowlaidout [lindex $v 6]
1842        set rowoptim [lindex $v 7]
1843        set numcommits [lindex $v 8]
1844        catch {unset rowchk}
1845    }
1846
1847    catch {unset colormap}
1848    catch {unset rowtextx}
1849    set nextcolor 0
1850    set canvxmax [$canv cget -width]
1851    set curview $n
1852    set row 0
1853    setcanvscroll
1854    set yf 0
1855    set row {}
1856    set selectfirst 0
1857    if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1858        set row $commitrow($n,$selid)
1859        # try to get the selected row in the same position on the screen
1860        set ymax [lindex [$canv cget -scrollregion] 3]
1861        set ytop [expr {[yc $row] - $yscreen}]
1862        if {$ytop < 0} {
1863            set ytop 0
1864        }
1865        set yf [expr {$ytop * 1.0 / $ymax}]
1866    }
1867    allcanvs yview moveto $yf
1868    drawvisible
1869    if {$row ne {}} {
1870        selectline $row 0
1871    } elseif {$selid ne {}} {
1872        set pending_select $selid
1873    } else {
1874        set row [expr {[lindex $displayorder 0] eq $nullid}]
1875        if {$row < $numcommits} {
1876            selectline $row 0
1877        } else {
1878            set selectfirst 1
1879        }
1880    }
1881    if {$phase ne {}} {
1882        if {$phase eq "getcommits"} {
1883            show_status "Reading commits..."
1884        }
1885        run chewcommits $n
1886    } elseif {$numcommits == 0} {
1887        show_status "No commits selected"
1888    }
1889}
1890
1891# Stuff relating to the highlighting facility
1892
1893proc ishighlighted {row} {
1894    global vhighlights fhighlights nhighlights rhighlights
1895
1896    if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1897        return $nhighlights($row)
1898    }
1899    if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1900        return $vhighlights($row)
1901    }
1902    if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1903        return $fhighlights($row)
1904    }
1905    if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1906        return $rhighlights($row)
1907    }
1908    return 0
1909}
1910
1911proc bolden {row font} {
1912    global canv linehtag selectedline boldrows
1913
1914    lappend boldrows $row
1915    $canv itemconf $linehtag($row) -font $font
1916    if {[info exists selectedline] && $row == $selectedline} {
1917        $canv delete secsel
1918        set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1919                   -outline {{}} -tags secsel \
1920                   -fill [$canv cget -selectbackground]]
1921        $canv lower $t
1922    }
1923}
1924
1925proc bolden_name {row font} {
1926    global canv2 linentag selectedline boldnamerows
1927
1928    lappend boldnamerows $row
1929    $canv2 itemconf $linentag($row) -font $font
1930    if {[info exists selectedline] && $row == $selectedline} {
1931        $canv2 delete secsel
1932        set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1933                   -outline {{}} -tags secsel \
1934                   -fill [$canv2 cget -selectbackground]]
1935        $canv2 lower $t
1936    }
1937}
1938
1939proc unbolden {} {
1940    global mainfont boldrows
1941
1942    set stillbold {}
1943    foreach row $boldrows {
1944        if {![ishighlighted $row]} {
1945            bolden $row $mainfont
1946        } else {
1947            lappend stillbold $row
1948        }
1949    }
1950    set boldrows $stillbold
1951}
1952
1953proc addvhighlight {n} {
1954    global hlview curview viewdata vhl_done vhighlights commitidx
1955
1956    if {[info exists hlview]} {
1957        delvhighlight
1958    }
1959    set hlview $n
1960    if {$n != $curview && ![info exists viewdata($n)]} {
1961        set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1962        set vparentlist($n) {}
1963        set vdisporder($n) {}
1964        set vcmitlisted($n) {}
1965        start_rev_list $n
1966    }
1967    set vhl_done $commitidx($hlview)
1968    if {$vhl_done > 0} {
1969        drawvisible
1970    }
1971}
1972
1973proc delvhighlight {} {
1974    global hlview vhighlights
1975
1976    if {![info exists hlview]} return
1977    unset hlview
1978    catch {unset vhighlights}
1979    unbolden
1980}
1981
1982proc vhighlightmore {} {
1983    global hlview vhl_done commitidx vhighlights
1984    global displayorder vdisporder curview mainfont
1985
1986    set font [concat $mainfont bold]
1987    set max $commitidx($hlview)
1988    if {$hlview == $curview} {
1989        set disp $displayorder
1990    } else {
1991        set disp $vdisporder($hlview)
1992    }
1993    set vr [visiblerows]
1994    set r0 [lindex $vr 0]
1995    set r1 [lindex $vr 1]
1996    for {set i $vhl_done} {$i < $max} {incr i} {
1997        set id [lindex $disp $i]
1998        if {[info exists commitrow($curview,$id)]} {
1999            set row $commitrow($curview,$id)
2000            if {$r0 <= $row && $row <= $r1} {
2001                if {![highlighted $row]} {
2002                    bolden $row $font
2003                }
2004                set vhighlights($row) 1
2005            }
2006        }
2007    }
2008    set vhl_done $max
2009}
2010
2011proc askvhighlight {row id} {
2012    global hlview vhighlights commitrow iddrawn mainfont
2013
2014    if {[info exists commitrow($hlview,$id)]} {
2015        if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2016            bolden $row [concat $mainfont bold]
2017        }
2018        set vhighlights($row) 1
2019    } else {
2020        set vhighlights($row) 0
2021    }
2022}
2023
2024proc hfiles_change {name ix op} {
2025    global highlight_files filehighlight fhighlights fh_serial
2026    global mainfont highlight_paths
2027
2028    if {[info exists filehighlight]} {
2029        # delete previous highlights
2030        catch {close $filehighlight}
2031        unset filehighlight
2032        catch {unset fhighlights}
2033        unbolden
2034        unhighlight_filelist
2035    }
2036    set highlight_paths {}
2037    after cancel do_file_hl $fh_serial
2038    incr fh_serial
2039    if {$highlight_files ne {}} {
2040        after 300 do_file_hl $fh_serial
2041    }
2042}
2043
2044proc makepatterns {l} {
2045    set ret {}
2046    foreach e $l {
2047        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2048        if {[string index $ee end] eq "/"} {
2049            lappend ret "$ee*"
2050        } else {
2051            lappend ret $ee
2052            lappend ret "$ee/*"
2053        }
2054    }
2055    return $ret
2056}
2057
2058proc do_file_hl {serial} {
2059    global highlight_files filehighlight highlight_paths gdttype fhl_list
2060
2061    if {$gdttype eq "touching paths:"} {
2062        if {[catch {set paths [shellsplit $highlight_files]}]} return
2063        set highlight_paths [makepatterns $paths]
2064        highlight_filelist
2065        set gdtargs [concat -- $paths]
2066    } else {
2067        set gdtargs [list "-S$highlight_files"]
2068    }
2069    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2070    set filehighlight [open $cmd r+]
2071    fconfigure $filehighlight -blocking 0
2072    filerun $filehighlight readfhighlight
2073    set fhl_list {}
2074    drawvisible
2075    flushhighlights
2076}
2077
2078proc flushhighlights {} {
2079    global filehighlight fhl_list
2080
2081    if {[info exists filehighlight]} {
2082        lappend fhl_list {}
2083        puts $filehighlight ""
2084        flush $filehighlight
2085    }
2086}
2087
2088proc askfilehighlight {row id} {
2089    global filehighlight fhighlights fhl_list
2090
2091    lappend fhl_list $id
2092    set fhighlights($row) -1
2093    puts $filehighlight $id
2094}
2095
2096proc readfhighlight {} {
2097    global filehighlight fhighlights commitrow curview mainfont iddrawn
2098    global fhl_list
2099
2100    if {![info exists filehighlight]} {
2101        return 0
2102    }
2103    set nr 0
2104    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2105        set line [string trim $line]
2106        set i [lsearch -exact $fhl_list $line]
2107        if {$i < 0} continue
2108        for {set j 0} {$j < $i} {incr j} {
2109            set id [lindex $fhl_list $j]
2110            if {[info exists commitrow($curview,$id)]} {
2111                set fhighlights($commitrow($curview,$id)) 0
2112            }
2113        }
2114        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2115        if {$line eq {}} continue
2116        if {![info exists commitrow($curview,$line)]} continue
2117        set row $commitrow($curview,$line)
2118        if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2119            bolden $row [concat $mainfont bold]
2120        }
2121        set fhighlights($row) 1
2122    }
2123    if {[eof $filehighlight]} {
2124        # strange...
2125        puts "oops, git diff-tree died"
2126        catch {close $filehighlight}
2127        unset filehighlight
2128        return 0
2129    }
2130    next_hlcont
2131    return 1
2132}
2133
2134proc find_change {name ix op} {
2135    global nhighlights mainfont boldnamerows
2136    global findstring findpattern findtype markingmatches
2137
2138    # delete previous highlights, if any
2139    foreach row $boldnamerows {
2140        bolden_name $row $mainfont
2141    }
2142    set boldnamerows {}
2143    catch {unset nhighlights}
2144    unbolden
2145    unmarkmatches
2146    if {$findtype ne "Regexp"} {
2147        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2148                   $findstring]
2149        set findpattern "*$e*"
2150    }
2151    set markingmatches [expr {$findstring ne {}}]
2152    drawvisible
2153}
2154
2155proc doesmatch {f} {
2156    global findtype findstring findpattern
2157
2158    if {$findtype eq "Regexp"} {
2159        return [regexp $findstring $f]
2160    } elseif {$findtype eq "IgnCase"} {
2161        return [string match -nocase $findpattern $f]
2162    } else {
2163        return [string match $findpattern $f]
2164    }
2165}
2166
2167proc askfindhighlight {row id} {
2168    global nhighlights commitinfo iddrawn mainfont
2169    global findloc
2170    global markingmatches
2171
2172    if {![info exists commitinfo($id)]} {
2173        getcommit $id
2174    }
2175    set info $commitinfo($id)
2176    set isbold 0
2177    set fldtypes {Headline Author Date Committer CDate Comments}
2178    foreach f $info ty $fldtypes {
2179        if {($findloc eq "All fields" || $findloc eq $ty) &&
2180            [doesmatch $f]} {
2181            if {$ty eq "Author"} {
2182                set isbold 2
2183                break
2184            }
2185            set isbold 1
2186        }
2187    }
2188    if {$isbold && [info exists iddrawn($id)]} {
2189        set f [concat $mainfont bold]
2190        if {![ishighlighted $row]} {
2191            bolden $row $f
2192            if {$isbold > 1} {
2193                bolden_name $row $f
2194            }
2195        }
2196        if {$markingmatches} {
2197            markrowmatches $row [lindex $info 0] [lindex $info 1]
2198        }
2199    }
2200    set nhighlights($row) $isbold
2201}
2202
2203proc markrowmatches {row headline author} {
2204    global canv canv2 linehtag linentag
2205
2206    $canv delete match$row
2207    $canv2 delete match$row
2208    set m [findmatches $headline]
2209    if {$m ne {}} {
2210        markmatches $canv $row $headline $linehtag($row) $m \
2211            [$canv itemcget $linehtag($row) -font]
2212    }
2213    set m [findmatches $author]
2214    if {$m ne {}} {
2215        markmatches $canv2 $row $author $linentag($row) $m \
2216            [$canv2 itemcget $linentag($row) -font]
2217    }
2218}
2219
2220proc vrel_change {name ix op} {
2221    global highlight_related
2222
2223    rhighlight_none
2224    if {$highlight_related ne "None"} {
2225        run drawvisible
2226    }
2227}
2228
2229# prepare for testing whether commits are descendents or ancestors of a
2230proc rhighlight_sel {a} {
2231    global descendent desc_todo ancestor anc_todo
2232    global highlight_related rhighlights
2233
2234    catch {unset descendent}
2235    set desc_todo [list $a]
2236    catch {unset ancestor}
2237    set anc_todo [list $a]
2238    if {$highlight_related ne "None"} {
2239        rhighlight_none
2240        run drawvisible
2241    }
2242}
2243
2244proc rhighlight_none {} {
2245    global rhighlights
2246
2247    catch {unset rhighlights}
2248    unbolden
2249}
2250
2251proc is_descendent {a} {
2252    global curview children commitrow descendent desc_todo
2253
2254    set v $curview
2255    set la $commitrow($v,$a)
2256    set todo $desc_todo
2257    set leftover {}
2258    set done 0
2259    for {set i 0} {$i < [llength $todo]} {incr i} {
2260        set do [lindex $todo $i]
2261        if {$commitrow($v,$do) < $la} {
2262            lappend leftover $do
2263            continue
2264        }
2265        foreach nk $children($v,$do) {
2266            if {![info exists descendent($nk)]} {
2267                set descendent($nk) 1
2268                lappend todo $nk
2269                if {$nk eq $a} {
2270                    set done 1
2271                }
2272            }
2273        }
2274        if {$done} {
2275            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2276            return
2277        }
2278    }
2279    set descendent($a) 0
2280    set desc_todo $leftover
2281}
2282
2283proc is_ancestor {a} {
2284    global curview parentlist commitrow ancestor anc_todo
2285
2286    set v $curview
2287    set la $commitrow($v,$a)
2288    set todo $anc_todo
2289    set leftover {}
2290    set done 0
2291    for {set i 0} {$i < [llength $todo]} {incr i} {
2292        set do [lindex $todo $i]
2293        if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2294            lappend leftover $do
2295            continue
2296        }
2297        foreach np [lindex $parentlist $commitrow($v,$do)] {
2298            if {![info exists ancestor($np)]} {
2299                set ancestor($np) 1
2300                lappend todo $np
2301                if {$np eq $a} {
2302                    set done 1
2303                }
2304            }
2305        }
2306        if {$done} {
2307            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2308            return
2309        }
2310    }
2311    set ancestor($a) 0
2312    set anc_todo $leftover
2313}
2314
2315proc askrelhighlight {row id} {
2316    global descendent highlight_related iddrawn mainfont rhighlights
2317    global selectedline ancestor
2318
2319    if {![info exists selectedline]} return
2320    set isbold 0
2321    if {$highlight_related eq "Descendent" ||
2322        $highlight_related eq "Not descendent"} {
2323        if {![info exists descendent($id)]} {
2324            is_descendent $id
2325        }
2326        if {$descendent($id) == ($highlight_related eq "Descendent")} {
2327            set isbold 1
2328        }
2329    } elseif {$highlight_related eq "Ancestor" ||
2330              $highlight_related eq "Not ancestor"} {
2331        if {![info exists ancestor($id)]} {
2332            is_ancestor $id
2333        }
2334        if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2335            set isbold 1
2336        }
2337    }
2338    if {[info exists iddrawn($id)]} {
2339        if {$isbold && ![ishighlighted $row]} {
2340            bolden $row [concat $mainfont bold]
2341        }
2342    }
2343    set rhighlights($row) $isbold
2344}
2345
2346proc next_hlcont {} {
2347    global fhl_row fhl_dirn displayorder numcommits
2348    global vhighlights fhighlights nhighlights rhighlights
2349    global hlview filehighlight findstring highlight_related
2350
2351    if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2352    set row $fhl_row
2353    while {1} {
2354        if {$row < 0 || $row >= $numcommits} {
2355            bell
2356            set fhl_dirn 0
2357            return
2358        }
2359        set id [lindex $displayorder $row]
2360        if {[info exists hlview]} {
2361            if {![info exists vhighlights($row)]} {
2362                askvhighlight $row $id
2363            }
2364            if {$vhighlights($row) > 0} break
2365        }
2366        if {$findstring ne {}} {
2367            if {![info exists nhighlights($row)]} {
2368                askfindhighlight $row $id
2369            }
2370            if {$nhighlights($row) > 0} break
2371        }
2372        if {$highlight_related ne "None"} {
2373            if {![info exists rhighlights($row)]} {
2374                askrelhighlight $row $id
2375            }
2376            if {$rhighlights($row) > 0} break
2377        }
2378        if {[info exists filehighlight]} {
2379            if {![info exists fhighlights($row)]} {
2380                # ask for a few more while we're at it...
2381                set r $row
2382                for {set n 0} {$n < 100} {incr n} {
2383                    if {![info exists fhighlights($r)]} {
2384                        askfilehighlight $r [lindex $displayorder $r]
2385                    }
2386                    incr r $fhl_dirn
2387                    if {$r < 0 || $r >= $numcommits} break
2388                }
2389                flushhighlights
2390            }
2391            if {$fhighlights($row) < 0} {
2392                set fhl_row $row
2393                return
2394            }
2395            if {$fhighlights($row) > 0} break
2396        }
2397        incr row $fhl_dirn
2398    }
2399    set fhl_dirn 0
2400    selectline $row 1
2401}
2402
2403proc next_highlight {dirn} {
2404    global selectedline fhl_row fhl_dirn
2405    global hlview filehighlight findstring highlight_related
2406
2407    if {![info exists selectedline]} return
2408    if {!([info exists hlview] || $findstring ne {} ||
2409          $highlight_related ne "None" || [info exists filehighlight])} return
2410    set fhl_row [expr {$selectedline + $dirn}]
2411    set fhl_dirn $dirn
2412    next_hlcont
2413}
2414
2415proc cancel_next_highlight {} {
2416    global fhl_dirn
2417
2418    set fhl_dirn 0
2419}
2420
2421# Graph layout functions
2422
2423proc shortids {ids} {
2424    set res {}
2425    foreach id $ids {
2426        if {[llength $id] > 1} {
2427            lappend res [shortids $id]
2428        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2429            lappend res [string range $id 0 7]
2430        } else {
2431            lappend res $id
2432        }
2433    }
2434    return $res
2435}
2436
2437proc incrange {l x o} {
2438    set n [llength $l]
2439    while {$x < $n} {
2440        set e [lindex $l $x]
2441        if {$e ne {}} {
2442            lset l $x [expr {$e + $o}]
2443        }
2444        incr x
2445    }
2446    return $l
2447}
2448
2449proc ntimes {n o} {
2450    set ret {}
2451    for {} {$n > 0} {incr n -1} {
2452        lappend ret $o
2453    }
2454    return $ret
2455}
2456
2457proc usedinrange {id l1 l2} {
2458    global children commitrow curview
2459
2460    if {[info exists commitrow($curview,$id)]} {
2461        set r $commitrow($curview,$id)
2462        if {$l1 <= $r && $r <= $l2} {
2463            return [expr {$r - $l1 + 1}]
2464        }
2465    }
2466    set kids $children($curview,$id)
2467    foreach c $kids {
2468        set r $commitrow($curview,$c)
2469        if {$l1 <= $r && $r <= $l2} {
2470            return [expr {$r - $l1 + 1}]
2471        }
2472    }
2473    return 0
2474}
2475
2476proc sanity {row {full 0}} {
2477    global rowidlist rowoffsets
2478
2479    set col -1
2480    set ids [lindex $rowidlist $row]
2481    foreach id $ids {
2482        incr col
2483        if {$id eq {}} continue
2484        if {$col < [llength $ids] - 1 &&
2485            [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2486            puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2487        }
2488        set o [lindex $rowoffsets $row $col]
2489        set y $row
2490        set x $col
2491        while {$o ne {}} {
2492            incr y -1
2493            incr x $o
2494            if {[lindex $rowidlist $y $x] != $id} {
2495                puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2496                puts "  id=[shortids $id] check started at row $row"
2497                for {set i $row} {$i >= $y} {incr i -1} {
2498                    puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2499                }
2500                break
2501            }
2502            if {!$full} break
2503            set o [lindex $rowoffsets $y $x]
2504        }
2505    }
2506}
2507
2508proc makeuparrow {oid x y z} {
2509    global rowidlist rowoffsets uparrowlen idrowranges displayorder
2510
2511    for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2512        incr y -1
2513        incr x $z
2514        set off0 [lindex $rowoffsets $y]
2515        for {set x0 $x} {1} {incr x0} {
2516            if {$x0 >= [llength $off0]} {
2517                set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2518                break
2519            }
2520            set z [lindex $off0 $x0]
2521            if {$z ne {}} {
2522                incr x0 $z
2523                break
2524            }
2525        }
2526        set z [expr {$x0 - $x}]
2527        lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2528        lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2529    }
2530    set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2531    lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2532    lappend idrowranges($oid) [lindex $displayorder $y]
2533}
2534
2535proc initlayout {} {
2536    global rowidlist rowoffsets displayorder commitlisted
2537    global rowlaidout rowoptim
2538    global idinlist rowchk rowrangelist idrowranges
2539    global numcommits canvxmax canv
2540    global nextcolor
2541    global parentlist
2542    global colormap rowtextx
2543    global selectfirst
2544
2545    set numcommits 0
2546    set displayorder {}
2547    set commitlisted {}
2548    set parentlist {}
2549    set rowrangelist {}
2550    set nextcolor 0
2551    set rowidlist {{}}
2552    set rowoffsets {{}}
2553    catch {unset idinlist}
2554    catch {unset rowchk}
2555    set rowlaidout 0
2556    set rowoptim 0
2557    set canvxmax [$canv cget -width]
2558    catch {unset colormap}
2559    catch {unset rowtextx}
2560    catch {unset idrowranges}
2561    set selectfirst 1
2562}
2563
2564proc setcanvscroll {} {
2565    global canv canv2 canv3 numcommits linespc canvxmax canvy0
2566
2567    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2568    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2569    $canv2 conf -scrollregion [list 0 0 0 $ymax]
2570    $canv3 conf -scrollregion [list 0 0 0 $ymax]
2571}
2572
2573proc visiblerows {} {
2574    global canv numcommits linespc
2575
2576    set ymax [lindex [$canv cget -scrollregion] 3]
2577    if {$ymax eq {} || $ymax == 0} return
2578    set f [$canv yview]
2579    set y0 [expr {int([lindex $f 0] * $ymax)}]
2580    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2581    if {$r0 < 0} {
2582        set r0 0
2583    }
2584    set y1 [expr {int([lindex $f 1] * $ymax)}]
2585    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2586    if {$r1 >= $numcommits} {
2587        set r1 [expr {$numcommits - 1}]
2588    }
2589    return [list $r0 $r1]
2590}
2591
2592proc layoutmore {tmax allread} {
2593    global rowlaidout rowoptim commitidx numcommits optim_delay
2594    global uparrowlen curview rowidlist idinlist
2595
2596    set showlast 0
2597    set showdelay $optim_delay
2598    set optdelay [expr {$uparrowlen + 1}]
2599    while {1} {
2600        if {$rowoptim - $showdelay > $numcommits} {
2601            showstuff [expr {$rowoptim - $showdelay}] $showlast
2602        } elseif {$rowlaidout - $optdelay > $rowoptim} {
2603            set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2604            if {$nr > 100} {
2605                set nr 100
2606            }
2607            optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2608            incr rowoptim $nr
2609        } elseif {$commitidx($curview) > $rowlaidout} {
2610            set nr [expr {$commitidx($curview) - $rowlaidout}]
2611            # may need to increase this threshold if uparrowlen or
2612            # mingaplen are increased...
2613            if {$nr > 150} {
2614                set nr 150
2615            }
2616            set row $rowlaidout
2617            set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2618            if {$rowlaidout == $row} {
2619                return 0
2620            }
2621        } elseif {$allread} {
2622            set optdelay 0
2623            set nrows $commitidx($curview)
2624            if {[lindex $rowidlist $nrows] ne {} ||
2625                [array names idinlist] ne {}} {
2626                layouttail
2627                set rowlaidout $commitidx($curview)
2628            } elseif {$rowoptim == $nrows} {
2629                set showdelay 0
2630                set showlast 1
2631                if {$numcommits == $nrows} {
2632                    return 0
2633                }
2634            }
2635        } else {
2636            return 0
2637        }
2638        if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2639            return 1
2640        }
2641    }
2642}
2643
2644proc showstuff {canshow last} {
2645    global numcommits commitrow pending_select selectedline curview
2646    global lookingforhead mainheadid displayorder nullid selectfirst
2647    global lastscrollset
2648
2649    if {$numcommits == 0} {
2650        global phase
2651        set phase "incrdraw"
2652        allcanvs delete all
2653    }
2654    set r0 $numcommits
2655    set prev $numcommits
2656    set numcommits $canshow
2657    set t [clock clicks -milliseconds]
2658    if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2659        set lastscrollset $t
2660        setcanvscroll
2661    }
2662    set rows [visiblerows]
2663    set r1 [lindex $rows 1]
2664    if {$r1 >= $canshow} {
2665        set r1 [expr {$canshow - 1}]
2666    }
2667    if {$r0 <= $r1} {
2668        drawcommits $r0 $r1
2669    }
2670    if {[info exists pending_select] &&
2671        [info exists commitrow($curview,$pending_select)] &&
2672        $commitrow($curview,$pending_select) < $numcommits} {
2673        selectline $commitrow($curview,$pending_select) 1
2674    }
2675    if {$selectfirst} {
2676        if {[info exists selectedline] || [info exists pending_select]} {
2677            set selectfirst 0
2678        } else {
2679            set l [expr {[lindex $displayorder 0] eq $nullid}]
2680            selectline $l 1
2681            set selectfirst 0
2682        }
2683    }
2684    if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2685        && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2686        set lookingforhead 0
2687        dodiffindex
2688    }
2689}
2690
2691proc doshowlocalchanges {} {
2692    global lookingforhead curview mainheadid phase commitrow
2693
2694    if {[info exists commitrow($curview,$mainheadid)] &&
2695        ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2696        dodiffindex
2697    } elseif {$phase ne {}} {
2698        set lookingforhead 1
2699    }
2700}
2701
2702proc dohidelocalchanges {} {
2703    global lookingforhead localrow lserial
2704
2705    set lookingforhead 0
2706    if {$localrow >= 0} {
2707        removerow $localrow
2708        set localrow -1
2709    }
2710    incr lserial
2711}
2712
2713# spawn off a process to do git diff-index HEAD
2714proc dodiffindex {} {
2715    global localrow lserial
2716
2717    incr lserial
2718    set localrow -1
2719    set fd [open "|git diff-index HEAD" r]
2720    fconfigure $fd -blocking 0
2721    filerun $fd [list readdiffindex $fd $lserial]
2722}
2723
2724proc readdiffindex {fd serial} {
2725    global localrow commitrow mainheadid nullid curview
2726    global commitinfo commitdata lserial
2727
2728    if {[gets $fd line] < 0} {
2729        if {[eof $fd]} {
2730            close $fd
2731            return 0
2732        }
2733        return 1
2734    }
2735    # we only need to see one line and we don't really care what it says...
2736    close $fd
2737
2738    if {$serial == $lserial && $localrow == -1} {
2739        # add the line for the local diff to the graph
2740        set localrow $commitrow($curview,$mainheadid)
2741        set hl "Local uncommitted changes"
2742        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2743        set commitdata($nullid) "\n    $hl\n"
2744        insertrow $localrow $nullid
2745    }
2746    return 0
2747}
2748
2749proc layoutrows {row endrow last} {
2750    global rowidlist rowoffsets displayorder
2751    global uparrowlen downarrowlen maxwidth mingaplen
2752    global children parentlist
2753    global idrowranges
2754    global commitidx curview
2755    global idinlist rowchk rowrangelist
2756
2757    set idlist [lindex $rowidlist $row]
2758    set offs [lindex $rowoffsets $row]
2759    while {$row < $endrow} {
2760        set id [lindex $displayorder $row]
2761        set oldolds {}
2762        set newolds {}
2763        foreach p [lindex $parentlist $row] {
2764            if {![info exists idinlist($p)]} {
2765                lappend newolds $p
2766            } elseif {!$idinlist($p)} {
2767                lappend oldolds $p
2768            }
2769        }
2770        set nev [expr {[llength $idlist] + [llength $newolds]
2771                       + [llength $oldolds] - $maxwidth + 1}]
2772        if {$nev > 0} {
2773            if {!$last &&
2774                $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2775            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2776                set i [lindex $idlist $x]
2777                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2778                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
2779                               [expr {$row + $uparrowlen + $mingaplen}]]
2780                    if {$r == 0} {
2781                        set idlist [lreplace $idlist $x $x]
2782                        set offs [lreplace $offs $x $x]
2783                        set offs [incrange $offs $x 1]
2784                        set idinlist($i) 0
2785                        set rm1 [expr {$row - 1}]
2786                        lappend idrowranges($i) [lindex $displayorder $rm1]
2787                        if {[incr nev -1] <= 0} break
2788                        continue
2789                    }
2790                    set rowchk($id) [expr {$row + $r}]
2791                }
2792            }
2793            lset rowidlist $row $idlist
2794            lset rowoffsets $row $offs
2795        }
2796        set col [lsearch -exact $idlist $id]
2797        if {$col < 0} {
2798            set col [llength $idlist]
2799            lappend idlist $id
2800            lset rowidlist $row $idlist
2801            set z {}
2802            if {$children($curview,$id) ne {}} {
2803                set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2804                unset idinlist($id)
2805            }
2806            lappend offs $z
2807            lset rowoffsets $row $offs
2808            if {$z ne {}} {
2809                makeuparrow $id $col $row $z
2810            }
2811        } else {
2812            unset idinlist($id)
2813        }
2814        set ranges {}
2815        if {[info exists idrowranges($id)]} {
2816            set ranges $idrowranges($id)
2817            lappend ranges $id
2818            unset idrowranges($id)
2819        }
2820        lappend rowrangelist $ranges
2821        incr row
2822        set offs [ntimes [llength $idlist] 0]
2823        set l [llength $newolds]
2824        set idlist [eval lreplace \$idlist $col $col $newolds]
2825        set o 0
2826        if {$l != 1} {
2827            set offs [lrange $offs 0 [expr {$col - 1}]]
2828            foreach x $newolds {
2829                lappend offs {}
2830                incr o -1
2831            }
2832            incr o
2833            set tmp [expr {[llength $idlist] - [llength $offs]}]
2834            if {$tmp > 0} {
2835                set offs [concat $offs [ntimes $tmp $o]]
2836            }
2837        } else {
2838            lset offs $col {}
2839        }
2840        foreach i $newolds {
2841            set idinlist($i) 1
2842            set idrowranges($i) $id
2843        }
2844        incr col $l
2845        foreach oid $oldolds {
2846            set idinlist($oid) 1
2847            set idlist [linsert $idlist $col $oid]
2848            set offs [linsert $offs $col $o]
2849            makeuparrow $oid $col $row $o
2850            incr col
2851        }
2852        lappend rowidlist $idlist
2853        lappend rowoffsets $offs
2854    }
2855    return $row
2856}
2857
2858proc addextraid {id row} {
2859    global displayorder commitrow commitinfo
2860    global commitidx commitlisted
2861    global parentlist children curview
2862
2863    incr commitidx($curview)
2864    lappend displayorder $id
2865    lappend commitlisted 0
2866    lappend parentlist {}
2867    set commitrow($curview,$id) $row
2868    readcommit $id
2869    if {![info exists commitinfo($id)]} {
2870        set commitinfo($id) {"No commit information available"}
2871    }
2872    if {![info exists children($curview,$id)]} {
2873        set children($curview,$id) {}
2874    }
2875}
2876
2877proc layouttail {} {
2878    global rowidlist rowoffsets idinlist commitidx curview
2879    global idrowranges rowrangelist
2880
2881    set row $commitidx($curview)
2882    set idlist [lindex $rowidlist $row]
2883    while {$idlist ne {}} {
2884        set col [expr {[llength $idlist] - 1}]
2885        set id [lindex $idlist $col]
2886        addextraid $id $row
2887        unset idinlist($id)
2888        lappend idrowranges($id) $id
2889        lappend rowrangelist $idrowranges($id)
2890        unset idrowranges($id)
2891        incr row
2892        set offs [ntimes $col 0]
2893        set idlist [lreplace $idlist $col $col]
2894        lappend rowidlist $idlist
2895        lappend rowoffsets $offs
2896    }
2897
2898    foreach id [array names idinlist] {
2899        unset idinlist($id)
2900        addextraid $id $row
2901        lset rowidlist $row [list $id]
2902        lset rowoffsets $row 0
2903        makeuparrow $id 0 $row 0
2904        lappend idrowranges($id) $id
2905        lappend rowrangelist $idrowranges($id)
2906        unset idrowranges($id)
2907        incr row
2908        lappend rowidlist {}
2909        lappend rowoffsets {}
2910    }
2911}
2912
2913proc insert_pad {row col npad} {
2914    global rowidlist rowoffsets
2915
2916    set pad [ntimes $npad {}]
2917    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2918    set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2919    lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2920}
2921
2922proc optimize_rows {row col endrow} {
2923    global rowidlist rowoffsets displayorder
2924
2925    for {} {$row < $endrow} {incr row} {
2926        set idlist [lindex $rowidlist $row]
2927        set offs [lindex $rowoffsets $row]
2928        set haspad 0
2929        for {} {$col < [llength $offs]} {incr col} {
2930            if {[lindex $idlist $col] eq {}} {
2931                set haspad 1
2932                continue
2933            }
2934            set z [lindex $offs $col]
2935            if {$z eq {}} continue
2936            set isarrow 0
2937            set x0 [expr {$col + $z}]
2938            set y0 [expr {$row - 1}]
2939            set z0 [lindex $rowoffsets $y0 $x0]
2940            if {$z0 eq {}} {
2941                set id [lindex $idlist $col]
2942                set ranges [rowranges $id]
2943                if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2944                    set isarrow 1
2945                }
2946            }
2947            # Looking at lines from this row to the previous row,
2948            # make them go straight up if they end in an arrow on
2949            # the previous row; otherwise make them go straight up
2950            # or at 45 degrees.
2951            if {$z < -1 || ($z < 0 && $isarrow)} {
2952                # Line currently goes left too much;
2953                # insert pads in the previous row, then optimize it
2954                set npad [expr {-1 - $z + $isarrow}]
2955                set offs [incrange $offs $col $npad]
2956                insert_pad $y0 $x0 $npad
2957                if {$y0 > 0} {
2958                    optimize_rows $y0 $x0 $row
2959                }
2960                set z [lindex $offs $col]
2961                set x0 [expr {$col + $z}]
2962                set z0 [lindex $rowoffsets $y0 $x0]
2963            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2964                # Line currently goes right too much;
2965                # insert pads in this line and adjust the next's rowoffsets
2966                set npad [expr {$z - 1 + $isarrow}]
2967                set y1 [expr {$row + 1}]
2968                set offs2 [lindex $rowoffsets $y1]
2969                set x1 -1
2970                foreach z $offs2 {
2971                    incr x1
2972                    if {$z eq {} || $x1 + $z < $col} continue
2973                    if {$x1 + $z > $col} {
2974                        incr npad
2975                    }
2976                    lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2977                    break
2978                }
2979                set pad [ntimes $npad {}]
2980                set idlist [eval linsert \$idlist $col $pad]
2981                set tmp [eval linsert \$offs $col $pad]
2982                incr col $npad
2983                set offs [incrange $tmp $col [expr {-$npad}]]
2984                set z [lindex $offs $col]
2985                set haspad 1
2986            }
2987            if {$z0 eq {} && !$isarrow} {
2988                # this line links to its first child on row $row-2
2989                set rm2 [expr {$row - 2}]
2990                set id [lindex $displayorder $rm2]
2991                set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2992                if {$xc >= 0} {
2993                    set z0 [expr {$xc - $x0}]
2994                }
2995            }
2996            # avoid lines jigging left then immediately right
2997            if {$z0 ne {} && $z < 0 && $z0 > 0} {
2998                insert_pad $y0 $x0 1
2999                set offs [incrange $offs $col 1]
3000                optimize_rows $y0 [expr {$x0 + 1}] $row
3001            }
3002        }
3003        if {!$haspad} {
3004            set o {}
3005            # Find the first column that doesn't have a line going right
3006            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3007                set o [lindex $offs $col]
3008                if {$o eq {}} {
3009                    # check if this is the link to the first child
3010                    set id [lindex $idlist $col]
3011                    set ranges [rowranges $id]
3012                    if {$ranges ne {} && $row == [lindex $ranges 0]} {
3013                        # it is, work out offset to child
3014                        set y0 [expr {$row - 1}]
3015                        set id [lindex $displayorder $y0]
3016                        set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3017                        if {$x0 >= 0} {
3018                            set o [expr {$x0 - $col}]
3019                        }
3020                    }
3021                }
3022                if {$o eq {} || $o <= 0} break
3023            }
3024            # Insert a pad at that column as long as it has a line and
3025            # isn't the last column, and adjust the next row' offsets
3026            if {$o ne {} && [incr col] < [llength $idlist]} {
3027                set y1 [expr {$row + 1}]
3028                set offs2 [lindex $rowoffsets $y1]
3029                set x1 -1
3030                foreach z $offs2 {
3031                    incr x1
3032                    if {$z eq {} || $x1 + $z < $col} continue
3033                    lset rowoffsets $y1 [incrange $offs2 $x1 1]
3034                    break
3035                }
3036                set idlist [linsert $idlist $col {}]
3037                set tmp [linsert $offs $col {}]
3038                incr col
3039                set offs [incrange $tmp $col -1]
3040            }
3041        }
3042        lset rowidlist $row $idlist
3043        lset rowoffsets $row $offs
3044        set col 0
3045    }
3046}
3047
3048proc xc {row col} {
3049    global canvx0 linespc
3050    return [expr {$canvx0 + $col * $linespc}]
3051}
3052
3053proc yc {row} {
3054    global canvy0 linespc
3055    return [expr {$canvy0 + $row * $linespc}]
3056}
3057
3058proc linewidth {id} {
3059    global thickerline lthickness
3060
3061    set wid $lthickness
3062    if {[info exists thickerline] && $id eq $thickerline} {
3063        set wid [expr {2 * $lthickness}]
3064    }
3065    return $wid
3066}
3067
3068proc rowranges {id} {
3069    global phase idrowranges commitrow rowlaidout rowrangelist curview
3070
3071    set ranges {}
3072    if {$phase eq {} ||
3073        ([info exists commitrow($curview,$id)]
3074         && $commitrow($curview,$id) < $rowlaidout)} {
3075        set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3076    } elseif {[info exists idrowranges($id)]} {
3077        set ranges $idrowranges($id)
3078    }
3079    set linenos {}
3080    foreach rid $ranges {
3081        lappend linenos $commitrow($curview,$rid)
3082    }
3083    if {$linenos ne {}} {
3084        lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3085    }
3086    return $linenos
3087}
3088
3089# work around tk8.4 refusal to draw arrows on diagonal segments
3090proc adjarrowhigh {coords} {
3091    global linespc
3092
3093    set x0 [lindex $coords 0]
3094    set x1 [lindex $coords 2]
3095    if {$x0 != $x1} {
3096        set y0 [lindex $coords 1]
3097        set y1 [lindex $coords 3]
3098        if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3099            # we have a nearby vertical segment, just trim off the diag bit
3100            set coords [lrange $coords 2 end]
3101        } else {
3102            set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3103            set xi [expr {$x0 - $slope * $linespc / 2}]
3104            set yi [expr {$y0 - $linespc / 2}]
3105            set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3106        }
3107    }
3108    return $coords
3109}
3110
3111proc drawlineseg {id row endrow arrowlow} {
3112    global rowidlist displayorder iddrawn linesegs
3113    global canv colormap linespc curview maxlinelen
3114
3115    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3116    set le [expr {$row + 1}]
3117    set arrowhigh 1
3118    while {1} {
3119        set c [lsearch -exact [lindex $rowidlist $le] $id]
3120        if {$c < 0} {
3121            incr le -1
3122            break
3123        }
3124        lappend cols $c
3125        set x [lindex $displayorder $le]
3126        if {$x eq $id} {
3127            set arrowhigh 0
3128            break
3129        }
3130        if {[info exists iddrawn($x)] || $le == $endrow} {
3131            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3132            if {$c >= 0} {
3133                lappend cols $c
3134                set arrowhigh 0
3135            }
3136            break
3137        }
3138        incr le
3139    }
3140    if {$le <= $row} {
3141        return $row
3142    }
3143
3144    set lines {}
3145    set i 0
3146    set joinhigh 0
3147    if {[info exists linesegs($id)]} {
3148        set lines $linesegs($id)
3149        foreach li $lines {
3150            set r0 [lindex $li 0]
3151            if {$r0 > $row} {
3152                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3153                    set joinhigh 1
3154                }
3155                break
3156            }
3157            incr i
3158        }
3159    }
3160    set joinlow 0
3161    if {$i > 0} {
3162        set li [lindex $lines [expr {$i-1}]]
3163        set r1 [lindex $li 1]
3164        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3165            set joinlow 1
3166        }
3167    }
3168
3169    set x [lindex $cols [expr {$le - $row}]]
3170    set xp [lindex $cols [expr {$le - 1 - $row}]]
3171    set dir [expr {$xp - $x}]
3172    if {$joinhigh} {
3173        set ith [lindex $lines $i 2]
3174        set coords [$canv coords $ith]
3175        set ah [$canv itemcget $ith -arrow]
3176        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3177        set x2 [lindex $cols [expr {$le + 1 - $row}]]
3178        if {$x2 ne {} && $x - $x2 == $dir} {
3179            set coords [lrange $coords 0 end-2]
3180        }
3181    } else {
3182        set coords [list [xc $le $x] [yc $le]]
3183    }
3184    if {$joinlow} {
3185        set itl [lindex $lines [expr {$i-1}] 2]
3186        set al [$canv itemcget $itl -arrow]
3187        set arrowlow [expr {$al eq "last" || $al eq "both"}]
3188    } elseif {$arrowlow &&
3189              [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3190        set arrowlow 0
3191    }
3192    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3193    for {set y $le} {[incr y -1] > $row} {} {
3194        set x $xp
3195        set xp [lindex $cols [expr {$y - 1 - $row}]]
3196        set ndir [expr {$xp - $x}]
3197        if {$dir != $ndir || $xp < 0} {
3198            lappend coords [xc $y $x] [yc $y]
3199        }
3200        set dir $ndir
3201    }
3202    if {!$joinlow} {
3203        if {$xp < 0} {
3204            # join parent line to first child
3205            set ch [lindex $displayorder $row]
3206            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3207            if {$xc < 0} {
3208                puts "oops: drawlineseg: child $ch not on row $row"
3209            } else {
3210                if {$xc < $x - 1} {
3211                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
3212                } elseif {$xc > $x + 1} {
3213                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
3214                }
3215                set x $xc
3216            }
3217            lappend coords [xc $row $x] [yc $row]
3218        } else {
3219            set xn [xc $row $xp]
3220            set yn [yc $row]
3221            # work around tk8.4 refusal to draw arrows on diagonal segments
3222            if {$arrowlow && $xn != [lindex $coords end-1]} {
3223                if {[llength $coords] < 4 ||
3224                    [lindex $coords end-3] != [lindex $coords end-1] ||
3225                    [lindex $coords end] - $yn > 2 * $linespc} {
3226                    set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3227                    set yo [yc [expr {$row + 0.5}]]
3228                    lappend coords $xn $yo $xn $yn
3229                }
3230            } else {
3231                lappend coords $xn $yn
3232            }
3233        }
3234        if {!$joinhigh} {
3235            if {$arrowhigh} {
3236                set coords [adjarrowhigh $coords]
3237            }
3238            assigncolor $id
3239            set t [$canv create line $coords -width [linewidth $id] \
3240                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
3241            $canv lower $t
3242            bindline $t $id
3243            set lines [linsert $lines $i [list $row $le $t]]
3244        } else {
3245            $canv coords $ith $coords
3246            if {$arrow ne $ah} {
3247                $canv itemconf $ith -arrow $arrow
3248            }
3249            lset lines $i 0 $row
3250        }
3251    } else {
3252        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3253        set ndir [expr {$xo - $xp}]
3254        set clow [$canv coords $itl]
3255        if {$dir == $ndir} {
3256            set clow [lrange $clow 2 end]
3257        }
3258        set coords [concat $coords $clow]
3259        if {!$joinhigh} {
3260            lset lines [expr {$i-1}] 1 $le
3261            if {$arrowhigh} {
3262                set coords [adjarrowhigh $coords]
3263            }
3264        } else {
3265            # coalesce two pieces
3266            $canv delete $ith
3267            set b [lindex $lines [expr {$i-1}] 0]
3268            set e [lindex $lines $i 1]
3269            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3270        }
3271        $canv coords $itl $coords
3272        if {$arrow ne $al} {
3273            $canv itemconf $itl -arrow $arrow
3274        }
3275    }
3276
3277    set linesegs($id) $lines
3278    return $le
3279}
3280
3281proc drawparentlinks {id row} {
3282    global rowidlist canv colormap curview parentlist
3283    global idpos
3284
3285    set rowids [lindex $rowidlist $row]
3286    set col [lsearch -exact $rowids $id]
3287    if {$col < 0} return
3288    set olds [lindex $parentlist $row]
3289    set row2 [expr {$row + 1}]
3290    set x [xc $row $col]
3291    set y [yc $row]
3292    set y2 [yc $row2]
3293    set ids [lindex $rowidlist $row2]
3294    # rmx = right-most X coord used
3295    set rmx 0
3296    foreach p $olds {
3297        set i [lsearch -exact $ids $p]
3298        if {$i < 0} {
3299            puts "oops, parent $p of $id not in list"
3300            continue
3301        }
3302        set x2 [xc $row2 $i]
3303        if {$x2 > $rmx} {
3304            set rmx $x2
3305        }
3306        if {[lsearch -exact $rowids $p] < 0} {
3307            # drawlineseg will do this one for us
3308            continue
3309        }
3310        assigncolor $p
3311        # should handle duplicated parents here...
3312        set coords [list $x $y]
3313        if {$i < $col - 1} {
3314            lappend coords [xc $row [expr {$i + 1}]] $y
3315        } elseif {$i > $col + 1} {
3316            lappend coords [xc $row [expr {$i - 1}]] $y
3317        }
3318        lappend coords $x2 $y2
3319        set t [$canv create line $coords -width [linewidth $p] \
3320                   -fill $colormap($p) -tags lines.$p]
3321        $canv lower $t
3322        bindline $t $p
3323    }
3324    if {$rmx > [lindex $idpos($id) 1]} {
3325        lset idpos($id) 1 $rmx
3326        redrawtags $id
3327    }
3328}
3329
3330proc drawlines {id} {
3331    global canv
3332
3333    $canv itemconf lines.$id -width [linewidth $id]
3334}
3335
3336proc drawcmittext {id row col} {
3337    global linespc canv canv2 canv3 canvy0 fgcolor curview
3338    global commitlisted commitinfo rowidlist parentlist
3339    global rowtextx idpos idtags idheads idotherrefs
3340    global linehtag linentag linedtag markingmatches
3341    global mainfont canvxmax boldrows boldnamerows fgcolor nullid
3342
3343    # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3344    set listed [lindex $commitlisted $row]
3345    if {$id eq $nullid} {
3346        set ofill red
3347    } else {
3348        set ofill [expr {$listed != 0? "blue": "white"}]
3349    }
3350    set x [xc $row $col]
3351    set y [yc $row]
3352    set orad [expr {$linespc / 3}]
3353    if {$listed <= 1} {
3354        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3355                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3356                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3357    } elseif {$listed == 2} {
3358        # triangle pointing left for left-side commits
3359        set t [$canv create polygon \
3360                   [expr {$x - $orad}] $y \
3361                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3362                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3363                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3364    } else {
3365        # triangle pointing right for right-side commits
3366        set t [$canv create polygon \
3367                   [expr {$x + $orad - 1}] $y \
3368                   [expr {$x - $orad}] [expr {$y - $orad}] \
3369                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3370                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3371    }
3372    $canv raise $t
3373    $canv bind $t <1> {selcanvline {} %x %y}
3374    set rmx [llength [lindex $rowidlist $row]]
3375    set olds [lindex $parentlist $row]
3376    if {$olds ne {}} {
3377        set nextids [lindex $rowidlist [expr {$row + 1}]]
3378        foreach p $olds {
3379            set i [lsearch -exact $nextids $p]
3380            if {$i > $rmx} {
3381                set rmx $i
3382            }
3383        }
3384    }
3385    set xt [xc $row $rmx]
3386    set rowtextx($row) $xt
3387    set idpos($id) [list $x $xt $y]
3388    if {[info exists idtags($id)] || [info exists idheads($id)]
3389        || [info exists idotherrefs($id)]} {
3390        set xt [drawtags $id $x $xt $y]
3391    }
3392    set headline [lindex $commitinfo($id) 0]
3393    set name [lindex $commitinfo($id) 1]
3394    set date [lindex $commitinfo($id) 2]
3395    set date [formatdate $date]
3396    set font $mainfont
3397    set nfont $mainfont
3398    set isbold [ishighlighted $row]
3399    if {$isbold > 0} {
3400        lappend boldrows $row
3401        lappend font bold
3402        if {$isbold > 1} {
3403            lappend boldnamerows $row
3404            lappend nfont bold
3405        }
3406    }
3407    set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3408                            -text $headline -font $font -tags text]
3409    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3410    set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3411                            -text $name -font $nfont -tags text]
3412    set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3413                            -text $date -font $mainfont -tags text]
3414    set xr [expr {$xt + [font measure $mainfont $headline]}]
3415    if {$markingmatches} {
3416        markrowmatches $row $headline $name
3417    }
3418    if {$xr > $canvxmax} {
3419        set canvxmax $xr
3420        setcanvscroll
3421    }
3422}
3423
3424proc drawcmitrow {row} {
3425    global displayorder rowidlist
3426    global iddrawn
3427    global commitinfo parentlist numcommits
3428    global filehighlight fhighlights findstring nhighlights
3429    global hlview vhighlights
3430    global highlight_related rhighlights
3431
3432    if {$row >= $numcommits} return
3433
3434    set id [lindex $displayorder $row]
3435    if {[info exists hlview] && ![info exists vhighlights($row)]} {
3436        askvhighlight $row $id
3437    }
3438    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3439        askfilehighlight $row $id
3440    }
3441    if {$findstring ne {} && ![info exists nhighlights($row)]} {
3442        askfindhighlight $row $id
3443    }
3444    if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3445        askrelhighlight $row $id
3446    }
3447    if {[info exists iddrawn($id)]} return
3448    set col [lsearch -exact [lindex $rowidlist $row] $id]
3449    if {$col < 0} {
3450        puts "oops, row $row id $id not in list"
3451        return
3452    }
3453    if {![info exists commitinfo($id)]} {
3454        getcommit $id
3455    }
3456    assigncolor $id
3457    drawcmittext $id $row $col
3458    set iddrawn($id) 1
3459}
3460
3461proc drawcommits {row {endrow {}}} {
3462    global numcommits iddrawn displayorder curview
3463    global parentlist rowidlist
3464
3465    if {$row < 0} {
3466        set row 0
3467    }
3468    if {$endrow eq {}} {
3469        set endrow $row
3470    }
3471    if {$endrow >= $numcommits} {
3472        set endrow [expr {$numcommits - 1}]
3473    }
3474
3475    # make the lines join to already-drawn rows either side
3476    set r [expr {$row - 1}]
3477    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3478        set r $row
3479    }
3480    set er [expr {$endrow + 1}]
3481    if {$er >= $numcommits ||
3482        ![info exists iddrawn([lindex $displayorder $er])]} {
3483        set er $endrow
3484    }
3485    for {} {$r <= $er} {incr r} {
3486        set id [lindex $displayorder $r]
3487        set wasdrawn [info exists iddrawn($id)]
3488        drawcmitrow $r
3489        if {$r == $er} break
3490        set nextid [lindex $displayorder [expr {$r + 1}]]
3491        if {$wasdrawn && [info exists iddrawn($nextid)]} {
3492            catch {unset prevlines}
3493            continue
3494        }
3495        drawparentlinks $id $r
3496
3497        if {[info exists lineends($r)]} {
3498            foreach lid $lineends($r) {
3499                unset prevlines($lid)
3500            }
3501        }
3502        set rowids [lindex $rowidlist $r]
3503        foreach lid $rowids {
3504            if {$lid eq {}} continue
3505            if {$lid eq $id} {
3506                # see if this is the first child of any of its parents
3507                foreach p [lindex $parentlist $r] {
3508                    if {[lsearch -exact $rowids $p] < 0} {
3509                        # make this line extend up to the child
3510                        set le [drawlineseg $p $r $er 0]
3511                        lappend lineends($le) $p
3512                        set prevlines($p) 1
3513                    }
3514                }
3515            } elseif {![info exists prevlines($lid)]} {
3516                set le [drawlineseg $lid $r $er 1]
3517                lappend lineends($le) $lid
3518                set prevlines($lid) 1
3519            }
3520        }
3521    }
3522}
3523
3524proc drawfrac {f0 f1} {
3525    global canv linespc
3526
3527    set ymax [lindex [$canv cget -scrollregion] 3]
3528    if {$ymax eq {} || $ymax == 0} return
3529    set y0 [expr {int($f0 * $ymax)}]
3530    set row [expr {int(($y0 - 3) / $linespc) - 1}]
3531    set y1 [expr {int($f1 * $ymax)}]
3532    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3533    drawcommits $row $endrow
3534}
3535
3536proc drawvisible {} {
3537    global canv
3538    eval drawfrac [$canv yview]
3539}
3540
3541proc clear_display {} {
3542    global iddrawn linesegs
3543    global vhighlights fhighlights nhighlights rhighlights
3544
3545    allcanvs delete all
3546    catch {unset iddrawn}
3547    catch {unset linesegs}
3548    catch {unset vhighlights}
3549    catch {unset fhighlights}
3550    catch {unset nhighlights}
3551    catch {unset rhighlights}
3552}
3553
3554proc findcrossings {id} {
3555    global rowidlist parentlist numcommits rowoffsets displayorder
3556
3557    set cross {}
3558    set ccross {}
3559    foreach {s e} [rowranges $id] {
3560        if {$e >= $numcommits} {
3561            set e [expr {$numcommits - 1}]
3562        }
3563        if {$e <= $s} continue
3564        set x [lsearch -exact [lindex $rowidlist $e] $id]
3565        if {$x < 0} {
3566            puts "findcrossings: oops, no [shortids $id] in row $e"
3567            continue
3568        }
3569        for {set row $e} {[incr row -1] >= $s} {} {
3570            set olds [lindex $parentlist $row]
3571            set kid [lindex $displayorder $row]
3572            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3573            if {$kidx < 0} continue
3574            set nextrow [lindex $rowidlist [expr {$row + 1}]]
3575            foreach p $olds {
3576                set px [lsearch -exact $nextrow $p]
3577                if {$px < 0} continue
3578                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3579                    if {[lsearch -exact $ccross $p] >= 0} continue
3580                    if {$x == $px + ($kidx < $px? -1: 1)} {
3581                        lappend ccross $p
3582                    } elseif {[lsearch -exact $cross $p] < 0} {
3583                        lappend cross $p
3584                    }
3585                }
3586            }
3587            set inc [lindex $rowoffsets $row $x]
3588            if {$inc eq {}} break
3589            incr x $inc
3590        }
3591    }
3592    return [concat $ccross {{}} $cross]
3593}
3594
3595proc assigncolor {id} {
3596    global colormap colors nextcolor
3597    global commitrow parentlist children children curview
3598
3599    if {[info exists colormap($id)]} return
3600    set ncolors [llength $colors]
3601    if {[info exists children($curview,$id)]} {
3602        set kids $children($curview,$id)
3603    } else {
3604        set kids {}
3605    }
3606    if {[llength $kids] == 1} {
3607        set child [lindex $kids 0]
3608        if {[info exists colormap($child)]
3609            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3610            set colormap($id) $colormap($child)
3611            return
3612        }
3613    }
3614    set badcolors {}
3615    set origbad {}
3616    foreach x [findcrossings $id] {
3617        if {$x eq {}} {
3618            # delimiter between corner crossings and other crossings
3619            if {[llength $badcolors] >= $ncolors - 1} break
3620            set origbad $badcolors
3621        }
3622        if {[info exists colormap($x)]
3623            && [lsearch -exact $badcolors $colormap($x)] < 0} {
3624            lappend badcolors $colormap($x)
3625        }
3626    }
3627    if {[llength $badcolors] >= $ncolors} {
3628        set badcolors $origbad
3629    }
3630    set origbad $badcolors
3631    if {[llength $badcolors] < $ncolors - 1} {
3632        foreach child $kids {
3633            if {[info exists colormap($child)]
3634                && [lsearch -exact $badcolors $colormap($child)] < 0} {
3635                lappend badcolors $colormap($child)
3636            }
3637            foreach p [lindex $parentlist $commitrow($curview,$child)] {
3638                if {[info exists colormap($p)]
3639                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
3640                    lappend badcolors $colormap($p)
3641                }
3642            }
3643        }
3644        if {[llength $badcolors] >= $ncolors} {
3645            set badcolors $origbad
3646        }
3647    }
3648    for {set i 0} {$i <= $ncolors} {incr i} {
3649        set c [lindex $colors $nextcolor]
3650        if {[incr nextcolor] >= $ncolors} {
3651            set nextcolor 0
3652        }
3653        if {[lsearch -exact $badcolors $c]} break
3654    }
3655    set colormap($id) $c
3656}
3657
3658proc bindline {t id} {
3659    global canv
3660
3661    $canv bind $t <Enter> "lineenter %x %y $id"
3662    $canv bind $t <Motion> "linemotion %x %y $id"
3663    $canv bind $t <Leave> "lineleave $id"
3664    $canv bind $t <Button-1> "lineclick %x %y $id 1"
3665}
3666
3667proc drawtags {id x xt y1} {
3668    global idtags idheads idotherrefs mainhead
3669    global linespc lthickness
3670    global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3671
3672    set marks {}
3673    set ntags 0
3674    set nheads 0
3675    if {[info exists idtags($id)]} {
3676        set marks $idtags($id)
3677        set ntags [llength $marks]
3678    }
3679    if {[info exists idheads($id)]} {
3680        set marks [concat $marks $idheads($id)]
3681        set nheads [llength $idheads($id)]
3682    }
3683    if {[info exists idotherrefs($id)]} {
3684        set marks [concat $marks $idotherrefs($id)]
3685    }
3686    if {$marks eq {}} {
3687        return $xt
3688    }
3689
3690    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3691    set yt [expr {$y1 - 0.5 * $linespc}]
3692    set yb [expr {$yt + $linespc - 1}]
3693    set xvals {}
3694    set wvals {}
3695    set i -1
3696    foreach tag $marks {
3697        incr i
3698        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3699            set wid [font measure [concat $mainfont bold] $tag]
3700        } else {
3701            set wid [font measure $mainfont $tag]
3702        }
3703        lappend xvals $xt
3704        lappend wvals $wid
3705        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3706    }
3707    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3708               -width $lthickness -fill black -tags tag.$id]
3709    $canv lower $t
3710    foreach tag $marks x $xvals wid $wvals {
3711        set xl [expr {$x + $delta}]
3712        set xr [expr {$x + $delta + $wid + $lthickness}]
3713        set font $mainfont
3714        if {[incr ntags -1] >= 0} {
3715            # draw a tag
3716            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3717                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3718                       -width 1 -outline black -fill yellow -tags tag.$id]
3719            $canv bind $t <1> [list showtag $tag 1]
3720            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3721        } else {
3722            # draw a head or other ref
3723            if {[incr nheads -1] >= 0} {
3724                set col green
3725                if {$tag eq $mainhead} {
3726                    lappend font bold
3727                }
3728            } else {
3729                set col "#ddddff"
3730            }
3731            set xl [expr {$xl - $delta/2}]
3732            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3733                -width 1 -outline black -fill $col -tags tag.$id
3734            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3735                set rwid [font measure $mainfont $remoteprefix]
3736                set xi [expr {$x + 1}]
3737                set yti [expr {$yt + 1}]
3738                set xri [expr {$x + $rwid}]
3739                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3740                        -width 0 -fill "#ffddaa" -tags tag.$id
3741            }
3742        }
3743        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3744                   -font $font -tags [list tag.$id text]]
3745        if {$ntags >= 0} {
3746            $canv bind $t <1> [list showtag $tag 1]
3747        } elseif {$nheads >= 0} {
3748            $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3749        }
3750    }
3751    return $xt
3752}
3753
3754proc xcoord {i level ln} {
3755    global canvx0 xspc1 xspc2
3756
3757    set x [expr {$canvx0 + $i * $xspc1($ln)}]
3758    if {$i > 0 && $i == $level} {
3759        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3760    } elseif {$i > $level} {
3761        set x [expr {$x + $xspc2 - $xspc1($ln)}]
3762    }
3763    return $x
3764}
3765
3766proc show_status {msg} {
3767    global canv mainfont fgcolor
3768
3769    clear_display
3770    $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3771        -tags text -fill $fgcolor
3772}
3773
3774# Insert a new commit as the child of the commit on row $row.
3775# The new commit will be displayed on row $row and the commits
3776# on that row and below will move down one row.
3777proc insertrow {row newcmit} {
3778    global displayorder parentlist commitlisted children
3779    global commitrow curview rowidlist rowoffsets numcommits
3780    global rowrangelist rowlaidout rowoptim numcommits
3781    global selectedline rowchk commitidx
3782
3783    if {$row >= $numcommits} {
3784        puts "oops, inserting new row $row but only have $numcommits rows"
3785        return
3786    }
3787    set p [lindex $displayorder $row]
3788    set displayorder [linsert $displayorder $row $newcmit]
3789    set parentlist [linsert $parentlist $row $p]
3790    set kids $children($curview,$p)
3791    lappend kids $newcmit
3792    set children($curview,$p) $kids
3793    set children($curview,$newcmit) {}
3794    set commitlisted [linsert $commitlisted $row 1]
3795    set l [llength $displayorder]
3796    for {set r $row} {$r < $l} {incr r} {
3797        set id [lindex $displayorder $r]
3798        set commitrow($curview,$id) $r
3799    }
3800    incr commitidx($curview)
3801
3802    set idlist [lindex $rowidlist $row]
3803    set offs [lindex $rowoffsets $row]
3804    set newoffs {}
3805    foreach x $idlist {
3806        if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3807            lappend newoffs {}
3808        } else {
3809            lappend newoffs 0
3810        }
3811    }
3812    if {[llength $kids] == 1} {
3813        set col [lsearch -exact $idlist $p]
3814        lset idlist $col $newcmit
3815    } else {
3816        set col [llength $idlist]
3817        lappend idlist $newcmit
3818        lappend offs {}
3819        lset rowoffsets $row $offs
3820    }
3821    set rowidlist [linsert $rowidlist $row $idlist]
3822    set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3823
3824    set rowrangelist [linsert $rowrangelist $row {}]
3825    if {[llength $kids] > 1} {
3826        set rp1 [expr {$row + 1}]
3827        set ranges [lindex $rowrangelist $rp1]
3828        if {$ranges eq {}} {
3829            set ranges [list $newcmit $p]
3830        } elseif {[lindex $ranges end-1] eq $p} {
3831            lset ranges end-1 $newcmit
3832        }
3833        lset rowrangelist $rp1 $ranges
3834    }
3835
3836    catch {unset rowchk}
3837
3838    incr rowlaidout
3839    incr rowoptim
3840    incr numcommits
3841
3842    if {[info exists selectedline] && $selectedline >= $row} {
3843        incr selectedline
3844    }
3845    redisplay
3846}
3847
3848# Remove a commit that was inserted with insertrow on row $row.
3849proc removerow {row} {
3850    global displayorder parentlist commitlisted children
3851    global commitrow curview rowidlist rowoffsets numcommits
3852    global rowrangelist idrowranges rowlaidout rowoptim numcommits
3853    global linesegends selectedline rowchk commitidx
3854
3855    if {$row >= $numcommits} {
3856        puts "oops, removing row $row but only have $numcommits rows"
3857        return
3858    }
3859    set rp1 [expr {$row + 1}]
3860    set id [lindex $displayorder $row]
3861    set p [lindex $parentlist $row]
3862    set displayorder [lreplace $displayorder $row $row]
3863    set parentlist [lreplace $parentlist $row $row]
3864    set commitlisted [lreplace $commitlisted $row $row]
3865    set kids $children($curview,$p)
3866    set i [lsearch -exact $kids $id]
3867    if {$i >= 0} {
3868        set kids [lreplace $kids $i $i]
3869        set children($curview,$p) $kids
3870    }
3871    set l [llength $displayorder]
3872    for {set r $row} {$r < $l} {incr r} {
3873        set id [lindex $displayorder $r]
3874        set commitrow($curview,$id) $r
3875    }
3876    incr commitidx($curview) -1
3877
3878    set rowidlist [lreplace $rowidlist $row $row]
3879    set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3880    if {$kids ne {}} {
3881        set offs [lindex $rowoffsets $row]
3882        set offs [lreplace $offs end end]
3883        lset rowoffsets $row $offs
3884    }
3885
3886    set rowrangelist [lreplace $rowrangelist $row $row]
3887    if {[llength $kids] > 0} {
3888        set ranges [lindex $rowrangelist $row]
3889        if {[lindex $ranges end-1] eq $id} {
3890            set ranges [lreplace $ranges end-1 end]
3891            lset rowrangelist $row $ranges
3892        }
3893    }
3894
3895    catch {unset rowchk}
3896
3897    incr rowlaidout -1
3898    incr rowoptim -1
3899    incr numcommits -1
3900
3901    if {[info exists selectedline] && $selectedline > $row} {
3902        incr selectedline -1
3903    }
3904    redisplay
3905}
3906
3907# Don't change the text pane cursor if it is currently the hand cursor,
3908# showing that we are over a sha1 ID link.
3909proc settextcursor {c} {
3910    global ctext curtextcursor
3911
3912    if {[$ctext cget -cursor] == $curtextcursor} {
3913        $ctext config -cursor $c
3914    }
3915    set curtextcursor $c
3916}
3917
3918proc nowbusy {what} {
3919    global isbusy
3920
3921    if {[array names isbusy] eq {}} {
3922        . config -cursor watch
3923        settextcursor watch
3924    }
3925    set isbusy($what) 1
3926}
3927
3928proc notbusy {what} {
3929    global isbusy maincursor textcursor
3930
3931    catch {unset isbusy($what)}
3932    if {[array names isbusy] eq {}} {
3933        . config -cursor $maincursor
3934        settextcursor $textcursor
3935    }
3936}
3937
3938proc findmatches {f} {
3939    global findtype findstring
3940    if {$findtype == "Regexp"} {
3941        set matches [regexp -indices -all -inline $findstring $f]
3942    } else {
3943        set fs $findstring
3944        if {$findtype == "IgnCase"} {
3945            set f [string tolower $f]
3946            set fs [string tolower $fs]
3947        }
3948        set matches {}
3949        set i 0
3950        set l [string length $fs]
3951        while {[set j [string first $fs $f $i]] >= 0} {
3952            lappend matches [list $j [expr {$j+$l-1}]]
3953            set i [expr {$j + $l}]
3954        }
3955    }
3956    return $matches
3957}
3958
3959proc dofind {{rev 0}} {
3960    global findstring findstartline findcurline selectedline numcommits
3961
3962    unmarkmatches
3963    cancel_next_highlight
3964    focus .
3965    if {$findstring eq {} || $numcommits == 0} return
3966    if {![info exists selectedline]} {
3967        set findstartline [lindex [visiblerows] $rev]
3968    } else {
3969        set findstartline $selectedline
3970    }
3971    set findcurline $findstartline
3972    nowbusy finding
3973    if {!$rev} {
3974        run findmore
3975    } else {
3976        set findcurline $findstartline
3977        if {$findcurline == 0} {
3978            set findcurline $numcommits
3979        }
3980        incr findcurline -1
3981        run findmorerev
3982    }
3983}
3984
3985proc findnext {restart} {
3986    global findcurline
3987    if {![info exists findcurline]} {
3988        if {$restart} {
3989            dofind
3990        } else {
3991            bell
3992        }
3993    } else {
3994        run findmore
3995        nowbusy finding
3996    }
3997}
3998
3999proc findprev {} {
4000    global findcurline
4001    if {![info exists findcurline]} {
4002        dofind 1
4003    } else {
4004        run findmorerev
4005        nowbusy finding
4006    }
4007}
4008
4009proc findmore {} {
4010    global commitdata commitinfo numcommits findstring findpattern findloc
4011    global findstartline findcurline markingmatches displayorder
4012
4013    set fldtypes {Headline Author Date Committer CDate Comments}
4014    set l [expr {$findcurline + 1}]
4015    if {$l >= $numcommits} {
4016        set l 0
4017    }
4018    if {$l <= $findstartline} {
4019        set lim [expr {$findstartline + 1}]
4020    } else {
4021        set lim $numcommits
4022    }
4023    if {$lim - $l > 500} {
4024        set lim [expr {$l + 500}]
4025    }
4026    set last 0
4027    for {} {$l < $lim} {incr l} {
4028        set id [lindex $displayorder $l]
4029        if {![doesmatch $commitdata($id)]} continue
4030        if {![info exists commitinfo($id)]} {
4031            getcommit $id
4032        }
4033        set info $commitinfo($id)
4034        foreach f $info ty $fldtypes {
4035            if {($findloc eq "All fields" || $findloc eq $ty) &&
4036                [doesmatch $f]} {
4037                set markingmatches 1
4038                findselectline $l
4039                notbusy finding
4040                return 0
4041            }
4042        }
4043    }
4044    if {$l == $findstartline + 1} {
4045        bell
4046        unset findcurline
4047        notbusy finding
4048        return 0
4049    }
4050    set findcurline [expr {$l - 1}]
4051    return 1
4052}
4053
4054proc findmorerev {} {
4055    global commitdata commitinfo numcommits findstring findpattern findloc
4056    global findstartline findcurline markingmatches displayorder
4057
4058    set fldtypes {Headline Author Date Committer CDate Comments}
4059    set l $findcurline
4060    if {$l == 0} {
4061        set l $numcommits
4062    }
4063    incr l -1
4064    if {$l >= $findstartline} {
4065        set lim [expr {$findstartline - 1}]
4066    } else {
4067        set lim -1
4068    }
4069    if {$l - $lim > 500} {
4070        set lim [expr {$l - 500}]
4071    }
4072    set last 0
4073    for {} {$l > $lim} {incr l -1} {
4074        set id [lindex $displayorder $l]
4075        if {![doesmatch $commitdata($id)]} continue
4076        if {![info exists commitinfo($id)]} {
4077            getcommit $id
4078        }
4079        set info $commitinfo($id)
4080        foreach f $info ty $fldtypes {
4081            if {($findloc eq "All fields" || $findloc eq $ty) &&
4082                [doesmatch $f]} {
4083                set markingmatches 1
4084                findselectline $l
4085                notbusy finding
4086                return 0
4087            }
4088        }
4089    }
4090    if {$l == -1} {
4091        bell
4092        unset findcurline
4093        notbusy finding
4094        return 0
4095    }
4096    set findcurline [expr {$l + 1}]
4097    return 1
4098}
4099
4100proc findselectline {l} {
4101    global findloc commentend ctext
4102    selectline $l 1
4103    if {$findloc == "All fields" || $findloc == "Comments"} {
4104        # highlight the matches in the comments
4105        set f [$ctext get 1.0 $commentend]
4106        set matches [findmatches $f]
4107        foreach match $matches {
4108            set start [lindex $match 0]
4109            set end [expr {[lindex $match 1] + 1}]
4110            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4111        }
4112    }
4113}
4114
4115# mark the bits of a headline or author that match a find string
4116proc markmatches {canv l str tag matches font} {
4117    set bbox [$canv bbox $tag]
4118    set x0 [lindex $bbox 0]
4119    set y0 [lindex $bbox 1]
4120    set y1 [lindex $bbox 3]
4121    foreach match $matches {
4122        set start [lindex $match 0]
4123        set end [lindex $match 1]
4124        if {$start > $end} continue
4125        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4126        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4127        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4128                   [expr {$x0+$xlen+2}] $y1 \
4129                   -outline {} -tags [list match$l matches] -fill yellow]
4130        $canv lower $t
4131    }
4132}
4133
4134proc unmarkmatches {} {
4135    global findids markingmatches findcurline
4136
4137    allcanvs delete matches
4138    catch {unset findids}
4139    set markingmatches 0
4140    catch {unset findcurline}
4141}
4142
4143proc selcanvline {w x y} {
4144    global canv canvy0 ctext linespc
4145    global rowtextx
4146    set ymax [lindex [$canv cget -scrollregion] 3]
4147    if {$ymax == {}} return
4148    set yfrac [lindex [$canv yview] 0]
4149    set y [expr {$y + $yfrac * $ymax}]
4150    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4151    if {$l < 0} {
4152        set l 0
4153    }
4154    if {$w eq $canv} {
4155        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4156    }
4157    unmarkmatches
4158    selectline $l 1
4159}
4160
4161proc commit_descriptor {p} {
4162    global commitinfo
4163    if {![info exists commitinfo($p)]} {
4164        getcommit $p
4165    }
4166    set l "..."
4167    if {[llength $commitinfo($p)] > 1} {
4168        set l [lindex $commitinfo($p) 0]
4169    }
4170    return "$p ($l)\n"
4171}
4172
4173# append some text to the ctext widget, and make any SHA1 ID
4174# that we know about be a clickable link.
4175proc appendwithlinks {text tags} {
4176    global ctext commitrow linknum curview
4177
4178    set start [$ctext index "end - 1c"]
4179    $ctext insert end $text $tags
4180    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4181    foreach l $links {
4182        set s [lindex $l 0]
4183        set e [lindex $l 1]
4184        set linkid [string range $text $s $e]
4185        if {![info exists commitrow($curview,$linkid)]} continue
4186        incr e
4187        $ctext tag add link "$start + $s c" "$start + $e c"
4188        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4189        $ctext tag bind link$linknum <1> \
4190            [list selectline $commitrow($curview,$linkid) 1]
4191        incr linknum
4192    }
4193    $ctext tag conf link -foreground blue -underline 1
4194    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4195    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4196}
4197
4198proc viewnextline {dir} {
4199    global canv linespc
4200
4201    $canv delete hover
4202    set ymax [lindex [$canv cget -scrollregion] 3]
4203    set wnow [$canv yview]
4204    set wtop [expr {[lindex $wnow 0] * $ymax}]
4205    set newtop [expr {$wtop + $dir * $linespc}]
4206    if {$newtop < 0} {
4207        set newtop 0
4208    } elseif {$newtop > $ymax} {
4209        set newtop $ymax
4210    }
4211    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4212}
4213
4214# add a list of tag or branch names at position pos
4215# returns the number of names inserted
4216proc appendrefs {pos ids var} {
4217    global ctext commitrow linknum curview $var maxrefs
4218
4219    if {[catch {$ctext index $pos}]} {
4220        return 0
4221    }
4222    $ctext conf -state normal
4223    $ctext delete $pos "$pos lineend"
4224    set tags {}
4225    foreach id $ids {
4226        foreach tag [set $var\($id\)] {
4227            lappend tags [list $tag $id]
4228        }
4229    }
4230    if {[llength $tags] > $maxrefs} {
4231        $ctext insert $pos "many ([llength $tags])"
4232    } else {
4233        set tags [lsort -index 0 -decreasing $tags]
4234        set sep {}
4235        foreach ti $tags {
4236            set id [lindex $ti 1]
4237            set lk link$linknum
4238            incr linknum
4239            $ctext tag delete $lk
4240            $ctext insert $pos $sep
4241            $ctext insert $pos [lindex $ti 0] $lk
4242            if {[info exists commitrow($curview,$id)]} {
4243                $ctext tag conf $lk -foreground blue
4244                $ctext tag bind $lk <1> \
4245                    [list selectline $commitrow($curview,$id) 1]
4246                $ctext tag conf $lk -underline 1
4247                $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4248                $ctext tag bind $lk <Leave> \
4249                    { %W configure -cursor $curtextcursor }
4250            }
4251            set sep ", "
4252        }
4253    }
4254    $ctext conf -state disabled
4255    return [llength $tags]
4256}
4257
4258# called when we have finished computing the nearby tags
4259proc dispneartags {delay} {
4260    global selectedline currentid showneartags tagphase
4261
4262    if {![info exists selectedline] || !$showneartags} return
4263    after cancel dispnexttag
4264    if {$delay} {
4265        after 200 dispnexttag
4266        set tagphase -1
4267    } else {
4268        after idle dispnexttag
4269        set tagphase 0
4270    }
4271}
4272
4273proc dispnexttag {} {
4274    global selectedline currentid showneartags tagphase ctext
4275
4276    if {![info exists selectedline] || !$showneartags} return
4277    switch -- $tagphase {
4278        0 {
4279            set dtags [desctags $currentid]
4280            if {$dtags ne {}} {
4281                appendrefs precedes $dtags idtags
4282            }
4283        }
4284        1 {
4285            set atags [anctags $currentid]
4286            if {$atags ne {}} {
4287                appendrefs follows $atags idtags
4288            }
4289        }
4290        2 {
4291            set dheads [descheads $currentid]
4292            if {$dheads ne {}} {
4293                if {[appendrefs branch $dheads idheads] > 1
4294                    && [$ctext get "branch -3c"] eq "h"} {
4295                    # turn "Branch" into "Branches"
4296                    $ctext conf -state normal
4297                    $ctext insert "branch -2c" "es"
4298                    $ctext conf -state disabled
4299                }
4300            }
4301        }
4302    }
4303    if {[incr tagphase] <= 2} {
4304        after idle dispnexttag
4305    }
4306}
4307
4308proc selectline {l isnew} {
4309    global canv canv2 canv3 ctext commitinfo selectedline
4310    global displayorder linehtag linentag linedtag
4311    global canvy0 linespc parentlist children curview
4312    global currentid sha1entry
4313    global commentend idtags linknum
4314    global mergemax numcommits pending_select
4315    global cmitmode showneartags allcommits
4316
4317    catch {unset pending_select}
4318    $canv delete hover
4319    normalline
4320    cancel_next_highlight
4321    if {$l < 0 || $l >= $numcommits} return
4322    set y [expr {$canvy0 + $l * $linespc}]
4323    set ymax [lindex [$canv cget -scrollregion] 3]
4324    set ytop [expr {$y - $linespc - 1}]
4325    set ybot [expr {$y + $linespc + 1}]
4326    set wnow [$canv yview]
4327    set wtop [expr {[lindex $wnow 0] * $ymax}]
4328    set wbot [expr {[lindex $wnow 1] * $ymax}]
4329    set wh [expr {$wbot - $wtop}]
4330    set newtop $wtop
4331    if {$ytop < $wtop} {
4332        if {$ybot < $wtop} {
4333            set newtop [expr {$y - $wh / 2.0}]
4334        } else {
4335            set newtop $ytop
4336            if {$newtop > $wtop - $linespc} {
4337                set newtop [expr {$wtop - $linespc}]
4338            }
4339        }
4340    } elseif {$ybot > $wbot} {
4341        if {$ytop > $wbot} {
4342            set newtop [expr {$y - $wh / 2.0}]
4343        } else {
4344            set newtop [expr {$ybot - $wh}]
4345            if {$newtop < $wtop + $linespc} {
4346                set newtop [expr {$wtop + $linespc}]
4347            }
4348        }
4349    }
4350    if {$newtop != $wtop} {
4351        if {$newtop < 0} {
4352            set newtop 0
4353        }
4354        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4355        drawvisible
4356    }
4357
4358    if {![info exists linehtag($l)]} return
4359    $canv delete secsel
4360    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4361               -tags secsel -fill [$canv cget -selectbackground]]
4362    $canv lower $t
4363    $canv2 delete secsel
4364    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4365               -tags secsel -fill [$canv2 cget -selectbackground]]
4366    $canv2 lower $t
4367    $canv3 delete secsel
4368    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4369               -tags secsel -fill [$canv3 cget -selectbackground]]
4370    $canv3 lower $t
4371
4372    if {$isnew} {
4373        addtohistory [list selectline $l 0]
4374    }
4375
4376    set selectedline $l
4377
4378    set id [lindex $displayorder $l]
4379    set currentid $id
4380    $sha1entry delete 0 end
4381    $sha1entry insert 0 $id
4382    $sha1entry selection from 0
4383    $sha1entry selection to end
4384    rhighlight_sel $id
4385
4386    $ctext conf -state normal
4387    clear_ctext
4388    set linknum 0
4389    set info $commitinfo($id)
4390    set date [formatdate [lindex $info 2]]
4391    $ctext insert end "Author: [lindex $info 1]  $date\n"
4392    set date [formatdate [lindex $info 4]]
4393    $ctext insert end "Committer: [lindex $info 3]  $date\n"
4394    if {[info exists idtags($id)]} {
4395        $ctext insert end "Tags:"
4396        foreach tag $idtags($id) {
4397            $ctext insert end " $tag"
4398        }
4399        $ctext insert end "\n"
4400    }
4401
4402    set headers {}
4403    set olds [lindex $parentlist $l]
4404    if {[llength $olds] > 1} {
4405        set np 0
4406        foreach p $olds {
4407            if {$np >= $mergemax} {
4408                set tag mmax
4409            } else {
4410                set tag m$np
4411            }
4412            $ctext insert end "Parent: " $tag
4413            appendwithlinks [commit_descriptor $p] {}
4414            incr np
4415        }
4416    } else {
4417        foreach p $olds {
4418            append headers "Parent: [commit_descriptor $p]"
4419        }
4420    }
4421
4422    foreach c $children($curview,$id) {
4423        append headers "Child:  [commit_descriptor $c]"
4424    }
4425
4426    # make anything that looks like a SHA1 ID be a clickable link
4427    appendwithlinks $headers {}
4428    if {$showneartags} {
4429        if {![info exists allcommits]} {
4430            getallcommits
4431        }
4432        $ctext insert end "Branch: "
4433        $ctext mark set branch "end -1c"
4434        $ctext mark gravity branch left
4435        $ctext insert end "\nFollows: "
4436        $ctext mark set follows "end -1c"
4437        $ctext mark gravity follows left
4438        $ctext insert end "\nPrecedes: "
4439        $ctext mark set precedes "end -1c"
4440        $ctext mark gravity precedes left
4441        $ctext insert end "\n"
4442        dispneartags 1
4443    }
4444    $ctext insert end "\n"
4445    set comment [lindex $info 5]
4446    if {[string first "\r" $comment] >= 0} {
4447        set comment [string map {"\r" "\n    "} $comment]
4448    }
4449    appendwithlinks $comment {comment}
4450
4451    $ctext tag remove found 1.0 end
4452    $ctext conf -state disabled
4453    set commentend [$ctext index "end - 1c"]
4454
4455    init_flist "Comments"
4456    if {$cmitmode eq "tree"} {
4457        gettree $id
4458    } elseif {[llength $olds] <= 1} {
4459        startdiff $id
4460    } else {
4461        mergediff $id $l
4462    }
4463}
4464
4465proc selfirstline {} {
4466    unmarkmatches
4467    selectline 0 1
4468}
4469
4470proc sellastline {} {
4471    global numcommits
4472    unmarkmatches
4473    set l [expr {$numcommits - 1}]
4474    selectline $l 1
4475}
4476
4477proc selnextline {dir} {
4478    global selectedline
4479    if {![info exists selectedline]} return
4480    set l [expr {$selectedline + $dir}]
4481    unmarkmatches
4482    selectline $l 1
4483}
4484
4485proc selnextpage {dir} {
4486    global canv linespc selectedline numcommits
4487
4488    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4489    if {$lpp < 1} {
4490        set lpp 1
4491    }
4492    allcanvs yview scroll [expr {$dir * $lpp}] units
4493    drawvisible
4494    if {![info exists selectedline]} return
4495    set l [expr {$selectedline + $dir * $lpp}]
4496    if {$l < 0} {
4497        set l 0
4498    } elseif {$l >= $numcommits} {
4499        set l [expr $numcommits - 1]
4500    }
4501    unmarkmatches
4502    selectline $l 1
4503}
4504
4505proc unselectline {} {
4506    global selectedline currentid
4507
4508    catch {unset selectedline}
4509    catch {unset currentid}
4510    allcanvs delete secsel
4511    rhighlight_none
4512    cancel_next_highlight
4513}
4514
4515proc reselectline {} {
4516    global selectedline
4517
4518    if {[info exists selectedline]} {
4519        selectline $selectedline 0
4520    }
4521}
4522
4523proc addtohistory {cmd} {
4524    global history historyindex curview
4525
4526    set elt [list $curview $cmd]
4527    if {$historyindex > 0
4528        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4529        return
4530    }
4531
4532    if {$historyindex < [llength $history]} {
4533        set history [lreplace $history $historyindex end $elt]
4534    } else {
4535        lappend history $elt
4536    }
4537    incr historyindex
4538    if {$historyindex > 1} {
4539        .tf.bar.leftbut conf -state normal
4540    } else {
4541        .tf.bar.leftbut conf -state disabled
4542    }
4543    .tf.bar.rightbut conf -state disabled
4544}
4545
4546proc godo {elt} {
4547    global curview
4548
4549    set view [lindex $elt 0]
4550    set cmd [lindex $elt 1]
4551    if {$curview != $view} {
4552        showview $view
4553    }
4554    eval $cmd
4555}
4556
4557proc goback {} {
4558    global history historyindex
4559
4560    if {$historyindex > 1} {
4561        incr historyindex -1
4562        godo [lindex $history [expr {$historyindex - 1}]]
4563        .tf.bar.rightbut conf -state normal
4564    }
4565    if {$historyindex <= 1} {
4566        .tf.bar.leftbut conf -state disabled
4567    }
4568}
4569
4570proc goforw {} {
4571    global history historyindex
4572
4573    if {$historyindex < [llength $history]} {
4574        set cmd [lindex $history $historyindex]
4575        incr historyindex
4576        godo $cmd
4577        .tf.bar.leftbut conf -state normal
4578    }
4579    if {$historyindex >= [llength $history]} {
4580        .tf.bar.rightbut conf -state disabled
4581    }
4582}
4583
4584proc gettree {id} {
4585    global treefilelist treeidlist diffids diffmergeid treepending nullid
4586
4587    set diffids $id
4588    catch {unset diffmergeid}
4589    if {![info exists treefilelist($id)]} {
4590        if {![info exists treepending]} {
4591            if {$id ne $nullid} {
4592                set cmd [concat | git ls-tree -r $id]
4593            } else {
4594                set cmd [concat | git ls-files]
4595            }
4596            if {[catch {set gtf [open $cmd r]}]} {
4597                return
4598            }
4599            set treepending $id
4600            set treefilelist($id) {}
4601            set treeidlist($id) {}
4602            fconfigure $gtf -blocking 0
4603            filerun $gtf [list gettreeline $gtf $id]
4604        }
4605    } else {
4606        setfilelist $id
4607    }
4608}
4609
4610proc gettreeline {gtf id} {
4611    global treefilelist treeidlist treepending cmitmode diffids nullid
4612
4613    set nl 0
4614    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4615        if {$diffids ne $nullid} {
4616            if {[lindex $line 1] ne "blob"} continue
4617            set i [string first "\t" $line]
4618            if {$i < 0} continue
4619            set sha1 [lindex $line 2]
4620            set fname [string range $line [expr {$i+1}] end]
4621            if {[string index $fname 0] eq "\""} {
4622                set fname [lindex $fname 0]
4623            }
4624            lappend treeidlist($id) $sha1
4625        } else {
4626            set fname $line
4627        }
4628        lappend treefilelist($id) $fname
4629    }
4630    if {![eof $gtf]} {
4631        return [expr {$nl >= 1000? 2: 1}]
4632    }
4633    close $gtf
4634    unset treepending
4635    if {$cmitmode ne "tree"} {
4636        if {![info exists diffmergeid]} {
4637            gettreediffs $diffids
4638        }
4639    } elseif {$id ne $diffids} {
4640        gettree $diffids
4641    } else {
4642        setfilelist $id
4643    }
4644    return 0
4645}
4646
4647proc showfile {f} {
4648    global treefilelist treeidlist diffids nullid
4649    global ctext commentend
4650
4651    set i [lsearch -exact $treefilelist($diffids) $f]
4652    if {$i < 0} {
4653        puts "oops, $f not in list for id $diffids"
4654        return
4655    }
4656    if {$diffids ne $nullid} {
4657        set blob [lindex $treeidlist($diffids) $i]
4658        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4659            puts "oops, error reading blob $blob: $err"
4660            return
4661        }
4662    } else {
4663        if {[catch {set bf [open $f r]} err]} {
4664            puts "oops, can't read $f: $err"
4665            return
4666        }
4667    }
4668    fconfigure $bf -blocking 0
4669    filerun $bf [list getblobline $bf $diffids]
4670    $ctext config -state normal
4671    clear_ctext $commentend
4672    $ctext insert end "\n"
4673    $ctext insert end "$f\n" filesep
4674    $ctext config -state disabled
4675    $ctext yview $commentend
4676}
4677
4678proc getblobline {bf id} {
4679    global diffids cmitmode ctext
4680
4681    if {$id ne $diffids || $cmitmode ne "tree"} {
4682        catch {close $bf}
4683        return 0
4684    }
4685    $ctext config -state normal
4686    set nl 0
4687    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4688        $ctext insert end "$line\n"
4689    }
4690    if {[eof $bf]} {
4691        # delete last newline
4692        $ctext delete "end - 2c" "end - 1c"
4693        close $bf
4694        return 0
4695    }
4696    $ctext config -state disabled
4697    return [expr {$nl >= 1000? 2: 1}]
4698}
4699
4700proc mergediff {id l} {
4701    global diffmergeid diffopts mdifffd
4702    global diffids
4703    global parentlist
4704
4705    set diffmergeid $id
4706    set diffids $id
4707    # this doesn't seem to actually affect anything...
4708    set env(GIT_DIFF_OPTS) $diffopts
4709    set cmd [concat | git diff-tree --no-commit-id --cc $id]
4710    if {[catch {set mdf [open $cmd r]} err]} {
4711        error_popup "Error getting merge diffs: $err"
4712        return
4713    }
4714    fconfigure $mdf -blocking 0
4715    set mdifffd($id) $mdf
4716    set np [llength [lindex $parentlist $l]]
4717    filerun $mdf [list getmergediffline $mdf $id $np]
4718}
4719
4720proc getmergediffline {mdf id np} {
4721    global diffmergeid ctext cflist mergemax
4722    global difffilestart mdifffd
4723
4724    $ctext conf -state normal
4725    set nr 0
4726    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4727        if {![info exists diffmergeid] || $id != $diffmergeid
4728            || $mdf != $mdifffd($id)} {
4729            close $mdf
4730            return 0
4731        }
4732        if {[regexp {^diff --cc (.*)} $line match fname]} {
4733            # start of a new file
4734            $ctext insert end "\n"
4735            set here [$ctext index "end - 1c"]
4736            lappend difffilestart $here
4737            add_flist [list $fname]
4738            set l [expr {(78 - [string length $fname]) / 2}]
4739            set pad [string range "----------------------------------------" 1 $l]
4740            $ctext insert end "$pad $fname $pad\n" filesep
4741        } elseif {[regexp {^@@} $line]} {
4742            $ctext insert end "$line\n" hunksep
4743        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4744            # do nothing
4745        } else {
4746            # parse the prefix - one ' ', '-' or '+' for each parent
4747            set spaces {}
4748            set minuses {}
4749            set pluses {}
4750            set isbad 0
4751            for {set j 0} {$j < $np} {incr j} {
4752                set c [string range $line $j $j]
4753                if {$c == " "} {
4754                    lappend spaces $j
4755                } elseif {$c == "-"} {
4756                    lappend minuses $j
4757                } elseif {$c == "+"} {
4758                    lappend pluses $j
4759                } else {
4760                    set isbad 1
4761                    break
4762                }
4763            }
4764            set tags {}
4765            set num {}
4766            if {!$isbad && $minuses ne {} && $pluses eq {}} {
4767                # line doesn't appear in result, parents in $minuses have the line
4768                set num [lindex $minuses 0]
4769            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4770                # line appears in result, parents in $pluses don't have the line
4771                lappend tags mresult
4772                set num [lindex $spaces 0]
4773            }
4774            if {$num ne {}} {
4775                if {$num >= $mergemax} {
4776                    set num "max"
4777                }
4778                lappend tags m$num
4779            }
4780            $ctext insert end "$line\n" $tags
4781        }
4782    }
4783    $ctext conf -state disabled
4784    if {[eof $mdf]} {
4785        close $mdf
4786        return 0
4787    }
4788    return [expr {$nr >= 1000? 2: 1}]
4789}
4790
4791proc startdiff {ids} {
4792    global treediffs diffids treepending diffmergeid nullid
4793
4794    set diffids $ids
4795    catch {unset diffmergeid}
4796    if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0} {
4797        if {![info exists treepending]} {
4798            gettreediffs $ids
4799        }
4800    } else {
4801        addtocflist $ids
4802    }
4803}
4804
4805proc addtocflist {ids} {
4806    global treediffs cflist
4807    add_flist $treediffs($ids)
4808    getblobdiffs $ids
4809}
4810
4811proc diffcmd {ids flags} {
4812    global nullid
4813
4814    set i [lsearch -exact $ids $nullid]
4815    if {$i >= 0} {
4816        set cmd [concat | git diff-index $flags]
4817        if {[llength $ids] > 1} {
4818            if {$i == 0} {
4819                lappend cmd -R [lindex $ids 1]
4820            } else {
4821                lappend cmd [lindex $ids 0]
4822            }
4823        } else {
4824            lappend cmd HEAD
4825        }
4826    } else {
4827        set cmd [concat | git diff-tree --no-commit-id -r $flags $ids]
4828    }
4829    return $cmd
4830}
4831
4832proc gettreediffs {ids} {
4833    global treediff treepending
4834
4835    set treepending $ids
4836    set treediff {}
4837    if {[catch {set gdtf [open [diffcmd $ids {}] r]}]} return
4838    fconfigure $gdtf -blocking 0
4839    filerun $gdtf [list gettreediffline $gdtf $ids]
4840}
4841
4842proc gettreediffline {gdtf ids} {
4843    global treediff treediffs treepending diffids diffmergeid
4844    global cmitmode
4845
4846    set nr 0
4847    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4848        set i [string first "\t" $line]
4849        if {$i >= 0} {
4850            set file [string range $line [expr {$i+1}] end]
4851            if {[string index $file 0] eq "\""} {
4852                set file [lindex $file 0]
4853            }
4854            lappend treediff $file
4855        }
4856    }
4857    if {![eof $gdtf]} {
4858        return [expr {$nr >= 1000? 2: 1}]
4859    }
4860    close $gdtf
4861    set treediffs($ids) $treediff
4862    unset treepending
4863    if {$cmitmode eq "tree"} {
4864        gettree $diffids
4865    } elseif {$ids != $diffids} {
4866        if {![info exists diffmergeid]} {
4867            gettreediffs $diffids
4868        }
4869    } else {
4870        addtocflist $ids
4871    }
4872    return 0
4873}
4874
4875proc getblobdiffs {ids} {
4876    global diffopts blobdifffd diffids env
4877    global diffinhdr treediffs
4878
4879    set env(GIT_DIFF_OPTS) $diffopts
4880    if {[catch {set bdf [open [diffcmd $ids {-p -C}] r]} err]} {
4881        puts "error getting diffs: $err"
4882        return
4883    }
4884    set diffinhdr 0
4885    fconfigure $bdf -blocking 0
4886    set blobdifffd($ids) $bdf
4887    filerun $bdf [list getblobdiffline $bdf $diffids]
4888}
4889
4890proc setinlist {var i val} {
4891    global $var
4892
4893    while {[llength [set $var]] < $i} {
4894        lappend $var {}
4895    }
4896    if {[llength [set $var]] == $i} {
4897        lappend $var $val
4898    } else {
4899        lset $var $i $val
4900    }
4901}
4902
4903proc makediffhdr {fname ids} {
4904    global ctext curdiffstart treediffs
4905
4906    set i [lsearch -exact $treediffs($ids) $fname]
4907    if {$i >= 0} {
4908        setinlist difffilestart $i $curdiffstart
4909    }
4910    set l [expr {(78 - [string length $fname]) / 2}]
4911    set pad [string range "----------------------------------------" 1 $l]
4912    $ctext insert $curdiffstart "$pad $fname $pad" filesep
4913}
4914
4915proc getblobdiffline {bdf ids} {
4916    global diffids blobdifffd ctext curdiffstart
4917    global diffnexthead diffnextnote difffilestart
4918    global diffinhdr treediffs
4919
4920    set nr 0
4921    $ctext conf -state normal
4922    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
4923        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4924            close $bdf
4925            return 0
4926        }
4927        if {![string compare -length 11 "diff --git " $line]} {
4928            # trim off "diff --git "
4929            set line [string range $line 11 end]
4930            set diffinhdr 1
4931            # start of a new file
4932            $ctext insert end "\n"
4933            set curdiffstart [$ctext index "end - 1c"]
4934            $ctext insert end "\n" filesep
4935            # If the name hasn't changed the length will be odd,
4936            # the middle char will be a space, and the two bits either
4937            # side will be a/name and b/name, or "a/name" and "b/name".
4938            # If the name has changed we'll get "rename from" and
4939            # "rename to" lines following this, and we'll use them
4940            # to get the filenames.
4941            # This complexity is necessary because spaces in the filename(s)
4942            # don't get escaped.
4943            set l [string length $line]
4944            set i [expr {$l / 2}]
4945            if {!(($l & 1) && [string index $line $i] eq " " &&
4946                  [string range $line 2 [expr {$i - 1}]] eq \
4947                      [string range $line [expr {$i + 3}] end])} {
4948                continue
4949            }
4950            # unescape if quoted and chop off the a/ from the front
4951            if {[string index $line 0] eq "\""} {
4952                set fname [string range [lindex $line 0] 2 end]
4953            } else {
4954                set fname [string range $line 2 [expr {$i - 1}]]
4955            }
4956            makediffhdr $fname $ids
4957
4958        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
4959                       $line match f1l f1c f2l f2c rest]} {
4960            $ctext insert end "$line\n" hunksep
4961            set diffinhdr 0
4962
4963        } elseif {$diffinhdr} {
4964            if {![string compare -length 12 "rename from " $line]} {
4965                set fname [string range $line 12 end]
4966                if {[string index $fname 0] eq "\""} {
4967                    set fname [lindex $fname 0]
4968                }
4969                set i [lsearch -exact $treediffs($ids) $fname]
4970                if {$i >= 0} {
4971                    setinlist difffilestart $i $curdiffstart
4972                }
4973            } elseif {![string compare -length 10 $line "rename to "]} {
4974                set fname [string range $line 10 end]
4975                if {[string index $fname 0] eq "\""} {
4976                    set fname [lindex $fname 0]
4977                }
4978                makediffhdr $fname $ids
4979            } elseif {[string compare -length 3 $line "---"] == 0} {
4980                # do nothing
4981                continue
4982            } elseif {[string compare -length 3 $line "+++"] == 0} {
4983                set diffinhdr 0
4984                continue
4985            }
4986            $ctext insert end "$line\n" filesep
4987
4988        } else {
4989            set x [string range $line 0 0]
4990            if {$x == "-" || $x == "+"} {
4991                set tag [expr {$x == "+"}]
4992                $ctext insert end "$line\n" d$tag
4993            } elseif {$x == " "} {
4994                $ctext insert end "$line\n"
4995            } else {
4996                # "\ No newline at end of file",
4997                # or something else we don't recognize
4998                $ctext insert end "$line\n" hunksep
4999            }
5000        }
5001    }
5002    $ctext conf -state disabled
5003    if {[eof $bdf]} {
5004        close $bdf
5005        return 0
5006    }
5007    return [expr {$nr >= 1000? 2: 1}]
5008}
5009
5010proc changediffdisp {} {
5011    global ctext diffelide
5012
5013    $ctext tag conf d0 -elide [lindex $diffelide 0]
5014    $ctext tag conf d1 -elide [lindex $diffelide 1]
5015}
5016
5017proc prevfile {} {
5018    global difffilestart ctext
5019    set prev [lindex $difffilestart 0]
5020    set here [$ctext index @0,0]
5021    foreach loc $difffilestart {
5022        if {[$ctext compare $loc >= $here]} {
5023            $ctext yview $prev
5024            return
5025        }
5026        set prev $loc
5027    }
5028    $ctext yview $prev
5029}
5030
5031proc nextfile {} {
5032    global difffilestart ctext
5033    set here [$ctext index @0,0]
5034    foreach loc $difffilestart {
5035        if {[$ctext compare $loc > $here]} {
5036            $ctext yview $loc
5037            return
5038        }
5039    }
5040}
5041
5042proc clear_ctext {{first 1.0}} {
5043    global ctext smarktop smarkbot
5044
5045    set l [lindex [split $first .] 0]
5046    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5047        set smarktop $l
5048    }
5049    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5050        set smarkbot $l
5051    }
5052    $ctext delete $first end
5053}
5054
5055proc incrsearch {name ix op} {
5056    global ctext searchstring searchdirn
5057
5058    $ctext tag remove found 1.0 end
5059    if {[catch {$ctext index anchor}]} {
5060        # no anchor set, use start of selection, or of visible area
5061        set sel [$ctext tag ranges sel]
5062        if {$sel ne {}} {
5063            $ctext mark set anchor [lindex $sel 0]
5064        } elseif {$searchdirn eq "-forwards"} {
5065            $ctext mark set anchor @0,0
5066        } else {
5067            $ctext mark set anchor @0,[winfo height $ctext]
5068        }
5069    }
5070    if {$searchstring ne {}} {
5071        set here [$ctext search $searchdirn -- $searchstring anchor]
5072        if {$here ne {}} {
5073            $ctext see $here
5074        }
5075        searchmarkvisible 1
5076    }
5077}
5078
5079proc dosearch {} {
5080    global sstring ctext searchstring searchdirn
5081
5082    focus $sstring
5083    $sstring icursor end
5084    set searchdirn -forwards
5085    if {$searchstring ne {}} {
5086        set sel [$ctext tag ranges sel]
5087        if {$sel ne {}} {
5088            set start "[lindex $sel 0] + 1c"
5089        } elseif {[catch {set start [$ctext index anchor]}]} {
5090            set start "@0,0"
5091        }
5092        set match [$ctext search -count mlen -- $searchstring $start]
5093        $ctext tag remove sel 1.0 end
5094        if {$match eq {}} {
5095            bell
5096            return
5097        }
5098        $ctext see $match
5099        set mend "$match + $mlen c"
5100        $ctext tag add sel $match $mend
5101        $ctext mark unset anchor
5102    }
5103}
5104
5105proc dosearchback {} {
5106    global sstring ctext searchstring searchdirn
5107
5108    focus $sstring
5109    $sstring icursor end
5110    set searchdirn -backwards
5111    if {$searchstring ne {}} {
5112        set sel [$ctext tag ranges sel]
5113        if {$sel ne {}} {
5114            set start [lindex $sel 0]
5115        } elseif {[catch {set start [$ctext index anchor]}]} {
5116            set start @0,[winfo height $ctext]
5117        }
5118        set match [$ctext search -backwards -count ml -- $searchstring $start]
5119        $ctext tag remove sel 1.0 end
5120        if {$match eq {}} {
5121            bell
5122            return
5123        }
5124        $ctext see $match
5125        set mend "$match + $ml c"
5126        $ctext tag add sel $match $mend
5127        $ctext mark unset anchor
5128    }
5129}
5130
5131proc searchmark {first last} {
5132    global ctext searchstring
5133
5134    set mend $first.0
5135    while {1} {
5136        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5137        if {$match eq {}} break
5138        set mend "$match + $mlen c"
5139        $ctext tag add found $match $mend
5140    }
5141}
5142
5143proc searchmarkvisible {doall} {
5144    global ctext smarktop smarkbot
5145
5146    set topline [lindex [split [$ctext index @0,0] .] 0]
5147    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5148    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5149        # no overlap with previous
5150        searchmark $topline $botline
5151        set smarktop $topline
5152        set smarkbot $botline
5153    } else {
5154        if {$topline < $smarktop} {
5155            searchmark $topline [expr {$smarktop-1}]
5156            set smarktop $topline
5157        }
5158        if {$botline > $smarkbot} {
5159            searchmark [expr {$smarkbot+1}] $botline
5160            set smarkbot $botline
5161        }
5162    }
5163}
5164
5165proc scrolltext {f0 f1} {
5166    global searchstring
5167
5168    .bleft.sb set $f0 $f1
5169    if {$searchstring ne {}} {
5170        searchmarkvisible 0
5171    }
5172}
5173
5174proc setcoords {} {
5175    global linespc charspc canvx0 canvy0 mainfont
5176    global xspc1 xspc2 lthickness
5177
5178    set linespc [font metrics $mainfont -linespace]
5179    set charspc [font measure $mainfont "m"]
5180    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5181    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5182    set lthickness [expr {int($linespc / 9) + 1}]
5183    set xspc1(0) $linespc
5184    set xspc2 $linespc
5185}
5186
5187proc redisplay {} {
5188    global canv
5189    global selectedline
5190
5191    set ymax [lindex [$canv cget -scrollregion] 3]
5192    if {$ymax eq {} || $ymax == 0} return
5193    set span [$canv yview]
5194    clear_display
5195    setcanvscroll
5196    allcanvs yview moveto [lindex $span 0]
5197    drawvisible
5198    if {[info exists selectedline]} {
5199        selectline $selectedline 0
5200        allcanvs yview moveto [lindex $span 0]
5201    }
5202}
5203
5204proc incrfont {inc} {
5205    global mainfont textfont ctext canv phase cflist
5206    global charspc tabstop
5207    global stopped entries
5208    unmarkmatches
5209    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5210    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5211    setcoords
5212    $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5213    $cflist conf -font $textfont
5214    $ctext tag conf filesep -font [concat $textfont bold]
5215    foreach e $entries {
5216        $e conf -font $mainfont
5217    }
5218    if {$phase eq "getcommits"} {
5219        $canv itemconf textitems -font $mainfont
5220    }
5221    redisplay
5222}
5223
5224proc clearsha1 {} {
5225    global sha1entry sha1string
5226    if {[string length $sha1string] == 40} {
5227        $sha1entry delete 0 end
5228    }
5229}
5230
5231proc sha1change {n1 n2 op} {
5232    global sha1string currentid sha1but
5233    if {$sha1string == {}
5234        || ([info exists currentid] && $sha1string == $currentid)} {
5235        set state disabled
5236    } else {
5237        set state normal
5238    }
5239    if {[$sha1but cget -state] == $state} return
5240    if {$state == "normal"} {
5241        $sha1but conf -state normal -relief raised -text "Goto: "
5242    } else {
5243        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5244    }
5245}
5246
5247proc gotocommit {} {
5248    global sha1string currentid commitrow tagids headids
5249    global displayorder numcommits curview
5250
5251    if {$sha1string == {}
5252        || ([info exists currentid] && $sha1string == $currentid)} return
5253    if {[info exists tagids($sha1string)]} {
5254        set id $tagids($sha1string)
5255    } elseif {[info exists headids($sha1string)]} {
5256        set id $headids($sha1string)
5257    } else {
5258        set id [string tolower $sha1string]
5259        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5260            set matches {}
5261            foreach i $displayorder {
5262                if {[string match $id* $i]} {
5263                    lappend matches $i
5264                }
5265            }
5266            if {$matches ne {}} {
5267                if {[llength $matches] > 1} {
5268                    error_popup "Short SHA1 id $id is ambiguous"
5269                    return
5270                }
5271                set id [lindex $matches 0]
5272            }
5273        }
5274    }
5275    if {[info exists commitrow($curview,$id)]} {
5276        selectline $commitrow($curview,$id) 1
5277        return
5278    }
5279    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5280        set type "SHA1 id"
5281    } else {
5282        set type "Tag/Head"
5283    }
5284    error_popup "$type $sha1string is not known"
5285}
5286
5287proc lineenter {x y id} {
5288    global hoverx hovery hoverid hovertimer
5289    global commitinfo canv
5290
5291    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5292    set hoverx $x
5293    set hovery $y
5294    set hoverid $id
5295    if {[info exists hovertimer]} {
5296        after cancel $hovertimer
5297    }
5298    set hovertimer [after 500 linehover]
5299    $canv delete hover
5300}
5301
5302proc linemotion {x y id} {
5303    global hoverx hovery hoverid hovertimer
5304
5305    if {[info exists hoverid] && $id == $hoverid} {
5306        set hoverx $x
5307        set hovery $y
5308        if {[info exists hovertimer]} {
5309            after cancel $hovertimer
5310        }
5311        set hovertimer [after 500 linehover]
5312    }
5313}
5314
5315proc lineleave {id} {
5316    global hoverid hovertimer canv
5317
5318    if {[info exists hoverid] && $id == $hoverid} {
5319        $canv delete hover
5320        if {[info exists hovertimer]} {
5321            after cancel $hovertimer
5322            unset hovertimer
5323        }
5324        unset hoverid
5325    }
5326}
5327
5328proc linehover {} {
5329    global hoverx hovery hoverid hovertimer
5330    global canv linespc lthickness
5331    global commitinfo mainfont
5332
5333    set text [lindex $commitinfo($hoverid) 0]
5334    set ymax [lindex [$canv cget -scrollregion] 3]
5335    if {$ymax == {}} return
5336    set yfrac [lindex [$canv yview] 0]
5337    set x [expr {$hoverx + 2 * $linespc}]
5338    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5339    set x0 [expr {$x - 2 * $lthickness}]
5340    set y0 [expr {$y - 2 * $lthickness}]
5341    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5342    set y1 [expr {$y + $linespc + 2 * $lthickness}]
5343    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5344               -fill \#ffff80 -outline black -width 1 -tags hover]
5345    $canv raise $t
5346    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5347               -font $mainfont]
5348    $canv raise $t
5349}
5350
5351proc clickisonarrow {id y} {
5352    global lthickness
5353
5354    set ranges [rowranges $id]
5355    set thresh [expr {2 * $lthickness + 6}]
5356    set n [expr {[llength $ranges] - 1}]
5357    for {set i 1} {$i < $n} {incr i} {
5358        set row [lindex $ranges $i]
5359        if {abs([yc $row] - $y) < $thresh} {
5360            return $i
5361        }
5362    }
5363    return {}
5364}
5365
5366proc arrowjump {id n y} {
5367    global canv
5368
5369    # 1 <-> 2, 3 <-> 4, etc...
5370    set n [expr {(($n - 1) ^ 1) + 1}]
5371    set row [lindex [rowranges $id] $n]
5372    set yt [yc $row]
5373    set ymax [lindex [$canv cget -scrollregion] 3]
5374    if {$ymax eq {} || $ymax <= 0} return
5375    set view [$canv yview]
5376    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5377    set yfrac [expr {$yt / $ymax - $yspan / 2}]
5378    if {$yfrac < 0} {
5379        set yfrac 0
5380    }
5381    allcanvs yview moveto $yfrac
5382}
5383
5384proc lineclick {x y id isnew} {
5385    global ctext commitinfo children canv thickerline curview
5386
5387    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5388    unmarkmatches
5389    unselectline
5390    normalline
5391    $canv delete hover
5392    # draw this line thicker than normal
5393    set thickerline $id
5394    drawlines $id
5395    if {$isnew} {
5396        set ymax [lindex [$canv cget -scrollregion] 3]
5397        if {$ymax eq {}} return
5398        set yfrac [lindex [$canv yview] 0]
5399        set y [expr {$y + $yfrac * $ymax}]
5400    }
5401    set dirn [clickisonarrow $id $y]
5402    if {$dirn ne {}} {
5403        arrowjump $id $dirn $y
5404        return
5405    }
5406
5407    if {$isnew} {
5408        addtohistory [list lineclick $x $y $id 0]
5409    }
5410    # fill the details pane with info about this line
5411    $ctext conf -state normal
5412    clear_ctext
5413    $ctext tag conf link -foreground blue -underline 1
5414    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5415    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5416    $ctext insert end "Parent:\t"
5417    $ctext insert end $id [list link link0]
5418    $ctext tag bind link0 <1> [list selbyid $id]
5419    set info $commitinfo($id)
5420    $ctext insert end "\n\t[lindex $info 0]\n"
5421    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5422    set date [formatdate [lindex $info 2]]
5423    $ctext insert end "\tDate:\t$date\n"
5424    set kids $children($curview,$id)
5425    if {$kids ne {}} {
5426        $ctext insert end "\nChildren:"
5427        set i 0
5428        foreach child $kids {
5429            incr i
5430            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5431            set info $commitinfo($child)
5432            $ctext insert end "\n\t"
5433            $ctext insert end $child [list link link$i]
5434            $ctext tag bind link$i <1> [list selbyid $child]
5435            $ctext insert end "\n\t[lindex $info 0]"
5436            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5437            set date [formatdate [lindex $info 2]]
5438            $ctext insert end "\n\tDate:\t$date\n"
5439        }
5440    }
5441    $ctext conf -state disabled
5442    init_flist {}
5443}
5444
5445proc normalline {} {
5446    global thickerline
5447    if {[info exists thickerline]} {
5448        set id $thickerline
5449        unset thickerline
5450        drawlines $id
5451    }
5452}
5453
5454proc selbyid {id} {
5455    global commitrow curview
5456    if {[info exists commitrow($curview,$id)]} {
5457        selectline $commitrow($curview,$id) 1
5458    }
5459}
5460
5461proc mstime {} {
5462    global startmstime
5463    if {![info exists startmstime]} {
5464        set startmstime [clock clicks -milliseconds]
5465    }
5466    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5467}
5468
5469proc rowmenu {x y id} {
5470    global rowctxmenu commitrow selectedline rowmenuid curview
5471    global nullid fakerowmenu mainhead
5472
5473    set rowmenuid $id
5474    if {![info exists selectedline]
5475        || $commitrow($curview,$id) eq $selectedline} {
5476        set state disabled
5477    } else {
5478        set state normal
5479    }
5480    if {$id ne $nullid} {
5481        set menu $rowctxmenu
5482        $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5483    } else {
5484        set menu $fakerowmenu
5485    }
5486    $menu entryconfigure "Diff this*" -state $state
5487    $menu entryconfigure "Diff selected*" -state $state
5488    $menu entryconfigure "Make patch" -state $state
5489    tk_popup $menu $x $y
5490}
5491
5492proc diffvssel {dirn} {
5493    global rowmenuid selectedline displayorder
5494
5495    if {![info exists selectedline]} return
5496    if {$dirn} {
5497        set oldid [lindex $displayorder $selectedline]
5498        set newid $rowmenuid
5499    } else {
5500        set oldid $rowmenuid
5501        set newid [lindex $displayorder $selectedline]
5502    }
5503    addtohistory [list doseldiff $oldid $newid]
5504    doseldiff $oldid $newid
5505}
5506
5507proc doseldiff {oldid newid} {
5508    global ctext
5509    global commitinfo
5510
5511    $ctext conf -state normal
5512    clear_ctext
5513    init_flist "Top"
5514    $ctext insert end "From "
5515    $ctext tag conf link -foreground blue -underline 1
5516    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5517    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5518    $ctext tag bind link0 <1> [list selbyid $oldid]
5519    $ctext insert end $oldid [list link link0]
5520    $ctext insert end "\n     "
5521    $ctext insert end [lindex $commitinfo($oldid) 0]
5522    $ctext insert end "\n\nTo   "
5523    $ctext tag bind link1 <1> [list selbyid $newid]
5524    $ctext insert end $newid [list link link1]
5525    $ctext insert end "\n     "
5526    $ctext insert end [lindex $commitinfo($newid) 0]
5527    $ctext insert end "\n"
5528    $ctext conf -state disabled
5529    $ctext tag remove found 1.0 end
5530    startdiff [list $oldid $newid]
5531}
5532
5533proc mkpatch {} {
5534    global rowmenuid currentid commitinfo patchtop patchnum
5535
5536    if {![info exists currentid]} return
5537    set oldid $currentid
5538    set oldhead [lindex $commitinfo($oldid) 0]
5539    set newid $rowmenuid
5540    set newhead [lindex $commitinfo($newid) 0]
5541    set top .patch
5542    set patchtop $top
5543    catch {destroy $top}
5544    toplevel $top
5545    label $top.title -text "Generate patch"
5546    grid $top.title - -pady 10
5547    label $top.from -text "From:"
5548    entry $top.fromsha1 -width 40 -relief flat
5549    $top.fromsha1 insert 0 $oldid
5550    $top.fromsha1 conf -state readonly
5551    grid $top.from $top.fromsha1 -sticky w
5552    entry $top.fromhead -width 60 -relief flat
5553    $top.fromhead insert 0 $oldhead
5554    $top.fromhead conf -state readonly
5555    grid x $top.fromhead -sticky w
5556    label $top.to -text "To:"
5557    entry $top.tosha1 -width 40 -relief flat
5558    $top.tosha1 insert 0 $newid
5559    $top.tosha1 conf -state readonly
5560    grid $top.to $top.tosha1 -sticky w
5561    entry $top.tohead -width 60 -relief flat
5562    $top.tohead insert 0 $newhead
5563    $top.tohead conf -state readonly
5564    grid x $top.tohead -sticky w
5565    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5566    grid $top.rev x -pady 10
5567    label $top.flab -text "Output file:"
5568    entry $top.fname -width 60
5569    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5570    incr patchnum
5571    grid $top.flab $top.fname -sticky w
5572    frame $top.buts
5573    button $top.buts.gen -text "Generate" -command mkpatchgo
5574    button $top.buts.can -text "Cancel" -command mkpatchcan
5575    grid $top.buts.gen $top.buts.can
5576    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5577    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5578    grid $top.buts - -pady 10 -sticky ew
5579    focus $top.fname
5580}
5581
5582proc mkpatchrev {} {
5583    global patchtop
5584
5585    set oldid [$patchtop.fromsha1 get]
5586    set oldhead [$patchtop.fromhead get]
5587    set newid [$patchtop.tosha1 get]
5588    set newhead [$patchtop.tohead get]
5589    foreach e [list fromsha1 fromhead tosha1 tohead] \
5590            v [list $newid $newhead $oldid $oldhead] {
5591        $patchtop.$e conf -state normal
5592        $patchtop.$e delete 0 end
5593        $patchtop.$e insert 0 $v
5594        $patchtop.$e conf -state readonly
5595    }
5596}
5597
5598proc mkpatchgo {} {
5599    global patchtop nullid
5600
5601    set oldid [$patchtop.fromsha1 get]
5602    set newid [$patchtop.tosha1 get]
5603    set fname [$patchtop.fname get]
5604    if {$newid eq $nullid} {
5605        set cmd [list git diff-index -p $oldid]
5606    } elseif {$oldid eq $nullid} {
5607        set cmd [list git diff-index -p -R $newid]
5608    } else {
5609        set cmd [list git diff-tree -p $oldid $newid]
5610    }
5611    lappend cmd >$fname &
5612    if {[catch {eval exec $cmd} err]} {
5613        error_popup "Error creating patch: $err"
5614    }
5615    catch {destroy $patchtop}
5616    unset patchtop
5617}
5618
5619proc mkpatchcan {} {
5620    global patchtop
5621
5622    catch {destroy $patchtop}
5623    unset patchtop
5624}
5625
5626proc mktag {} {
5627    global rowmenuid mktagtop commitinfo
5628
5629    set top .maketag
5630    set mktagtop $top
5631    catch {destroy $top}
5632    toplevel $top
5633    label $top.title -text "Create tag"
5634    grid $top.title - -pady 10
5635    label $top.id -text "ID:"
5636    entry $top.sha1 -width 40 -relief flat
5637    $top.sha1 insert 0 $rowmenuid
5638    $top.sha1 conf -state readonly
5639    grid $top.id $top.sha1 -sticky w
5640    entry $top.head -width 60 -relief flat
5641    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5642    $top.head conf -state readonly
5643    grid x $top.head -sticky w
5644    label $top.tlab -text "Tag name:"
5645    entry $top.tag -width 60
5646    grid $top.tlab $top.tag -sticky w
5647    frame $top.buts
5648    button $top.buts.gen -text "Create" -command mktaggo
5649    button $top.buts.can -text "Cancel" -command mktagcan
5650    grid $top.buts.gen $top.buts.can
5651    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5652    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5653    grid $top.buts - -pady 10 -sticky ew
5654    focus $top.tag
5655}
5656
5657proc domktag {} {
5658    global mktagtop env tagids idtags
5659
5660    set id [$mktagtop.sha1 get]
5661    set tag [$mktagtop.tag get]
5662    if {$tag == {}} {
5663        error_popup "No tag name specified"
5664        return
5665    }
5666    if {[info exists tagids($tag)]} {
5667        error_popup "Tag \"$tag\" already exists"
5668        return
5669    }
5670    if {[catch {
5671        set dir [gitdir]
5672        set fname [file join $dir "refs/tags" $tag]
5673        set f [open $fname w]
5674        puts $f $id
5675        close $f
5676    } err]} {
5677        error_popup "Error creating tag: $err"
5678        return
5679    }
5680
5681    set tagids($tag) $id
5682    lappend idtags($id) $tag
5683    redrawtags $id
5684    addedtag $id
5685}
5686
5687proc redrawtags {id} {
5688    global canv linehtag commitrow idpos selectedline curview
5689    global mainfont canvxmax iddrawn
5690
5691    if {![info exists commitrow($curview,$id)]} return
5692    if {![info exists iddrawn($id)]} return
5693    drawcommits $commitrow($curview,$id)
5694    $canv delete tag.$id
5695    set xt [eval drawtags $id $idpos($id)]
5696    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5697    set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5698    set xr [expr {$xt + [font measure $mainfont $text]}]
5699    if {$xr > $canvxmax} {
5700        set canvxmax $xr
5701        setcanvscroll
5702    }
5703    if {[info exists selectedline]
5704        && $selectedline == $commitrow($curview,$id)} {
5705        selectline $selectedline 0
5706    }
5707}
5708
5709proc mktagcan {} {
5710    global mktagtop
5711
5712    catch {destroy $mktagtop}
5713    unset mktagtop
5714}
5715
5716proc mktaggo {} {
5717    domktag
5718    mktagcan
5719}
5720
5721proc writecommit {} {
5722    global rowmenuid wrcomtop commitinfo wrcomcmd
5723
5724    set top .writecommit
5725    set wrcomtop $top
5726    catch {destroy $top}
5727    toplevel $top
5728    label $top.title -text "Write commit to file"
5729    grid $top.title - -pady 10
5730    label $top.id -text "ID:"
5731    entry $top.sha1 -width 40 -relief flat
5732    $top.sha1 insert 0 $rowmenuid
5733    $top.sha1 conf -state readonly
5734    grid $top.id $top.sha1 -sticky w
5735    entry $top.head -width 60 -relief flat
5736    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5737    $top.head conf -state readonly
5738    grid x $top.head -sticky w
5739    label $top.clab -text "Command:"
5740    entry $top.cmd -width 60 -textvariable wrcomcmd
5741    grid $top.clab $top.cmd -sticky w -pady 10
5742    label $top.flab -text "Output file:"
5743    entry $top.fname -width 60
5744    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5745    grid $top.flab $top.fname -sticky w
5746    frame $top.buts
5747    button $top.buts.gen -text "Write" -command wrcomgo
5748    button $top.buts.can -text "Cancel" -command wrcomcan
5749    grid $top.buts.gen $top.buts.can
5750    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5751    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5752    grid $top.buts - -pady 10 -sticky ew
5753    focus $top.fname
5754}
5755
5756proc wrcomgo {} {
5757    global wrcomtop
5758
5759    set id [$wrcomtop.sha1 get]
5760    set cmd "echo $id | [$wrcomtop.cmd get]"
5761    set fname [$wrcomtop.fname get]
5762    if {[catch {exec sh -c $cmd >$fname &} err]} {
5763        error_popup "Error writing commit: $err"
5764    }
5765    catch {destroy $wrcomtop}
5766    unset wrcomtop
5767}
5768
5769proc wrcomcan {} {
5770    global wrcomtop
5771
5772    catch {destroy $wrcomtop}
5773    unset wrcomtop
5774}
5775
5776proc mkbranch {} {
5777    global rowmenuid mkbrtop
5778
5779    set top .makebranch
5780    catch {destroy $top}
5781    toplevel $top
5782    label $top.title -text "Create new branch"
5783    grid $top.title - -pady 10
5784    label $top.id -text "ID:"
5785    entry $top.sha1 -width 40 -relief flat
5786    $top.sha1 insert 0 $rowmenuid
5787    $top.sha1 conf -state readonly
5788    grid $top.id $top.sha1 -sticky w
5789    label $top.nlab -text "Name:"
5790    entry $top.name -width 40
5791    grid $top.nlab $top.name -sticky w
5792    frame $top.buts
5793    button $top.buts.go -text "Create" -command [list mkbrgo $top]
5794    button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5795    grid $top.buts.go $top.buts.can
5796    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5797    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5798    grid $top.buts - -pady 10 -sticky ew
5799    focus $top.name
5800}
5801
5802proc mkbrgo {top} {
5803    global headids idheads
5804
5805    set name [$top.name get]
5806    set id [$top.sha1 get]
5807    if {$name eq {}} {
5808        error_popup "Please specify a name for the new branch"
5809        return
5810    }
5811    catch {destroy $top}
5812    nowbusy newbranch
5813    update
5814    if {[catch {
5815        exec git branch $name $id
5816    } err]} {
5817        notbusy newbranch
5818        error_popup $err
5819    } else {
5820        set headids($name) $id
5821        lappend idheads($id) $name
5822        addedhead $id $name
5823        notbusy newbranch
5824        redrawtags $id
5825        dispneartags 0
5826    }
5827}
5828
5829proc cherrypick {} {
5830    global rowmenuid curview commitrow
5831    global mainhead
5832
5833    set oldhead [exec git rev-parse HEAD]
5834    set dheads [descheads $rowmenuid]
5835    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5836        set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5837                        included in branch $mainhead -- really re-apply it?"]
5838        if {!$ok} return
5839    }
5840    nowbusy cherrypick
5841    update
5842    # Unfortunately git-cherry-pick writes stuff to stderr even when
5843    # no error occurs, and exec takes that as an indication of error...
5844    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5845        notbusy cherrypick
5846        error_popup $err
5847        return
5848    }
5849    set newhead [exec git rev-parse HEAD]
5850    if {$newhead eq $oldhead} {
5851        notbusy cherrypick
5852        error_popup "No changes committed"
5853        return
5854    }
5855    addnewchild $newhead $oldhead
5856    if {[info exists commitrow($curview,$oldhead)]} {
5857        insertrow $commitrow($curview,$oldhead) $newhead
5858        if {$mainhead ne {}} {
5859            movehead $newhead $mainhead
5860            movedhead $newhead $mainhead
5861        }
5862        redrawtags $oldhead
5863        redrawtags $newhead
5864    }
5865    notbusy cherrypick
5866}
5867
5868proc resethead {} {
5869    global mainheadid mainhead rowmenuid confirm_ok resettype
5870    global showlocalchanges
5871
5872    set confirm_ok 0
5873    set w ".confirmreset"
5874    toplevel $w
5875    wm transient $w .
5876    wm title $w "Confirm reset"
5877    message $w.m -text \
5878        "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
5879        -justify center -aspect 1000
5880    pack $w.m -side top -fill x -padx 20 -pady 20
5881    frame $w.f -relief sunken -border 2
5882    message $w.f.rt -text "Reset type:" -aspect 1000
5883    grid $w.f.rt -sticky w
5884    set resettype mixed
5885    radiobutton $w.f.soft -value soft -variable resettype -justify left \
5886        -text "Soft: Leave working tree and index untouched"
5887    grid $w.f.soft -sticky w
5888    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
5889        -text "Mixed: Leave working tree untouched, reset index"
5890    grid $w.f.mixed -sticky w
5891    radiobutton $w.f.hard -value hard -variable resettype -justify left \
5892        -text "Hard: Reset working tree and index\n(discard ALL local changes)"
5893    grid $w.f.hard -sticky w
5894    pack $w.f -side top -fill x
5895    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
5896    pack $w.ok -side left -fill x -padx 20 -pady 20
5897    button $w.cancel -text Cancel -command "destroy $w"
5898    pack $w.cancel -side right -fill x -padx 20 -pady 20
5899    bind $w <Visibility> "grab $w; focus $w"
5900    tkwait window $w
5901    if {!$confirm_ok} return
5902    if {[catch {set fd [open \
5903            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
5904        error_popup $err
5905    } else {
5906        dohidelocalchanges
5907        set w ".resetprogress"
5908        filerun $fd [list readresetstat $fd $w]
5909        toplevel $w
5910        wm transient $w
5911        wm title $w "Reset progress"
5912        message $w.m -text "Reset in progress, please wait..." \
5913            -justify center -aspect 1000
5914        pack $w.m -side top -fill x -padx 20 -pady 5
5915        canvas $w.c -width 150 -height 20 -bg white
5916        $w.c create rect 0 0 0 20 -fill green -tags rect
5917        pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
5918        nowbusy reset
5919    }
5920}
5921
5922proc readresetstat {fd w} {
5923    global mainhead mainheadid showlocalchanges
5924
5925    if {[gets $fd line] >= 0} {
5926        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
5927            set x [expr {($m * 150) / $n}]
5928            $w.c coords rect 0 0 $x 20
5929        }
5930        return 1
5931    }
5932    destroy $w
5933    notbusy reset
5934    if {[catch {close $fd} err]} {
5935        error_popup $err
5936    }
5937    set oldhead $mainheadid
5938    set newhead [exec git rev-parse HEAD]
5939    if {$newhead ne $oldhead} {
5940        movehead $newhead $mainhead
5941        movedhead $newhead $mainhead
5942        set mainheadid $newhead
5943        redrawtags $oldhead
5944        redrawtags $newhead
5945    }
5946    if {$showlocalchanges} {
5947        doshowlocalchanges
5948    }
5949    return 0
5950}
5951
5952# context menu for a head
5953proc headmenu {x y id head} {
5954    global headmenuid headmenuhead headctxmenu mainhead
5955
5956    set headmenuid $id
5957    set headmenuhead $head
5958    set state normal
5959    if {$head eq $mainhead} {
5960        set state disabled
5961    }
5962    $headctxmenu entryconfigure 0 -state $state
5963    $headctxmenu entryconfigure 1 -state $state
5964    tk_popup $headctxmenu $x $y
5965}
5966
5967proc cobranch {} {
5968    global headmenuid headmenuhead mainhead headids
5969    global showlocalchanges mainheadid
5970
5971    # check the tree is clean first??
5972    set oldmainhead $mainhead
5973    nowbusy checkout
5974    update
5975    dohidelocalchanges
5976    if {[catch {
5977        exec git checkout -q $headmenuhead
5978    } err]} {
5979        notbusy checkout
5980        error_popup $err
5981    } else {
5982        notbusy checkout
5983        set mainhead $headmenuhead
5984        set mainheadid $headmenuid
5985        if {[info exists headids($oldmainhead)]} {
5986            redrawtags $headids($oldmainhead)
5987        }
5988        redrawtags $headmenuid
5989    }
5990    if {$showlocalchanges} {
5991        dodiffindex
5992    }
5993}
5994
5995proc rmbranch {} {
5996    global headmenuid headmenuhead mainhead
5997    global headids idheads
5998
5999    set head $headmenuhead
6000    set id $headmenuid
6001    # this check shouldn't be needed any more...
6002    if {$head eq $mainhead} {
6003        error_popup "Cannot delete the currently checked-out branch"
6004        return
6005    }
6006    set dheads [descheads $id]
6007    if {$dheads eq $headids($head)} {
6008        # the stuff on this branch isn't on any other branch
6009        if {![confirm_popup "The commits on branch $head aren't on any other\
6010                        branch.\nReally delete branch $head?"]} return
6011    }
6012    nowbusy rmbranch
6013    update
6014    if {[catch {exec git branch -D $head} err]} {
6015        notbusy rmbranch
6016        error_popup $err
6017        return
6018    }
6019    removehead $id $head
6020    removedhead $id $head
6021    redrawtags $id
6022    notbusy rmbranch
6023    dispneartags 0
6024}
6025
6026# Stuff for finding nearby tags
6027proc getallcommits {} {
6028    global allcommits allids nbmp nextarc seeds
6029
6030    set allids {}
6031    set nbmp 0
6032    set nextarc 0
6033    set allcommits 0
6034    set seeds {}
6035    regetallcommits
6036}
6037
6038# Called when the graph might have changed
6039proc regetallcommits {} {
6040    global allcommits seeds
6041
6042    set cmd [concat | git rev-list --all --parents]
6043    foreach id $seeds {
6044        lappend cmd "^$id"
6045    }
6046    set fd [open $cmd r]
6047    fconfigure $fd -blocking 0
6048    incr allcommits
6049    nowbusy allcommits
6050    filerun $fd [list getallclines $fd]
6051}
6052
6053# Since most commits have 1 parent and 1 child, we group strings of
6054# such commits into "arcs" joining branch/merge points (BMPs), which
6055# are commits that either don't have 1 parent or don't have 1 child.
6056#
6057# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6058# arcout(id) - outgoing arcs for BMP
6059# arcids(a) - list of IDs on arc including end but not start
6060# arcstart(a) - BMP ID at start of arc
6061# arcend(a) - BMP ID at end of arc
6062# growing(a) - arc a is still growing
6063# arctags(a) - IDs out of arcids (excluding end) that have tags
6064# archeads(a) - IDs out of arcids (excluding end) that have heads
6065# The start of an arc is at the descendent end, so "incoming" means
6066# coming from descendents, and "outgoing" means going towards ancestors.
6067
6068proc getallclines {fd} {
6069    global allids allparents allchildren idtags idheads nextarc nbmp
6070    global arcnos arcids arctags arcout arcend arcstart archeads growing
6071    global seeds allcommits
6072
6073    set nid 0
6074    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6075        set id [lindex $line 0]
6076        if {[info exists allparents($id)]} {
6077            # seen it already
6078            continue
6079        }
6080        lappend allids $id
6081        set olds [lrange $line 1 end]
6082        set allparents($id) $olds
6083        if {![info exists allchildren($id)]} {
6084            set allchildren($id) {}
6085            set arcnos($id) {}
6086            lappend seeds $id
6087        } else {
6088            set a $arcnos($id)
6089            if {[llength $olds] == 1 && [llength $a] == 1} {
6090                lappend arcids($a) $id
6091                if {[info exists idtags($id)]} {
6092                    lappend arctags($a) $id
6093                }
6094                if {[info exists idheads($id)]} {
6095                    lappend archeads($a) $id
6096                }
6097                if {[info exists allparents($olds)]} {
6098                    # seen parent already
6099                    if {![info exists arcout($olds)]} {
6100                        splitarc $olds
6101                    }
6102                    lappend arcids($a) $olds
6103                    set arcend($a) $olds
6104                    unset growing($a)
6105                }
6106                lappend allchildren($olds) $id
6107                lappend arcnos($olds) $a
6108                continue
6109            }
6110        }
6111        incr nbmp
6112        foreach a $arcnos($id) {
6113            lappend arcids($a) $id
6114            set arcend($a) $id
6115            unset growing($a)
6116        }
6117
6118        set ao {}
6119        foreach p $olds {
6120            lappend allchildren($p) $id
6121            set a [incr nextarc]
6122            set arcstart($a) $id
6123            set archeads($a) {}
6124            set arctags($a) {}
6125            set archeads($a) {}
6126            set arcids($a) {}
6127            lappend ao $a
6128            set growing($a) 1
6129            if {[info exists allparents($p)]} {
6130                # seen it already, may need to make a new branch
6131                if {![info exists arcout($p)]} {
6132                    splitarc $p
6133                }
6134                lappend arcids($a) $p
6135                set arcend($a) $p
6136                unset growing($a)
6137            }
6138            lappend arcnos($p) $a
6139        }
6140        set arcout($id) $ao
6141    }
6142    if {$nid > 0} {
6143        global cached_dheads cached_dtags cached_atags
6144        catch {unset cached_dheads}
6145        catch {unset cached_dtags}
6146        catch {unset cached_atags}
6147    }
6148    if {![eof $fd]} {
6149        return [expr {$nid >= 1000? 2: 1}]
6150    }
6151    close $fd
6152    if {[incr allcommits -1] == 0} {
6153        notbusy allcommits
6154    }
6155    dispneartags 0
6156    return 0
6157}
6158
6159proc recalcarc {a} {
6160    global arctags archeads arcids idtags idheads
6161
6162    set at {}
6163    set ah {}
6164    foreach id [lrange $arcids($a) 0 end-1] {
6165        if {[info exists idtags($id)]} {
6166            lappend at $id
6167        }
6168        if {[info exists idheads($id)]} {
6169            lappend ah $id
6170        }
6171    }
6172    set arctags($a) $at
6173    set archeads($a) $ah
6174}
6175
6176proc splitarc {p} {
6177    global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6178    global arcstart arcend arcout allparents growing
6179
6180    set a $arcnos($p)
6181    if {[llength $a] != 1} {
6182        puts "oops splitarc called but [llength $a] arcs already"
6183        return
6184    }
6185    set a [lindex $a 0]
6186    set i [lsearch -exact $arcids($a) $p]
6187    if {$i < 0} {
6188        puts "oops splitarc $p not in arc $a"
6189        return
6190    }
6191    set na [incr nextarc]
6192    if {[info exists arcend($a)]} {
6193        set arcend($na) $arcend($a)
6194    } else {
6195        set l [lindex $allparents([lindex $arcids($a) end]) 0]
6196        set j [lsearch -exact $arcnos($l) $a]
6197        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6198    }
6199    set tail [lrange $arcids($a) [expr {$i+1}] end]
6200    set arcids($a) [lrange $arcids($a) 0 $i]
6201    set arcend($a) $p
6202    set arcstart($na) $p
6203    set arcout($p) $na
6204    set arcids($na) $tail
6205    if {[info exists growing($a)]} {
6206        set growing($na) 1
6207        unset growing($a)
6208    }
6209    incr nbmp
6210
6211    foreach id $tail {
6212        if {[llength $arcnos($id)] == 1} {
6213            set arcnos($id) $na
6214        } else {
6215            set j [lsearch -exact $arcnos($id) $a]
6216            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6217        }
6218    }
6219
6220    # reconstruct tags and heads lists
6221    if {$arctags($a) ne {} || $archeads($a) ne {}} {
6222        recalcarc $a
6223        recalcarc $na
6224    } else {
6225        set arctags($na) {}
6226        set archeads($na) {}
6227    }
6228}
6229
6230# Update things for a new commit added that is a child of one
6231# existing commit.  Used when cherry-picking.
6232proc addnewchild {id p} {
6233    global allids allparents allchildren idtags nextarc nbmp
6234    global arcnos arcids arctags arcout arcend arcstart archeads growing
6235    global seeds
6236
6237    lappend allids $id
6238    set allparents($id) [list $p]
6239    set allchildren($id) {}
6240    set arcnos($id) {}
6241    lappend seeds $id
6242    incr nbmp
6243    lappend allchildren($p) $id
6244    set a [incr nextarc]
6245    set arcstart($a) $id
6246    set archeads($a) {}
6247    set arctags($a) {}
6248    set arcids($a) [list $p]
6249    set arcend($a) $p
6250    if {![info exists arcout($p)]} {
6251        splitarc $p
6252    }
6253    lappend arcnos($p) $a
6254    set arcout($id) [list $a]
6255}
6256
6257# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6258# or 0 if neither is true.
6259proc anc_or_desc {a b} {
6260    global arcout arcstart arcend arcnos cached_isanc
6261
6262    if {$arcnos($a) eq $arcnos($b)} {
6263        # Both are on the same arc(s); either both are the same BMP,
6264        # or if one is not a BMP, the other is also not a BMP or is
6265        # the BMP at end of the arc (and it only has 1 incoming arc).
6266        # Or both can be BMPs with no incoming arcs.
6267        if {$a eq $b || $arcnos($a) eq {}} {
6268            return 0
6269        }
6270        # assert {[llength $arcnos($a)] == 1}
6271        set arc [lindex $arcnos($a) 0]
6272        set i [lsearch -exact $arcids($arc) $a]
6273        set j [lsearch -exact $arcids($arc) $b]
6274        if {$i < 0 || $i > $j} {
6275            return 1
6276        } else {
6277            return -1
6278        }
6279    }
6280
6281    if {![info exists arcout($a)]} {
6282        set arc [lindex $arcnos($a) 0]
6283        if {[info exists arcend($arc)]} {
6284            set aend $arcend($arc)
6285        } else {
6286            set aend {}
6287        }
6288        set a $arcstart($arc)
6289    } else {
6290        set aend $a
6291    }
6292    if {![info exists arcout($b)]} {
6293        set arc [lindex $arcnos($b) 0]
6294        if {[info exists arcend($arc)]} {
6295            set bend $arcend($arc)
6296        } else {
6297            set bend {}
6298        }
6299        set b $arcstart($arc)
6300    } else {
6301        set bend $b
6302    }
6303    if {$a eq $bend} {
6304        return 1
6305    }
6306    if {$b eq $aend} {
6307        return -1
6308    }
6309    if {[info exists cached_isanc($a,$bend)]} {
6310        if {$cached_isanc($a,$bend)} {
6311            return 1
6312        }
6313    }
6314    if {[info exists cached_isanc($b,$aend)]} {
6315        if {$cached_isanc($b,$aend)} {
6316            return -1
6317        }
6318        if {[info exists cached_isanc($a,$bend)]} {
6319            return 0
6320        }
6321    }
6322
6323    set todo [list $a $b]
6324    set anc($a) a
6325    set anc($b) b
6326    for {set i 0} {$i < [llength $todo]} {incr i} {
6327        set x [lindex $todo $i]
6328        if {$anc($x) eq {}} {
6329            continue
6330        }
6331        foreach arc $arcnos($x) {
6332            set xd $arcstart($arc)
6333            if {$xd eq $bend} {
6334                set cached_isanc($a,$bend) 1
6335                set cached_isanc($b,$aend) 0
6336                return 1
6337            } elseif {$xd eq $aend} {
6338                set cached_isanc($b,$aend) 1
6339                set cached_isanc($a,$bend) 0
6340                return -1
6341            }
6342            if {![info exists anc($xd)]} {
6343                set anc($xd) $anc($x)
6344                lappend todo $xd
6345            } elseif {$anc($xd) ne $anc($x)} {
6346                set anc($xd) {}
6347            }
6348        }
6349    }
6350    set cached_isanc($a,$bend) 0
6351    set cached_isanc($b,$aend) 0
6352    return 0
6353}
6354
6355# This identifies whether $desc has an ancestor that is
6356# a growing tip of the graph and which is not an ancestor of $anc
6357# and returns 0 if so and 1 if not.
6358# If we subsequently discover a tag on such a growing tip, and that
6359# turns out to be a descendent of $anc (which it could, since we
6360# don't necessarily see children before parents), then $desc
6361# isn't a good choice to display as a descendent tag of
6362# $anc (since it is the descendent of another tag which is
6363# a descendent of $anc).  Similarly, $anc isn't a good choice to
6364# display as a ancestor tag of $desc.
6365#
6366proc is_certain {desc anc} {
6367    global arcnos arcout arcstart arcend growing problems
6368
6369    set certain {}
6370    if {[llength $arcnos($anc)] == 1} {
6371        # tags on the same arc are certain
6372        if {$arcnos($desc) eq $arcnos($anc)} {
6373            return 1
6374        }
6375        if {![info exists arcout($anc)]} {
6376            # if $anc is partway along an arc, use the start of the arc instead
6377            set a [lindex $arcnos($anc) 0]
6378            set anc $arcstart($a)
6379        }
6380    }
6381    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6382        set x $desc
6383    } else {
6384        set a [lindex $arcnos($desc) 0]
6385        set x $arcend($a)
6386    }
6387    if {$x == $anc} {
6388        return 1
6389    }
6390    set anclist [list $x]
6391    set dl($x) 1
6392    set nnh 1
6393    set ngrowanc 0
6394    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6395        set x [lindex $anclist $i]
6396        if {$dl($x)} {
6397            incr nnh -1
6398        }
6399        set done($x) 1
6400        foreach a $arcout($x) {
6401            if {[info exists growing($a)]} {
6402                if {![info exists growanc($x)] && $dl($x)} {
6403                    set growanc($x) 1
6404                    incr ngrowanc
6405                }
6406            } else {
6407                set y $arcend($a)
6408                if {[info exists dl($y)]} {
6409                    if {$dl($y)} {
6410                        if {!$dl($x)} {
6411                            set dl($y) 0
6412                            if {![info exists done($y)]} {
6413                                incr nnh -1
6414                            }
6415                            if {[info exists growanc($x)]} {
6416                                incr ngrowanc -1
6417                            }
6418                            set xl [list $y]
6419                            for {set k 0} {$k < [llength $xl]} {incr k} {
6420                                set z [lindex $xl $k]
6421                                foreach c $arcout($z) {
6422                                    if {[info exists arcend($c)]} {
6423                                        set v $arcend($c)
6424                                        if {[info exists dl($v)] && $dl($v)} {
6425                                            set dl($v) 0
6426                                            if {![info exists done($v)]} {
6427                                                incr nnh -1
6428                                            }
6429                                            if {[info exists growanc($v)]} {
6430                                                incr ngrowanc -1
6431                                            }
6432                                            lappend xl $v
6433                                        }
6434                                    }
6435                                }
6436                            }
6437                        }
6438                    }
6439                } elseif {$y eq $anc || !$dl($x)} {
6440                    set dl($y) 0
6441                    lappend anclist $y
6442                } else {
6443                    set dl($y) 1
6444                    lappend anclist $y
6445                    incr nnh
6446                }
6447            }
6448        }
6449    }
6450    foreach x [array names growanc] {
6451        if {$dl($x)} {
6452            return 0
6453        }
6454        return 0
6455    }
6456    return 1
6457}
6458
6459proc validate_arctags {a} {
6460    global arctags idtags
6461
6462    set i -1
6463    set na $arctags($a)
6464    foreach id $arctags($a) {
6465        incr i
6466        if {![info exists idtags($id)]} {
6467            set na [lreplace $na $i $i]
6468            incr i -1
6469        }
6470    }
6471    set arctags($a) $na
6472}
6473
6474proc validate_archeads {a} {
6475    global archeads idheads
6476
6477    set i -1
6478    set na $archeads($a)
6479    foreach id $archeads($a) {
6480        incr i
6481        if {![info exists idheads($id)]} {
6482            set na [lreplace $na $i $i]
6483            incr i -1
6484        }
6485    }
6486    set archeads($a) $na
6487}
6488
6489# Return the list of IDs that have tags that are descendents of id,
6490# ignoring IDs that are descendents of IDs already reported.
6491proc desctags {id} {
6492    global arcnos arcstart arcids arctags idtags allparents
6493    global growing cached_dtags
6494
6495    if {![info exists allparents($id)]} {
6496        return {}
6497    }
6498    set t1 [clock clicks -milliseconds]
6499    set argid $id
6500    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6501        # part-way along an arc; check that arc first
6502        set a [lindex $arcnos($id) 0]
6503        if {$arctags($a) ne {}} {
6504            validate_arctags $a
6505            set i [lsearch -exact $arcids($a) $id]
6506            set tid {}
6507            foreach t $arctags($a) {
6508                set j [lsearch -exact $arcids($a) $t]
6509                if {$j >= $i} break
6510                set tid $t
6511            }
6512            if {$tid ne {}} {
6513                return $tid
6514            }
6515        }
6516        set id $arcstart($a)
6517        if {[info exists idtags($id)]} {
6518            return $id
6519        }
6520    }
6521    if {[info exists cached_dtags($id)]} {
6522        return $cached_dtags($id)
6523    }
6524
6525    set origid $id
6526    set todo [list $id]
6527    set queued($id) 1
6528    set nc 1
6529    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6530        set id [lindex $todo $i]
6531        set done($id) 1
6532        set ta [info exists hastaggedancestor($id)]
6533        if {!$ta} {
6534            incr nc -1
6535        }
6536        # ignore tags on starting node
6537        if {!$ta && $i > 0} {
6538            if {[info exists idtags($id)]} {
6539                set tagloc($id) $id
6540                set ta 1
6541            } elseif {[info exists cached_dtags($id)]} {
6542                set tagloc($id) $cached_dtags($id)
6543                set ta 1
6544            }
6545        }
6546        foreach a $arcnos($id) {
6547            set d $arcstart($a)
6548            if {!$ta && $arctags($a) ne {}} {
6549                validate_arctags $a
6550                if {$arctags($a) ne {}} {
6551                    lappend tagloc($id) [lindex $arctags($a) end]
6552                }
6553            }
6554            if {$ta || $arctags($a) ne {}} {
6555                set tomark [list $d]
6556                for {set j 0} {$j < [llength $tomark]} {incr j} {
6557                    set dd [lindex $tomark $j]
6558                    if {![info exists hastaggedancestor($dd)]} {
6559                        if {[info exists done($dd)]} {
6560                            foreach b $arcnos($dd) {
6561                                lappend tomark $arcstart($b)
6562                            }
6563                            if {[info exists tagloc($dd)]} {
6564                                unset tagloc($dd)
6565                            }
6566                        } elseif {[info exists queued($dd)]} {
6567                            incr nc -1
6568                        }
6569                        set hastaggedancestor($dd) 1
6570                    }
6571                }
6572            }
6573            if {![info exists queued($d)]} {
6574                lappend todo $d
6575                set queued($d) 1
6576                if {![info exists hastaggedancestor($d)]} {
6577                    incr nc
6578                }
6579            }
6580        }
6581    }
6582    set tags {}
6583    foreach id [array names tagloc] {
6584        if {![info exists hastaggedancestor($id)]} {
6585            foreach t $tagloc($id) {
6586                if {[lsearch -exact $tags $t] < 0} {
6587                    lappend tags $t
6588                }
6589            }
6590        }
6591    }
6592    set t2 [clock clicks -milliseconds]
6593    set loopix $i
6594
6595    # remove tags that are descendents of other tags
6596    for {set i 0} {$i < [llength $tags]} {incr i} {
6597        set a [lindex $tags $i]
6598        for {set j 0} {$j < $i} {incr j} {
6599            set b [lindex $tags $j]
6600            set r [anc_or_desc $a $b]
6601            if {$r == 1} {
6602                set tags [lreplace $tags $j $j]
6603                incr j -1
6604                incr i -1
6605            } elseif {$r == -1} {
6606                set tags [lreplace $tags $i $i]
6607                incr i -1
6608                break
6609            }
6610        }
6611    }
6612
6613    if {[array names growing] ne {}} {
6614        # graph isn't finished, need to check if any tag could get
6615        # eclipsed by another tag coming later.  Simply ignore any
6616        # tags that could later get eclipsed.
6617        set ctags {}
6618        foreach t $tags {
6619            if {[is_certain $t $origid]} {
6620                lappend ctags $t
6621            }
6622        }
6623        if {$tags eq $ctags} {
6624            set cached_dtags($origid) $tags
6625        } else {
6626            set tags $ctags
6627        }
6628    } else {
6629        set cached_dtags($origid) $tags
6630    }
6631    set t3 [clock clicks -milliseconds]
6632    if {0 && $t3 - $t1 >= 100} {
6633        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6634            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6635    }
6636    return $tags
6637}
6638
6639proc anctags {id} {
6640    global arcnos arcids arcout arcend arctags idtags allparents
6641    global growing cached_atags
6642
6643    if {![info exists allparents($id)]} {
6644        return {}
6645    }
6646    set t1 [clock clicks -milliseconds]
6647    set argid $id
6648    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6649        # part-way along an arc; check that arc first
6650        set a [lindex $arcnos($id) 0]
6651        if {$arctags($a) ne {}} {
6652            validate_arctags $a
6653            set i [lsearch -exact $arcids($a) $id]
6654            foreach t $arctags($a) {
6655                set j [lsearch -exact $arcids($a) $t]
6656                if {$j > $i} {
6657                    return $t
6658                }
6659            }
6660        }
6661        if {![info exists arcend($a)]} {
6662            return {}
6663        }
6664        set id $arcend($a)
6665        if {[info exists idtags($id)]} {
6666            return $id
6667        }
6668    }
6669    if {[info exists cached_atags($id)]} {
6670        return $cached_atags($id)
6671    }
6672
6673    set origid $id
6674    set todo [list $id]
6675    set queued($id) 1
6676    set taglist {}
6677    set nc 1
6678    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6679        set id [lindex $todo $i]
6680        set done($id) 1
6681        set td [info exists hastaggeddescendent($id)]
6682        if {!$td} {
6683            incr nc -1
6684        }
6685        # ignore tags on starting node
6686        if {!$td && $i > 0} {
6687            if {[info exists idtags($id)]} {
6688                set tagloc($id) $id
6689                set td 1
6690            } elseif {[info exists cached_atags($id)]} {
6691                set tagloc($id) $cached_atags($id)
6692                set td 1
6693            }
6694        }
6695        foreach a $arcout($id) {
6696            if {!$td && $arctags($a) ne {}} {
6697                validate_arctags $a
6698                if {$arctags($a) ne {}} {
6699                    lappend tagloc($id) [lindex $arctags($a) 0]
6700                }
6701            }
6702            if {![info exists arcend($a)]} continue
6703            set d $arcend($a)
6704            if {$td || $arctags($a) ne {}} {
6705                set tomark [list $d]
6706                for {set j 0} {$j < [llength $tomark]} {incr j} {
6707                    set dd [lindex $tomark $j]
6708                    if {![info exists hastaggeddescendent($dd)]} {
6709                        if {[info exists done($dd)]} {
6710                            foreach b $arcout($dd) {
6711                                if {[info exists arcend($b)]} {
6712                                    lappend tomark $arcend($b)
6713                                }
6714                            }
6715                            if {[info exists tagloc($dd)]} {
6716                                unset tagloc($dd)
6717                            }
6718                        } elseif {[info exists queued($dd)]} {
6719                            incr nc -1
6720                        }
6721                        set hastaggeddescendent($dd) 1
6722                    }
6723                }
6724            }
6725            if {![info exists queued($d)]} {
6726                lappend todo $d
6727                set queued($d) 1
6728                if {![info exists hastaggeddescendent($d)]} {
6729                    incr nc
6730                }
6731            }
6732        }
6733    }
6734    set t2 [clock clicks -milliseconds]
6735    set loopix $i
6736    set tags {}
6737    foreach id [array names tagloc] {
6738        if {![info exists hastaggeddescendent($id)]} {
6739            foreach t $tagloc($id) {
6740                if {[lsearch -exact $tags $t] < 0} {
6741                    lappend tags $t
6742                }
6743            }
6744        }
6745    }
6746
6747    # remove tags that are ancestors of other tags
6748    for {set i 0} {$i < [llength $tags]} {incr i} {
6749        set a [lindex $tags $i]
6750        for {set j 0} {$j < $i} {incr j} {
6751            set b [lindex $tags $j]
6752            set r [anc_or_desc $a $b]
6753            if {$r == -1} {
6754                set tags [lreplace $tags $j $j]
6755                incr j -1
6756                incr i -1
6757            } elseif {$r == 1} {
6758                set tags [lreplace $tags $i $i]
6759                incr i -1
6760                break
6761            }
6762        }
6763    }
6764
6765    if {[array names growing] ne {}} {
6766        # graph isn't finished, need to check if any tag could get
6767        # eclipsed by another tag coming later.  Simply ignore any
6768        # tags that could later get eclipsed.
6769        set ctags {}
6770        foreach t $tags {
6771            if {[is_certain $origid $t]} {
6772                lappend ctags $t
6773            }
6774        }
6775        if {$tags eq $ctags} {
6776            set cached_atags($origid) $tags
6777        } else {
6778            set tags $ctags
6779        }
6780    } else {
6781        set cached_atags($origid) $tags
6782    }
6783    set t3 [clock clicks -milliseconds]
6784    if {0 && $t3 - $t1 >= 100} {
6785        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6786            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6787    }
6788    return $tags
6789}
6790
6791# Return the list of IDs that have heads that are descendents of id,
6792# including id itself if it has a head.
6793proc descheads {id} {
6794    global arcnos arcstart arcids archeads idheads cached_dheads
6795    global allparents
6796
6797    if {![info exists allparents($id)]} {
6798        return {}
6799    }
6800    set aret {}
6801    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6802        # part-way along an arc; check it first
6803        set a [lindex $arcnos($id) 0]
6804        if {$archeads($a) ne {}} {
6805            validate_archeads $a
6806            set i [lsearch -exact $arcids($a) $id]
6807            foreach t $archeads($a) {
6808                set j [lsearch -exact $arcids($a) $t]
6809                if {$j > $i} break
6810                lappend aret $t
6811            }
6812        }
6813        set id $arcstart($a)
6814    }
6815    set origid $id
6816    set todo [list $id]
6817    set seen($id) 1
6818    set ret {}
6819    for {set i 0} {$i < [llength $todo]} {incr i} {
6820        set id [lindex $todo $i]
6821        if {[info exists cached_dheads($id)]} {
6822            set ret [concat $ret $cached_dheads($id)]
6823        } else {
6824            if {[info exists idheads($id)]} {
6825                lappend ret $id
6826            }
6827            foreach a $arcnos($id) {
6828                if {$archeads($a) ne {}} {
6829                    validate_archeads $a
6830                    if {$archeads($a) ne {}} {
6831                        set ret [concat $ret $archeads($a)]
6832                    }
6833                }
6834                set d $arcstart($a)
6835                if {![info exists seen($d)]} {
6836                    lappend todo $d
6837                    set seen($d) 1
6838                }
6839            }
6840        }
6841    }
6842    set ret [lsort -unique $ret]
6843    set cached_dheads($origid) $ret
6844    return [concat $ret $aret]
6845}
6846
6847proc addedtag {id} {
6848    global arcnos arcout cached_dtags cached_atags
6849
6850    if {![info exists arcnos($id)]} return
6851    if {![info exists arcout($id)]} {
6852        recalcarc [lindex $arcnos($id) 0]
6853    }
6854    catch {unset cached_dtags}
6855    catch {unset cached_atags}
6856}
6857
6858proc addedhead {hid head} {
6859    global arcnos arcout cached_dheads
6860
6861    if {![info exists arcnos($hid)]} return
6862    if {![info exists arcout($hid)]} {
6863        recalcarc [lindex $arcnos($hid) 0]
6864    }
6865    catch {unset cached_dheads}
6866}
6867
6868proc removedhead {hid head} {
6869    global cached_dheads
6870
6871    catch {unset cached_dheads}
6872}
6873
6874proc movedhead {hid head} {
6875    global arcnos arcout cached_dheads
6876
6877    if {![info exists arcnos($hid)]} return
6878    if {![info exists arcout($hid)]} {
6879        recalcarc [lindex $arcnos($hid) 0]
6880    }
6881    catch {unset cached_dheads}
6882}
6883
6884proc changedrefs {} {
6885    global cached_dheads cached_dtags cached_atags
6886    global arctags archeads arcnos arcout idheads idtags
6887
6888    foreach id [concat [array names idheads] [array names idtags]] {
6889        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6890            set a [lindex $arcnos($id) 0]
6891            if {![info exists donearc($a)]} {
6892                recalcarc $a
6893                set donearc($a) 1
6894            }
6895        }
6896    }
6897    catch {unset cached_dtags}
6898    catch {unset cached_atags}
6899    catch {unset cached_dheads}
6900}
6901
6902proc rereadrefs {} {
6903    global idtags idheads idotherrefs mainhead
6904
6905    set refids [concat [array names idtags] \
6906                    [array names idheads] [array names idotherrefs]]
6907    foreach id $refids {
6908        if {![info exists ref($id)]} {
6909            set ref($id) [listrefs $id]
6910        }
6911    }
6912    set oldmainhead $mainhead
6913    readrefs
6914    changedrefs
6915    set refids [lsort -unique [concat $refids [array names idtags] \
6916                        [array names idheads] [array names idotherrefs]]]
6917    foreach id $refids {
6918        set v [listrefs $id]
6919        if {![info exists ref($id)] || $ref($id) != $v ||
6920            ($id eq $oldmainhead && $id ne $mainhead) ||
6921            ($id eq $mainhead && $id ne $oldmainhead)} {
6922            redrawtags $id
6923        }
6924    }
6925}
6926
6927proc listrefs {id} {
6928    global idtags idheads idotherrefs
6929
6930    set x {}
6931    if {[info exists idtags($id)]} {
6932        set x $idtags($id)
6933    }
6934    set y {}
6935    if {[info exists idheads($id)]} {
6936        set y $idheads($id)
6937    }
6938    set z {}
6939    if {[info exists idotherrefs($id)]} {
6940        set z $idotherrefs($id)
6941    }
6942    return [list $x $y $z]
6943}
6944
6945proc showtag {tag isnew} {
6946    global ctext tagcontents tagids linknum tagobjid
6947
6948    if {$isnew} {
6949        addtohistory [list showtag $tag 0]
6950    }
6951    $ctext conf -state normal
6952    clear_ctext
6953    set linknum 0
6954    if {![info exists tagcontents($tag)]} {
6955        catch {
6956            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
6957        }
6958    }
6959    if {[info exists tagcontents($tag)]} {
6960        set text $tagcontents($tag)
6961    } else {
6962        set text "Tag: $tag\nId:  $tagids($tag)"
6963    }
6964    appendwithlinks $text {}
6965    $ctext conf -state disabled
6966    init_flist {}
6967}
6968
6969proc doquit {} {
6970    global stopped
6971    set stopped 100
6972    savestuff .
6973    destroy .
6974}
6975
6976proc doprefs {} {
6977    global maxwidth maxgraphpct diffopts
6978    global oldprefs prefstop showneartags showlocalchanges
6979    global bgcolor fgcolor ctext diffcolors selectbgcolor
6980    global uifont tabstop
6981
6982    set top .gitkprefs
6983    set prefstop $top
6984    if {[winfo exists $top]} {
6985        raise $top
6986        return
6987    }
6988    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
6989        set oldprefs($v) [set $v]
6990    }
6991    toplevel $top
6992    wm title $top "Gitk preferences"
6993    label $top.ldisp -text "Commit list display options"
6994    $top.ldisp configure -font $uifont
6995    grid $top.ldisp - -sticky w -pady 10
6996    label $top.spacer -text " "
6997    label $top.maxwidthl -text "Maximum graph width (lines)" \
6998        -font optionfont
6999    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7000    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7001    label $top.maxpctl -text "Maximum graph width (% of pane)" \
7002        -font optionfont
7003    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7004    grid x $top.maxpctl $top.maxpct -sticky w
7005    frame $top.showlocal
7006    label $top.showlocal.l -text "Show local changes" -font optionfont
7007    checkbutton $top.showlocal.b -variable showlocalchanges
7008    pack $top.showlocal.b $top.showlocal.l -side left
7009    grid x $top.showlocal -sticky w
7010
7011    label $top.ddisp -text "Diff display options"
7012    $top.ddisp configure -font $uifont
7013    grid $top.ddisp - -sticky w -pady 10
7014    label $top.diffoptl -text "Options for diff program" \
7015        -font optionfont
7016    entry $top.diffopt -width 20 -textvariable diffopts
7017    grid x $top.diffoptl $top.diffopt -sticky w
7018    frame $top.ntag
7019    label $top.ntag.l -text "Display nearby tags" -font optionfont
7020    checkbutton $top.ntag.b -variable showneartags
7021    pack $top.ntag.b $top.ntag.l -side left
7022    grid x $top.ntag -sticky w
7023    label $top.tabstopl -text "tabstop" -font optionfont
7024    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7025    grid x $top.tabstopl $top.tabstop -sticky w
7026
7027    label $top.cdisp -text "Colors: press to choose"
7028    $top.cdisp configure -font $uifont
7029    grid $top.cdisp - -sticky w -pady 10
7030    label $top.bg -padx 40 -relief sunk -background $bgcolor
7031    button $top.bgbut -text "Background" -font optionfont \
7032        -command [list choosecolor bgcolor 0 $top.bg background setbg]
7033    grid x $top.bgbut $top.bg -sticky w
7034    label $top.fg -padx 40 -relief sunk -background $fgcolor
7035    button $top.fgbut -text "Foreground" -font optionfont \
7036        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7037    grid x $top.fgbut $top.fg -sticky w
7038    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7039    button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7040        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7041                      [list $ctext tag conf d0 -foreground]]
7042    grid x $top.diffoldbut $top.diffold -sticky w
7043    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7044    button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7045        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7046                      [list $ctext tag conf d1 -foreground]]
7047    grid x $top.diffnewbut $top.diffnew -sticky w
7048    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7049    button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7050        -command [list choosecolor diffcolors 2 $top.hunksep \
7051                      "diff hunk header" \
7052                      [list $ctext tag conf hunksep -foreground]]
7053    grid x $top.hunksepbut $top.hunksep -sticky w
7054    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7055    button $top.selbgbut -text "Select bg" -font optionfont \
7056        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7057    grid x $top.selbgbut $top.selbgsep -sticky w
7058
7059    frame $top.buts
7060    button $top.buts.ok -text "OK" -command prefsok -default active
7061    $top.buts.ok configure -font $uifont
7062    button $top.buts.can -text "Cancel" -command prefscan -default normal
7063    $top.buts.can configure -font $uifont
7064    grid $top.buts.ok $top.buts.can
7065    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7066    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7067    grid $top.buts - - -pady 10 -sticky ew
7068    bind $top <Visibility> "focus $top.buts.ok"
7069}
7070
7071proc choosecolor {v vi w x cmd} {
7072    global $v
7073
7074    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7075               -title "Gitk: choose color for $x"]
7076    if {$c eq {}} return
7077    $w conf -background $c
7078    lset $v $vi $c
7079    eval $cmd $c
7080}
7081
7082proc setselbg {c} {
7083    global bglist cflist
7084    foreach w $bglist {
7085        $w configure -selectbackground $c
7086    }
7087    $cflist tag configure highlight \
7088        -background [$cflist cget -selectbackground]
7089    allcanvs itemconf secsel -fill $c
7090}
7091
7092proc setbg {c} {
7093    global bglist
7094
7095    foreach w $bglist {
7096        $w conf -background $c
7097    }
7098}
7099
7100proc setfg {c} {
7101    global fglist canv
7102
7103    foreach w $fglist {
7104        $w conf -foreground $c
7105    }
7106    allcanvs itemconf text -fill $c
7107    $canv itemconf circle -outline $c
7108}
7109
7110proc prefscan {} {
7111    global maxwidth maxgraphpct diffopts
7112    global oldprefs prefstop showneartags showlocalchanges
7113
7114    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7115        set $v $oldprefs($v)
7116    }
7117    catch {destroy $prefstop}
7118    unset prefstop
7119}
7120
7121proc prefsok {} {
7122    global maxwidth maxgraphpct
7123    global oldprefs prefstop showneartags showlocalchanges
7124    global charspc ctext tabstop
7125
7126    catch {destroy $prefstop}
7127    unset prefstop
7128    $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7129    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7130        if {$showlocalchanges} {
7131            doshowlocalchanges
7132        } else {
7133            dohidelocalchanges
7134        }
7135    }
7136    if {$maxwidth != $oldprefs(maxwidth)
7137        || $maxgraphpct != $oldprefs(maxgraphpct)} {
7138        redisplay
7139    } elseif {$showneartags != $oldprefs(showneartags)} {
7140        reselectline
7141    }
7142}
7143
7144proc formatdate {d} {
7145    if {$d ne {}} {
7146        set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7147    }
7148    return $d
7149}
7150
7151# This list of encoding names and aliases is distilled from
7152# http://www.iana.org/assignments/character-sets.
7153# Not all of them are supported by Tcl.
7154set encoding_aliases {
7155    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7156      ISO646-US US-ASCII us IBM367 cp367 csASCII }
7157    { ISO-10646-UTF-1 csISO10646UTF1 }
7158    { ISO_646.basic:1983 ref csISO646basic1983 }
7159    { INVARIANT csINVARIANT }
7160    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7161    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7162    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7163    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7164    { NATS-DANO iso-ir-9-1 csNATSDANO }
7165    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7166    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7167    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7168    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7169    { ISO-2022-KR csISO2022KR }
7170    { EUC-KR csEUCKR }
7171    { ISO-2022-JP csISO2022JP }
7172    { ISO-2022-JP-2 csISO2022JP2 }
7173    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7174      csISO13JISC6220jp }
7175    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7176    { IT iso-ir-15 ISO646-IT csISO15Italian }
7177    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7178    { ES iso-ir-17 ISO646-ES csISO17Spanish }
7179    { greek7-old iso-ir-18 csISO18Greek7Old }
7180    { latin-greek iso-ir-19 csISO19LatinGreek }
7181    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7182    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7183    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7184    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7185    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7186    { BS_viewdata iso-ir-47 csISO47BSViewdata }
7187    { INIS iso-ir-49 csISO49INIS }
7188    { INIS-8 iso-ir-50 csISO50INIS8 }
7189    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7190    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7191    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7192    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7193    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7194    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7195      csISO60Norwegian1 }
7196    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7197    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7198    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7199    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7200    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7201    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7202    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7203    { greek7 iso-ir-88 csISO88Greek7 }
7204    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7205    { iso-ir-90 csISO90 }
7206    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7207    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7208      csISO92JISC62991984b }
7209    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7210    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7211    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7212      csISO95JIS62291984handadd }
7213    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7214    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7215    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7216    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7217      CP819 csISOLatin1 }
7218    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7219    { T.61-7bit iso-ir-102 csISO102T617bit }
7220    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7221    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7222    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7223    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7224    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7225    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7226    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7227    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7228      arabic csISOLatinArabic }
7229    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7230    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7231    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7232      greek greek8 csISOLatinGreek }
7233    { T.101-G2 iso-ir-128 csISO128T101G2 }
7234    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7235      csISOLatinHebrew }
7236    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7237    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7238    { CSN_369103 iso-ir-139 csISO139CSN369103 }
7239    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7240    { ISO_6937-2-add iso-ir-142 csISOTextComm }
7241    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7242    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7243      csISOLatinCyrillic }
7244    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7245    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7246    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7247    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7248    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7249    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7250    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7251    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7252    { ISO_10367-box iso-ir-155 csISO10367Box }
7253    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7254    { latin-lap lap iso-ir-158 csISO158Lap }
7255    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7256    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7257    { us-dk csUSDK }
7258    { dk-us csDKUS }
7259    { JIS_X0201 X0201 csHalfWidthKatakana }
7260    { KSC5636 ISO646-KR csKSC5636 }
7261    { ISO-10646-UCS-2 csUnicode }
7262    { ISO-10646-UCS-4 csUCS4 }
7263    { DEC-MCS dec csDECMCS }
7264    { hp-roman8 roman8 r8 csHPRoman8 }
7265    { macintosh mac csMacintosh }
7266    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7267      csIBM037 }
7268    { IBM038 EBCDIC-INT cp038 csIBM038 }
7269    { IBM273 CP273 csIBM273 }
7270    { IBM274 EBCDIC-BE CP274 csIBM274 }
7271    { IBM275 EBCDIC-BR cp275 csIBM275 }
7272    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7273    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7274    { IBM280 CP280 ebcdic-cp-it csIBM280 }
7275    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7276    { IBM284 CP284 ebcdic-cp-es csIBM284 }
7277    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7278    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7279    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7280    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7281    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7282    { IBM424 cp424 ebcdic-cp-he csIBM424 }
7283    { IBM437 cp437 437 csPC8CodePage437 }
7284    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7285    { IBM775 cp775 csPC775Baltic }
7286    { IBM850 cp850 850 csPC850Multilingual }
7287    { IBM851 cp851 851 csIBM851 }
7288    { IBM852 cp852 852 csPCp852 }
7289    { IBM855 cp855 855 csIBM855 }
7290    { IBM857 cp857 857 csIBM857 }
7291    { IBM860 cp860 860 csIBM860 }
7292    { IBM861 cp861 861 cp-is csIBM861 }
7293    { IBM862 cp862 862 csPC862LatinHebrew }
7294    { IBM863 cp863 863 csIBM863 }
7295    { IBM864 cp864 csIBM864 }
7296    { IBM865 cp865 865 csIBM865 }
7297    { IBM866 cp866 866 csIBM866 }
7298    { IBM868 CP868 cp-ar csIBM868 }
7299    { IBM869 cp869 869 cp-gr csIBM869 }
7300    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7301    { IBM871 CP871 ebcdic-cp-is csIBM871 }
7302    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7303    { IBM891 cp891 csIBM891 }
7304    { IBM903 cp903 csIBM903 }
7305    { IBM904 cp904 904 csIBBM904 }
7306    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7307    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7308    { IBM1026 CP1026 csIBM1026 }
7309    { EBCDIC-AT-DE csIBMEBCDICATDE }
7310    { EBCDIC-AT-DE-A csEBCDICATDEA }
7311    { EBCDIC-CA-FR csEBCDICCAFR }
7312    { EBCDIC-DK-NO csEBCDICDKNO }
7313    { EBCDIC-DK-NO-A csEBCDICDKNOA }
7314    { EBCDIC-FI-SE csEBCDICFISE }
7315    { EBCDIC-FI-SE-A csEBCDICFISEA }
7316    { EBCDIC-FR csEBCDICFR }
7317    { EBCDIC-IT csEBCDICIT }
7318    { EBCDIC-PT csEBCDICPT }
7319    { EBCDIC-ES csEBCDICES }
7320    { EBCDIC-ES-A csEBCDICESA }
7321    { EBCDIC-ES-S csEBCDICESS }
7322    { EBCDIC-UK csEBCDICUK }
7323    { EBCDIC-US csEBCDICUS }
7324    { UNKNOWN-8BIT csUnknown8BiT }
7325    { MNEMONIC csMnemonic }
7326    { MNEM csMnem }
7327    { VISCII csVISCII }
7328    { VIQR csVIQR }
7329    { KOI8-R csKOI8R }
7330    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7331    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7332    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7333    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7334    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7335    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7336    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7337    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7338    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7339    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7340    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7341    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7342    { IBM1047 IBM-1047 }
7343    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7344    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7345    { UNICODE-1-1 csUnicode11 }
7346    { CESU-8 csCESU-8 }
7347    { BOCU-1 csBOCU-1 }
7348    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7349    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7350      l8 }
7351    { ISO-8859-15 ISO_8859-15 Latin-9 }
7352    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7353    { GBK CP936 MS936 windows-936 }
7354    { JIS_Encoding csJISEncoding }
7355    { Shift_JIS MS_Kanji csShiftJIS }
7356    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7357      EUC-JP }
7358    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7359    { ISO-10646-UCS-Basic csUnicodeASCII }
7360    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7361    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7362    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7363    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7364    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7365    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7366    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7367    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7368    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7369    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7370    { Adobe-Standard-Encoding csAdobeStandardEncoding }
7371    { Ventura-US csVenturaUS }
7372    { Ventura-International csVenturaInternational }
7373    { PC8-Danish-Norwegian csPC8DanishNorwegian }
7374    { PC8-Turkish csPC8Turkish }
7375    { IBM-Symbols csIBMSymbols }
7376    { IBM-Thai csIBMThai }
7377    { HP-Legal csHPLegal }
7378    { HP-Pi-font csHPPiFont }
7379    { HP-Math8 csHPMath8 }
7380    { Adobe-Symbol-Encoding csHPPSMath }
7381    { HP-DeskTop csHPDesktop }
7382    { Ventura-Math csVenturaMath }
7383    { Microsoft-Publishing csMicrosoftPublishing }
7384    { Windows-31J csWindows31J }
7385    { GB2312 csGB2312 }
7386    { Big5 csBig5 }
7387}
7388
7389proc tcl_encoding {enc} {
7390    global encoding_aliases
7391    set names [encoding names]
7392    set lcnames [string tolower $names]
7393    set enc [string tolower $enc]
7394    set i [lsearch -exact $lcnames $enc]
7395    if {$i < 0} {
7396        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7397        if {[regsub {^iso[-_]} $enc iso encx]} {
7398            set i [lsearch -exact $lcnames $encx]
7399        }
7400    }
7401    if {$i < 0} {
7402        foreach l $encoding_aliases {
7403            set ll [string tolower $l]
7404            if {[lsearch -exact $ll $enc] < 0} continue
7405            # look through the aliases for one that tcl knows about
7406            foreach e $ll {
7407                set i [lsearch -exact $lcnames $e]
7408                if {$i < 0} {
7409                    if {[regsub {^iso[-_]} $e iso ex]} {
7410                        set i [lsearch -exact $lcnames $ex]
7411                    }
7412                }
7413                if {$i >= 0} break
7414            }
7415            break
7416        }
7417    }
7418    if {$i >= 0} {
7419        return [lindex $names $i]
7420    }
7421    return {}
7422}
7423
7424# defaults...
7425set datemode 0
7426set diffopts "-U 5 -p"
7427set wrcomcmd "git diff-tree --stdin -p --pretty"
7428
7429set gitencoding {}
7430catch {
7431    set gitencoding [exec git config --get i18n.commitencoding]
7432}
7433if {$gitencoding == ""} {
7434    set gitencoding "utf-8"
7435}
7436set tclencoding [tcl_encoding $gitencoding]
7437if {$tclencoding == {}} {
7438    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7439}
7440
7441set mainfont {Helvetica 9}
7442set textfont {Courier 9}
7443set uifont {Helvetica 9 bold}
7444set tabstop 8
7445set findmergefiles 0
7446set maxgraphpct 50
7447set maxwidth 16
7448set revlistorder 0
7449set fastdate 0
7450set uparrowlen 7
7451set downarrowlen 7
7452set mingaplen 30
7453set cmitmode "patch"
7454set wrapcomment "none"
7455set showneartags 1
7456set maxrefs 20
7457set maxlinelen 200
7458set showlocalchanges 1
7459
7460set colors {green red blue magenta darkgrey brown orange}
7461set bgcolor white
7462set fgcolor black
7463set diffcolors {red "#00a000" blue}
7464set selectbgcolor gray85
7465
7466catch {source ~/.gitk}
7467
7468font create optionfont -family sans-serif -size -12
7469
7470# check that we can find a .git directory somewhere...
7471set gitdir [gitdir]
7472if {![file isdirectory $gitdir]} {
7473    show_error {} . "Cannot find the git directory \"$gitdir\"."
7474    exit 1
7475}
7476
7477set revtreeargs {}
7478set cmdline_files {}
7479set i 0
7480foreach arg $argv {
7481    switch -regexp -- $arg {
7482        "^$" { }
7483        "^-d" { set datemode 1 }
7484        "--" {
7485            set cmdline_files [lrange $argv [expr {$i + 1}] end]
7486            break
7487        }
7488        default {
7489            lappend revtreeargs $arg
7490        }
7491    }
7492    incr i
7493}
7494
7495if {$i >= [llength $argv] && $revtreeargs ne {}} {
7496    # no -- on command line, but some arguments (other than -d)
7497    if {[catch {
7498        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7499        set cmdline_files [split $f "\n"]
7500        set n [llength $cmdline_files]
7501        set revtreeargs [lrange $revtreeargs 0 end-$n]
7502        # Unfortunately git rev-parse doesn't produce an error when
7503        # something is both a revision and a filename.  To be consistent
7504        # with git log and git rev-list, check revtreeargs for filenames.
7505        foreach arg $revtreeargs {
7506            if {[file exists $arg]} {
7507                show_error {} . "Ambiguous argument '$arg': both revision\
7508                                 and filename"
7509                exit 1
7510            }
7511        }
7512    } err]} {
7513        # unfortunately we get both stdout and stderr in $err,
7514        # so look for "fatal:".
7515        set i [string first "fatal:" $err]
7516        if {$i > 0} {
7517            set err [string range $err [expr {$i + 6}] end]
7518        }
7519        show_error {} . "Bad arguments to gitk:\n$err"
7520        exit 1
7521    }
7522}
7523
7524set nullid "0000000000000000000000000000000000000000"
7525
7526set runq {}
7527set history {}
7528set historyindex 0
7529set fh_serial 0
7530set nhl_names {}
7531set highlight_paths {}
7532set searchdirn -forwards
7533set boldrows {}
7534set boldnamerows {}
7535set diffelide {0 0}
7536set markingmatches 0
7537
7538set optim_delay 16
7539
7540set nextviewnum 1
7541set curview 0
7542set selectedview 0
7543set selectedhlview None
7544set viewfiles(0) {}
7545set viewperm(0) 0
7546set viewargs(0) {}
7547
7548set cmdlineok 0
7549set stopped 0
7550set stuffsaved 0
7551set patchnum 0
7552set lookingforhead 0
7553set localrow -1
7554set lserial 0
7555setcoords
7556makewindow
7557wm title . "[file tail $argv0]: [file tail [pwd]]"
7558readrefs
7559
7560if {$cmdline_files ne {} || $revtreeargs ne {}} {
7561    # create a view for the files/dirs specified on the command line
7562    set curview 1
7563    set selectedview 1
7564    set nextviewnum 2
7565    set viewname(1) "Command line"
7566    set viewfiles(1) $cmdline_files
7567    set viewargs(1) $revtreeargs
7568    set viewperm(1) 0
7569    addviewmenu 1
7570    .bar.view entryconf Edit* -state normal
7571    .bar.view entryconf Delete* -state normal
7572}
7573
7574if {[info exists permviews]} {
7575    foreach v $permviews {
7576        set n $nextviewnum
7577        incr nextviewnum
7578        set viewname($n) [lindex $v 0]
7579        set viewfiles($n) [lindex $v 1]
7580        set viewargs($n) [lindex $v 2]
7581        set viewperm($n) 1
7582        addviewmenu $n
7583    }
7584}
7585getcommits