gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "${1+$@}"
   4
   5 # Copyright (C) 2005 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
  10 proc gitdir {} {
  11     global env
  12     if {[info exists env(GIT_DIR)]} {
  13         return $env(GIT_DIR)
  14     } else {
  15         return ".git"
  16     }
  17 }
  18
  19 proc getcommits {rargs} {
  20     global commits commfd phase canv mainfont env
  21     global startmsecs nextupdate
  22     global ctext maincursor textcursor leftover
  23
  24     # check that we can find a .git directory somewhere...
  25     set gitdir [gitdir]
  26     if {![file isdirectory $gitdir]} {
  27         error_popup "Cannot find the git directory \"$gitdir\"."
  28         exit 1
  29     }
  30     set commits {}
  31     set phase getcommits
  32     set startmsecs [clock clicks -milliseconds]
  33     set nextupdate [expr $startmsecs + 100]
  34     if [catch {
  35         set parse_args [concat --default HEAD $rargs]
  36         set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
  37     }] {
  38         # if git-rev-parse failed for some reason...
  39         if {$rargs == {}} {
  40             set rargs HEAD
  41         }
  42         set parsed_args $rargs
  43     }
  44     if [catch {
  45         set commfd [open "|git-rev-list --header --topo-order $parsed_args" r]
  46     } err] {
  47         puts stderr "Error executing git-rev-list: $err"
  48         exit 1
  49     }
  50     set leftover {}
  51     fconfigure $commfd -blocking 0 -translation lf
  52     fileevent $commfd readable "getcommitlines $commfd"
  53     $canv delete all
  54     $canv create text 3 3 -anchor nw -text "Reading commits..." \
  55         -font $mainfont -tags textitems
  56     . config -cursor watch
  57     settextcursor watch
  58 }
  59
  60 proc getcommitlines {commfd}  {
  61     global commits parents cdate children nchildren
  62     global commitlisted phase commitinfo nextupdate
  63     global stopped redisplaying leftover
  64
  65     set stuff [read $commfd]
  66     if {$stuff == {}} {
  67         if {![eof $commfd]} return
  68         # set it blocking so we wait for the process to terminate
  69         fconfigure $commfd -blocking 1
  70         if {![catch {close $commfd} err]} {
  71             after idle finishcommits
  72             return
  73         }
  74         if {[string range $err 0 4] == "usage"} {
  75             set err \
  76 {Gitk: error reading commits: bad arguments to git-rev-list.
  77 (Note: arguments to gitk are passed to git-rev-list
  78 to allow selection of commits to be displayed.)}
  79         } else {
  80             set err "Error reading commits: $err"
  81         }
  82         error_popup $err
  83         exit 1
  84     }
  85     set start 0
  86     while 1 {
  87         set i [string first "\0" $stuff $start]
  88         if {$i < 0} {
  89             append leftover [string range $stuff $start end]
  90             return
  91         }
  92         set cmit [string range $stuff $start [expr {$i - 1}]]
  93         if {$start == 0} {
  94             set cmit "$leftover$cmit"
  95             set leftover {}
  96         }
  97         set start [expr {$i + 1}]
  98         if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
  99             set shortcmit $cmit
 100             if {[string length $shortcmit] > 80} {
 101                 set shortcmit "[string range $shortcmit 0 80]..."
 102             }
 103             error_popup "Can't parse git-rev-list output: {$shortcmit}"
 104             exit 1
 105         }
 106         set cmit [string range $cmit 41 end]
 107         lappend commits $id
 108         set commitlisted($id) 1
 109         parsecommit $id $cmit 1
 110         drawcommit $id
 111         if {[clock clicks -milliseconds] >= $nextupdate} {
 112             doupdate
 113         }
 114         while {$redisplaying} {
 115             set redisplaying 0
 116             if {$stopped == 1} {
 117                 set stopped 0
 118                 set phase "getcommits"
 119                 foreach id $commits {
 120                     drawcommit $id
 121                     if {$stopped} break
 122                     if {[clock clicks -milliseconds] >= $nextupdate} {
 123                         doupdate
 124                     }
 125                 }
 126             }
 127         }
 128     }
 129 }
 130
 131 proc doupdate {} {
 132     global commfd nextupdate
 133
 134     incr nextupdate 100
 135     fileevent $commfd readable {}
 136     update
 137     fileevent $commfd readable "getcommitlines $commfd"
 138 }
 139
 140 proc readcommit {id} {
 141     if [catch {set contents [exec git-cat-file commit $id]}] return
 142     parsecommit $id $contents 0
 143 }
 144
 145 proc parsecommit {id contents listed} {
 146     global commitinfo children nchildren parents nparents cdate ncleft
 147
 148     set inhdr 1
 149     set comment {}
 150     set headline {}
 151     set auname {}
 152     set audate {}
 153     set comname {}
 154     set comdate {}
 155     if {![info exists nchildren($id)]} {
 156         set children($id) {}
 157         set nchildren($id) 0
 158         set ncleft($id) 0
 159     }
 160     set parents($id) {}
 161     set nparents($id) 0
 162     foreach line [split $contents "\n"] {
 163         if {$inhdr} {
 164             if {$line == {}} {
 165                 set inhdr 0
 166             } else {
 167                 set tag [lindex $line 0]
 168                 if {$tag == "parent"} {
 169                     set p [lindex $line 1]
 170                     if {![info exists nchildren($p)]} {
 171                         set children($p) {}
 172                         set nchildren($p) 0
 173                         set ncleft($p) 0
 174                     }
 175                     lappend parents($id) $p
 176                     incr nparents($id)
 177                     # sometimes we get a commit that lists a parent twice...
 178                     if {$listed && [lsearch -exact $children($p) $id] < 0} {
 179                         lappend children($p) $id
 180                         incr nchildren($p)
 181                         incr ncleft($p)
 182                     }
 183                 } elseif {$tag == "author"} {
 184                     set x [expr {[llength $line] - 2}]
 185                     set audate [lindex $line $x]
 186                     set auname [lrange $line 1 [expr {$x - 1}]]
 187                 } elseif {$tag == "committer"} {
 188                     set x [expr {[llength $line] - 2}]
 189                     set comdate [lindex $line $x]
 190                     set comname [lrange $line 1 [expr {$x - 1}]]
 191                 }
 192             }
 193         } else {
 194             if {$comment == {}} {
 195                 set headline [string trim $line]
 196             } else {
 197                 append comment "\n"
 198             }
 199             if {!$listed} {
 200                 # git-rev-list indents the comment by 4 spaces;
 201                 # if we got this via git-cat-file, add the indentation
 202                 append comment "    "
 203             }
 204             append comment $line
 205         }
 206     }
 207     if {$audate != {}} {
 208         set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 209     }
 210     if {$comdate != {}} {
 211         set cdate($id) $comdate
 212         set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 213     }
 214     set commitinfo($id) [list $headline $auname $audate \
 215                              $comname $comdate $comment]
 216 }
 217
 218 proc readrefs {} {
 219     global tagids idtags headids idheads
 220     set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
 221     foreach f $tags {
 222         catch {
 223             set fd [open $f r]
 224             set line [read $fd]
 225             if {[regexp {^[0-9a-f]{40}} $line id]} {
 226                 set direct [file tail $f]
 227                 set tagids($direct) $id
 228                 lappend idtags($id) $direct
 229                 set contents [split [exec git-cat-file tag $id] "\n"]
 230                 set obj {}
 231                 set type {}
 232                 set tag {}
 233                 foreach l $contents {
 234                     if {$l == {}} break
 235                     switch -- [lindex $l 0] {
 236                         "object" {set obj [lindex $l 1]}
 237                         "type" {set type [lindex $l 1]}
 238                         "tag" {set tag [string range $l 4 end]}
 239                     }
 240                 }
 241                 if {$obj != {} && $type == "commit" && $tag != {}} {
 242                     set tagids($tag) $obj
 243                     lappend idtags($obj) $tag
 244                 }
 245             }
 246             close $fd
 247         }
 248     }
 249     set heads [glob -nocomplain -types f [gitdir]/refs/heads/*]
 250     foreach f $heads {
 251         catch {
 252             set fd [open $f r]
 253             set line [read $fd 40]
 254             if {[regexp {^[0-9a-f]{40}} $line id]} {
 255                 set head [file tail $f]
 256                 set headids($head) $line
 257                 lappend idheads($line) $head
 258             }
 259             close $fd
 260         }
 261     }
 262 }
 263
 264 proc error_popup msg {
 265     set w .error
 266     toplevel $w
 267     wm transient $w .
 268     message $w.m -text $msg -justify center -aspect 400
 269     pack $w.m -side top -fill x -padx 20 -pady 20
 270     button $w.ok -text OK -command "destroy $w"
 271     pack $w.ok -side bottom -fill x
 272     bind $w <Visibility> "grab $w; focus $w"
 273     tkwait window $w
 274 }
 275
 276 proc makewindow {} {
 277     global canv canv2 canv3 linespc charspc ctext cflist textfont
 278     global findtype findtypemenu findloc findstring fstring geometry
 279     global entries sha1entry sha1string sha1but
 280     global maincursor textcursor curtextcursor
 281     global rowctxmenu gaudydiff mergemax
 282
 283     menu .bar
 284     .bar add cascade -label "File" -menu .bar.file
 285     menu .bar.file
 286     .bar.file add command -label "Quit" -command doquit
 287     menu .bar.help
 288     .bar add cascade -label "Help" -menu .bar.help
 289     .bar.help add command -label "About gitk" -command about
 290     . configure -menu .bar
 291
 292     if {![info exists geometry(canv1)]} {
 293         set geometry(canv1) [expr 45 * $charspc]
 294         set geometry(canv2) [expr 30 * $charspc]
 295         set geometry(canv3) [expr 15 * $charspc]
 296         set geometry(canvh) [expr 25 * $linespc + 4]
 297         set geometry(ctextw) 80
 298         set geometry(ctexth) 30
 299         set geometry(cflistw) 30
 300     }
 301     panedwindow .ctop -orient vertical
 302     if {[info exists geometry(width)]} {
 303         .ctop conf -width $geometry(width) -height $geometry(height)
 304         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 305         set geometry(ctexth) [expr {($texth - 8) /
 306                                     [font metrics $textfont -linespace]}]
 307     }
 308     frame .ctop.top
 309     frame .ctop.top.bar
 310     pack .ctop.top.bar -side bottom -fill x
 311     set cscroll .ctop.top.csb
 312     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 313     pack $cscroll -side right -fill y
 314     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 315     pack .ctop.top.clist -side top -fill both -expand 1
 316     .ctop add .ctop.top
 317     set canv .ctop.top.clist.canv
 318     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 319         -bg white -bd 0 \
 320         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 321     .ctop.top.clist add $canv
 322     set canv2 .ctop.top.clist.canv2
 323     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 324         -bg white -bd 0 -yscrollincr $linespc
 325     .ctop.top.clist add $canv2
 326     set canv3 .ctop.top.clist.canv3
 327     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 328         -bg white -bd 0 -yscrollincr $linespc
 329     .ctop.top.clist add $canv3
 330     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 331
 332     set sha1entry .ctop.top.bar.sha1
 333     set entries $sha1entry
 334     set sha1but .ctop.top.bar.sha1label
 335     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 336         -command gotocommit -width 8
 337     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 338     pack .ctop.top.bar.sha1label -side left
 339     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 340     trace add variable sha1string write sha1change
 341     pack $sha1entry -side left -pady 2
 342
 343     image create bitmap bm-left -data {
 344         #define left_width 16
 345         #define left_height 16
 346         static unsigned char left_bits[] = {
 347         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 348         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 349         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 350     }
 351     image create bitmap bm-right -data {
 352         #define right_width 16
 353         #define right_height 16
 354         static unsigned char right_bits[] = {
 355         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 356         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 357         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 358     }
 359     button .ctop.top.bar.leftbut -image bm-left -command goback \
 360         -state disabled -width 26
 361     pack .ctop.top.bar.leftbut -side left -fill y
 362     button .ctop.top.bar.rightbut -image bm-right -command goforw \
 363         -state disabled -width 26
 364     pack .ctop.top.bar.rightbut -side left -fill y
 365
 366     button .ctop.top.bar.findbut -text "Find" -command dofind
 367     pack .ctop.top.bar.findbut -side left
 368     set findstring {}
 369     set fstring .ctop.top.bar.findstring
 370     lappend entries $fstring
 371     entry $fstring -width 30 -font $textfont -textvariable findstring
 372     pack $fstring -side left -expand 1 -fill x
 373     set findtype Exact
 374     set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 375                           findtype Exact IgnCase Regexp]
 376     set findloc "All fields"
 377     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 378         Comments Author Committer Files Pickaxe
 379     pack .ctop.top.bar.findloc -side right
 380     pack .ctop.top.bar.findtype -side right
 381     # for making sure type==Exact whenever loc==Pickaxe
 382     trace add variable findloc write findlocchange
 383
 384     panedwindow .ctop.cdet -orient horizontal
 385     .ctop add .ctop.cdet
 386     frame .ctop.cdet.left
 387     set ctext .ctop.cdet.left.ctext
 388     text $ctext -bg white -state disabled -font $textfont \
 389         -width $geometry(ctextw) -height $geometry(ctexth) \
 390         -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
 391     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 392     pack .ctop.cdet.left.sb -side right -fill y
 393     pack $ctext -side left -fill both -expand 1
 394     .ctop.cdet add .ctop.cdet.left
 395
 396     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 397     if {$gaudydiff} {
 398         $ctext tag conf hunksep -back blue -fore white
 399         $ctext tag conf d0 -back "#ff8080"
 400         $ctext tag conf d1 -back green
 401     } else {
 402         $ctext tag conf hunksep -fore blue
 403         $ctext tag conf d0 -fore red
 404         $ctext tag conf d1 -fore "#00a000"
 405         $ctext tag conf m0 -fore red
 406         $ctext tag conf m1 -fore blue
 407         $ctext tag conf m2 -fore green
 408         $ctext tag conf m3 -fore purple
 409         $ctext tag conf m4 -fore brown
 410         $ctext tag conf mmax -fore darkgrey
 411         set mergemax 5
 412         $ctext tag conf mresult -font [concat $textfont bold]
 413         $ctext tag conf msep -font [concat $textfont bold]
 414         $ctext tag conf found -back yellow
 415     }
 416
 417     frame .ctop.cdet.right
 418     set cflist .ctop.cdet.right.cfiles
 419     listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 420         -yscrollcommand ".ctop.cdet.right.sb set"
 421     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 422     pack .ctop.cdet.right.sb -side right -fill y
 423     pack $cflist -side left -fill both -expand 1
 424     .ctop.cdet add .ctop.cdet.right
 425     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 426
 427     pack .ctop -side top -fill both -expand 1
 428
 429     bindall <1> {selcanvline %W %x %y}
 430     #bindall <B1-Motion> {selcanvline %W %x %y}
 431     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 432     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 433     bindall <2> "allcanvs scan mark 0 %y"
 434     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 435     bind . <Key-Up> "selnextline -1"
 436     bind . <Key-Down> "selnextline 1"
 437     bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 438     bind . <Key-Next> "allcanvs yview scroll 1 pages"
 439     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 440     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 441     bindkey <Key-space> "$ctext yview scroll 1 pages"
 442     bindkey p "selnextline -1"
 443     bindkey n "selnextline 1"
 444     bindkey b "$ctext yview scroll -1 pages"
 445     bindkey d "$ctext yview scroll 18 units"
 446     bindkey u "$ctext yview scroll -18 units"
 447     bindkey / {findnext 1}
 448     bindkey <Key-Return> {findnext 0}
 449     bindkey ? findprev
 450     bindkey f nextfile
 451     bind . <Control-q> doquit
 452     bind . <Control-f> dofind
 453     bind . <Control-g> {findnext 0}
 454     bind . <Control-r> findprev
 455     bind . <Control-equal> {incrfont 1}
 456     bind . <Control-KP_Add> {incrfont 1}
 457     bind . <Control-minus> {incrfont -1}
 458     bind . <Control-KP_Subtract> {incrfont -1}
 459     bind $cflist <<ListboxSelect>> listboxsel
 460     bind . <Destroy> {savestuff %W}
 461     bind . <Button-1> "click %W"
 462     bind $fstring <Key-Return> dofind
 463     bind $sha1entry <Key-Return> gotocommit
 464     bind $sha1entry <<PasteSelection>> clearsha1
 465
 466     set maincursor [. cget -cursor]
 467     set textcursor [$ctext cget -cursor]
 468     set curtextcursor $textcursor
 469
 470     set rowctxmenu .rowctxmenu
 471     menu $rowctxmenu -tearoff 0
 472     $rowctxmenu add command -label "Diff this -> selected" \
 473         -command {diffvssel 0}
 474     $rowctxmenu add command -label "Diff selected -> this" \
 475         -command {diffvssel 1}
 476     $rowctxmenu add command -label "Make patch" -command mkpatch
 477     $rowctxmenu add command -label "Create tag" -command mktag
 478     $rowctxmenu add command -label "Write commit to file" -command writecommit
 479 }
 480
 481 # when we make a key binding for the toplevel, make sure
 482 # it doesn't get triggered when that key is pressed in the
 483 # find string entry widget.
 484 proc bindkey {ev script} {
 485     global entries
 486     bind . $ev $script
 487     set escript [bind Entry $ev]
 488     if {$escript == {}} {
 489         set escript [bind Entry <Key>]
 490     }
 491     foreach e $entries {
 492         bind $e $ev "$escript; break"
 493     }
 494 }
 495
 496 # set the focus back to the toplevel for any click outside
 497 # the entry widgets
 498 proc click {w} {
 499     global entries
 500     foreach e $entries {
 501         if {$w == $e} return
 502     }
 503     focus .
 504 }
 505
 506 proc savestuff {w} {
 507     global canv canv2 canv3 ctext cflist mainfont textfont
 508     global stuffsaved findmergefiles gaudydiff maxgraphpct
 509
 510     if {$stuffsaved} return
 511     if {![winfo viewable .]} return
 512     catch {
 513         set f [open "~/.gitk-new" w]
 514         puts $f [list set mainfont $mainfont]
 515         puts $f [list set textfont $textfont]
 516         puts $f [list set findmergefiles $findmergefiles]
 517         puts $f [list set gaudydiff $gaudydiff]
 518         puts $f [list set maxgraphpct $maxgraphpct]
 519         puts $f "set geometry(width) [winfo width .ctop]"
 520         puts $f "set geometry(height) [winfo height .ctop]"
 521         puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
 522         puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
 523         puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
 524         puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
 525         set wid [expr {([winfo width $ctext] - 8) \
 526                            / [font measure $textfont "0"]}]
 527         puts $f "set geometry(ctextw) $wid"
 528         set wid [expr {([winfo width $cflist] - 11) \
 529                            / [font measure [$cflist cget -font] "0"]}]
 530         puts $f "set geometry(cflistw) $wid"
 531         close $f
 532         file rename -force "~/.gitk-new" "~/.gitk"
 533     }
 534     set stuffsaved 1
 535 }
 536
 537 proc resizeclistpanes {win w} {
 538     global oldwidth
 539     if [info exists oldwidth($win)] {
 540         set s0 [$win sash coord 0]
 541         set s1 [$win sash coord 1]
 542         if {$w < 60} {
 543             set sash0 [expr {int($w/2 - 2)}]
 544             set sash1 [expr {int($w*5/6 - 2)}]
 545         } else {
 546             set factor [expr {1.0 * $w / $oldwidth($win)}]
 547             set sash0 [expr {int($factor * [lindex $s0 0])}]
 548             set sash1 [expr {int($factor * [lindex $s1 0])}]
 549             if {$sash0 < 30} {
 550                 set sash0 30
 551             }
 552             if {$sash1 < $sash0 + 20} {
 553                 set sash1 [expr $sash0 + 20]
 554             }
 555             if {$sash1 > $w - 10} {
 556                 set sash1 [expr $w - 10]
 557                 if {$sash0 > $sash1 - 20} {
 558                     set sash0 [expr $sash1 - 20]
 559                 }
 560             }
 561         }
 562         $win sash place 0 $sash0 [lindex $s0 1]
 563         $win sash place 1 $sash1 [lindex $s1 1]
 564     }
 565     set oldwidth($win) $w
 566 }
 567
 568 proc resizecdetpanes {win w} {
 569     global oldwidth
 570     if [info exists oldwidth($win)] {
 571         set s0 [$win sash coord 0]
 572         if {$w < 60} {
 573             set sash0 [expr {int($w*3/4 - 2)}]
 574         } else {
 575             set factor [expr {1.0 * $w / $oldwidth($win)}]
 576             set sash0 [expr {int($factor * [lindex $s0 0])}]
 577             if {$sash0 < 45} {
 578                 set sash0 45
 579             }
 580             if {$sash0 > $w - 15} {
 581                 set sash0 [expr $w - 15]
 582             }
 583         }
 584         $win sash place 0 $sash0 [lindex $s0 1]
 585     }
 586     set oldwidth($win) $w
 587 }
 588
 589 proc allcanvs args {
 590     global canv canv2 canv3
 591     eval $canv $args
 592     eval $canv2 $args
 593     eval $canv3 $args
 594 }
 595
 596 proc bindall {event action} {
 597     global canv canv2 canv3
 598     bind $canv $event $action
 599     bind $canv2 $event $action
 600     bind $canv3 $event $action
 601 }
 602
 603 proc about {} {
 604     set w .about
 605     if {[winfo exists $w]} {
 606         raise $w
 607         return
 608     }
 609     toplevel $w
 610     wm title $w "About gitk"
 611     message $w.m -text {
 612 Gitk version 1.2
 613
 614 Copyright © 2005 Paul Mackerras
 615
 616 Use and redistribute under the terms of the GNU General Public License} \
 617             -justify center -aspect 400
 618     pack $w.m -side top -fill x -padx 20 -pady 20
 619     button $w.ok -text Close -command "destroy $w"
 620     pack $w.ok -side bottom
 621 }
 622
 623 proc assigncolor {id} {
 624     global commitinfo colormap commcolors colors nextcolor
 625     global parents nparents children nchildren
 626     global cornercrossings crossings
 627
 628     if [info exists colormap($id)] return
 629     set ncolors [llength $colors]
 630     if {$nparents($id) <= 1 && $nchildren($id) == 1} {
 631         set child [lindex $children($id) 0]
 632         if {[info exists colormap($child)]
 633             && $nparents($child) == 1} {
 634             set colormap($id) $colormap($child)
 635             return
 636         }
 637     }
 638     set badcolors {}
 639     if {[info exists cornercrossings($id)]} {
 640         foreach x $cornercrossings($id) {
 641             if {[info exists colormap($x)]
 642                 && [lsearch -exact $badcolors $colormap($x)] < 0} {
 643                 lappend badcolors $colormap($x)
 644             }
 645         }
 646         if {[llength $badcolors] >= $ncolors} {
 647             set badcolors {}
 648         }
 649     }
 650     set origbad $badcolors
 651     if {[llength $badcolors] < $ncolors - 1} {
 652         if {[info exists crossings($id)]} {
 653             foreach x $crossings($id) {
 654                 if {[info exists colormap($x)]
 655                     && [lsearch -exact $badcolors $colormap($x)] < 0} {
 656                     lappend badcolors $colormap($x)
 657                 }
 658             }
 659             if {[llength $badcolors] >= $ncolors} {
 660                 set badcolors $origbad
 661             }
 662         }
 663         set origbad $badcolors
 664     }
 665     if {[llength $badcolors] < $ncolors - 1} {
 666         foreach child $children($id) {
 667             if {[info exists colormap($child)]
 668                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
 669                 lappend badcolors $colormap($child)
 670             }
 671             if {[info exists parents($child)]} {
 672                 foreach p $parents($child) {
 673                     if {[info exists colormap($p)]
 674                         && [lsearch -exact $badcolors $colormap($p)] < 0} {
 675                         lappend badcolors $colormap($p)
 676                     }
 677                 }
 678             }
 679         }
 680         if {[llength $badcolors] >= $ncolors} {
 681             set badcolors $origbad
 682         }
 683     }
 684     for {set i 0} {$i <= $ncolors} {incr i} {
 685         set c [lindex $colors $nextcolor]
 686         if {[incr nextcolor] >= $ncolors} {
 687             set nextcolor 0
 688         }
 689         if {[lsearch -exact $badcolors $c]} break
 690     }
 691     set colormap($id) $c
 692 }
 693
 694 proc initgraph {} {
 695     global canvy canvy0 lineno numcommits lthickness nextcolor linespc
 696     global mainline sidelines
 697     global nchildren ncleft
 698
 699     allcanvs delete all
 700     set nextcolor 0
 701     set canvy $canvy0
 702     set lineno -1
 703     set numcommits 0
 704     set lthickness [expr {int($linespc / 9) + 1}]
 705     catch {unset mainline}
 706     catch {unset sidelines}
 707     foreach id [array names nchildren] {
 708         set ncleft($id) $nchildren($id)
 709     }
 710 }
 711
 712 proc bindline {t id} {
 713     global canv
 714
 715     $canv bind $t <Enter> "lineenter %x %y $id"
 716     $canv bind $t <Motion> "linemotion %x %y $id"
 717     $canv bind $t <Leave> "lineleave $id"
 718     $canv bind $t <Button-1> "lineclick %x %y $id 1"
 719 }
 720
 721 proc drawcommitline {level} {
 722     global parents children nparents nchildren todo
 723     global canv canv2 canv3 mainfont namefont canvy linespc
 724     global lineid linehtag linentag linedtag commitinfo
 725     global colormap numcommits currentparents dupparents
 726     global oldlevel oldnlines oldtodo
 727     global idtags idline idheads
 728     global lineno lthickness mainline sidelines
 729     global commitlisted rowtextx idpos
 730
 731     incr numcommits
 732     incr lineno
 733     set id [lindex $todo $level]
 734     set lineid($lineno) $id
 735     set idline($id) $lineno
 736     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 737     if {![info exists commitinfo($id)]} {
 738         readcommit $id
 739         if {![info exists commitinfo($id)]} {
 740             set commitinfo($id) {"No commit information available"}
 741             set nparents($id) 0
 742         }
 743     }
 744     assigncolor $id
 745     set currentparents {}
 746     set dupparents {}
 747     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 748         foreach p $parents($id) {
 749             if {[lsearch -exact $currentparents $p] < 0} {
 750                 lappend currentparents $p
 751             } else {
 752                 # remember that this parent was listed twice
 753                 lappend dupparents $p
 754             }
 755         }
 756     }
 757     set x [xcoord $level $level $lineno]
 758     set y1 $canvy
 759     set canvy [expr $canvy + $linespc]
 760     allcanvs conf -scrollregion \
 761         [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
 762     if {[info exists mainline($id)]} {
 763         lappend mainline($id) $x $y1
 764         set t [$canv create line $mainline($id) \
 765                    -width $lthickness -fill $colormap($id)]
 766         $canv lower $t
 767         bindline $t $id
 768     }
 769     if {[info exists sidelines($id)]} {
 770         foreach ls $sidelines($id) {
 771             set coords [lindex $ls 0]
 772             set thick [lindex $ls 1]
 773             set t [$canv create line $coords -fill $colormap($id) \
 774                        -width [expr {$thick * $lthickness}]]
 775             $canv lower $t
 776             bindline $t $id
 777         }
 778     }
 779     set orad [expr {$linespc / 3}]
 780     set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
 781                [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
 782                -fill $ofill -outline black -width 1]
 783     $canv raise $t
 784     $canv bind $t <1> {selcanvline {} %x %y}
 785     set xt [xcoord [llength $todo] $level $lineno]
 786     if {[llength $currentparents] > 2} {
 787         set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
 788     }
 789     set rowtextx($lineno) $xt
 790     set idpos($id) [list $x $xt $y1]
 791     if {[info exists idtags($id)] || [info exists idheads($id)]} {
 792         set xt [drawtags $id $x $xt $y1]
 793     }
 794     set headline [lindex $commitinfo($id) 0]
 795     set name [lindex $commitinfo($id) 1]
 796     set date [lindex $commitinfo($id) 2]
 797     set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 798                                -text $headline -font $mainfont ]
 799     $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
 800     set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 801                                -text $name -font $namefont]
 802     set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 803                                -text $date -font $mainfont]
 804 }
 805
 806 proc drawtags {id x xt y1} {
 807     global idtags idheads
 808     global linespc lthickness
 809     global canv mainfont
 810
 811     set marks {}
 812     set ntags 0
 813     if {[info exists idtags($id)]} {
 814         set marks $idtags($id)
 815         set ntags [llength $marks]
 816     }
 817     if {[info exists idheads($id)]} {
 818         set marks [concat $marks $idheads($id)]
 819     }
 820     if {$marks eq {}} {
 821         return $xt
 822     }
 823
 824     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 825     set yt [expr $y1 - 0.5 * $linespc]
 826     set yb [expr $yt + $linespc - 1]
 827     set xvals {}
 828     set wvals {}
 829     foreach tag $marks {
 830         set wid [font measure $mainfont $tag]
 831         lappend xvals $xt
 832         lappend wvals $wid
 833         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 834     }
 835     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 836                -width $lthickness -fill black -tags tag.$id]
 837     $canv lower $t
 838     foreach tag $marks x $xvals wid $wvals {
 839         set xl [expr $x + $delta]
 840         set xr [expr $x + $delta + $wid + $lthickness]
 841         if {[incr ntags -1] >= 0} {
 842             # draw a tag
 843             $canv create polygon $x [expr $yt + $delta] $xl $yt\
 844                 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
 845                 -width 1 -outline black -fill yellow -tags tag.$id
 846         } else {
 847             # draw a head
 848             set xl [expr $xl - $delta/2]
 849             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 850                 -width 1 -outline black -fill green -tags tag.$id
 851         }
 852         $canv create text $xl $y1 -anchor w -text $tag \
 853             -font $mainfont -tags tag.$id
 854     }
 855     return $xt
 856 }
 857
 858 proc updatetodo {level noshortcut} {
 859     global currentparents ncleft todo
 860     global mainline oldlevel oldtodo oldnlines
 861     global canvy linespc mainline
 862     global commitinfo lineno xspc1
 863
 864     set oldlevel $level
 865     set oldtodo $todo
 866     set oldnlines [llength $todo]
 867     if {!$noshortcut && [llength $currentparents] == 1} {
 868         set p [lindex $currentparents 0]
 869         if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
 870             set ncleft($p) 0
 871             set x [xcoord $level $level $lineno]
 872             set y [expr $canvy - $linespc]
 873             set mainline($p) [list $x $y]
 874             set todo [lreplace $todo $level $level $p]
 875             set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
 876             return 0
 877         }
 878     }
 879
 880     set todo [lreplace $todo $level $level]
 881     set i $level
 882     foreach p $currentparents {
 883         incr ncleft($p) -1
 884         set k [lsearch -exact $todo $p]
 885         if {$k < 0} {
 886             set todo [linsert $todo $i $p]
 887             incr i
 888         }
 889     }
 890     return 1
 891 }
 892
 893 proc notecrossings {id lo hi corner} {
 894     global oldtodo crossings cornercrossings
 895
 896     for {set i $lo} {[incr i] < $hi} {} {
 897         set p [lindex $oldtodo $i]
 898         if {$p == {}} continue
 899         if {$i == $corner} {
 900             if {![info exists cornercrossings($id)]
 901                 || [lsearch -exact $cornercrossings($id) $p] < 0} {
 902                 lappend cornercrossings($id) $p
 903             }
 904             if {![info exists cornercrossings($p)]
 905                 || [lsearch -exact $cornercrossings($p) $id] < 0} {
 906                 lappend cornercrossings($p) $id
 907             }
 908         } else {
 909             if {![info exists crossings($id)]
 910                 || [lsearch -exact $crossings($id) $p] < 0} {
 911                 lappend crossings($id) $p
 912             }
 913             if {![info exists crossings($p)]
 914                 || [lsearch -exact $crossings($p) $id] < 0} {
 915                 lappend crossings($p) $id
 916             }
 917         }
 918     }
 919 }
 920
 921 proc xcoord {i level ln} {
 922     global canvx0 xspc1 xspc2
 923
 924     set x [expr {$canvx0 + $i * $xspc1($ln)}]
 925     if {$i > 0 && $i == $level} {
 926         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
 927     } elseif {$i > $level} {
 928         set x [expr {$x + $xspc2 - $xspc1($ln)}]
 929     }
 930     return $x
 931 }
 932
 933 proc drawslants {level} {
 934     global canv mainline sidelines canvx0 canvy xspc1 xspc2 lthickness
 935     global oldlevel oldtodo todo currentparents dupparents
 936     global lthickness linespc canvy colormap lineno geometry
 937     global maxgraphpct
 938
 939     # decide on the line spacing for the next line
 940     set lj [expr {$lineno + 1}]
 941     set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
 942     set n [llength $todo]
 943     if {$n <= 1 || $canvx0 + $n * $xspc2 <= $maxw} {
 944         set xspc1($lj) $xspc2
 945     } else {
 946         set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($n - 1)}]
 947         if {$xspc1($lj) < $lthickness} {
 948             set xspc1($lj) $lthickness
 949         }
 950     }
 951
 952     set y1 [expr $canvy - $linespc]
 953     set y2 $canvy
 954     set i -1
 955     foreach id $oldtodo {
 956         incr i
 957         if {$id == {}} continue
 958         set xi [xcoord $i $oldlevel $lineno]
 959         if {$i == $oldlevel} {
 960             foreach p $currentparents {
 961                 set j [lsearch -exact $todo $p]
 962                 set coords [list $xi $y1]
 963                 set xj [xcoord $j $level $lj]
 964                 if {$xj < $xi - $linespc} {
 965                     lappend coords [expr {$xj + $linespc}] $y1
 966                     notecrossings $p $j $i [expr {$j + 1}]
 967                 } elseif {$xj > $xi + $linespc} {
 968                     lappend coords [expr {$xj - $linespc}] $y1
 969                     notecrossings $p $i $j [expr {$j - 1}]
 970                 }
 971                 if {[lsearch -exact $dupparents $p] >= 0} {
 972                     # draw a double-width line to indicate the doubled parent
 973                     lappend coords $xj $y2
 974                     lappend sidelines($p) [list $coords 2]
 975                     if {![info exists mainline($p)]} {
 976                         set mainline($p) [list $xj $y2]
 977                     }
 978                 } else {
 979                     # normal case, no parent duplicated
 980                     set yb $y2
 981                     set dx [expr {abs($xi - $xj)}]
 982                     if {0 && $dx < $linespc} {
 983                         set yb [expr {$y1 + $dx}]
 984                     }
 985                     if {![info exists mainline($p)]} {
 986                         if {$xi != $xj} {
 987                             lappend coords $xj $yb
 988                         }
 989                         set mainline($p) $coords
 990                     } else {
 991                         lappend coords $xj $yb
 992                         if {$yb < $y2} {
 993                             lappend coords $xj $y2
 994                         }
 995                         lappend sidelines($p) [list $coords 1]
 996                     }
 997                 }
 998             }
 999         } else {
1000             set j $i
1001             if {[lindex $todo $i] != $id} {
1002                 set j [lsearch -exact $todo $id]
1003             }
1004             if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1005                 || ($oldlevel <= $i && $i <= $level)
1006                 || ($level <= $i && $i <= $oldlevel)} {
1007                 set xj [xcoord $j $level $lj]
1008                 set dx [expr {abs($xi - $xj)}]
1009                 set yb $y2
1010                 if {0 && $dx < $linespc} {
1011                     set yb [expr {$y1 + $dx}]
1012                 }
1013                 lappend mainline($id) $xi $y1 $xj $yb
1014             }
1015         }
1016     }
1017 }
1018
1019 proc decidenext {{noread 0}} {
1020     global parents children nchildren ncleft todo
1021     global canv canv2 canv3 mainfont namefont canvy linespc
1022     global datemode cdate
1023     global commitinfo
1024     global currentparents oldlevel oldnlines oldtodo
1025     global lineno lthickness
1026
1027     # remove the null entry if present
1028     set nullentry [lsearch -exact $todo {}]
1029     if {$nullentry >= 0} {
1030         set todo [lreplace $todo $nullentry $nullentry]
1031     }
1032
1033     # choose which one to do next time around
1034     set todol [llength $todo]
1035     set level -1
1036     set latest {}
1037     for {set k $todol} {[incr k -1] >= 0} {} {
1038         set p [lindex $todo $k]
1039         if {$ncleft($p) == 0} {
1040             if {$datemode} {
1041                 if {![info exists commitinfo($p)]} {
1042                     if {$noread} {
1043                         return {}
1044                     }
1045                     readcommit $p
1046                 }
1047                 if {$latest == {} || $cdate($p) > $latest} {
1048                     set level $k
1049                     set latest $cdate($p)
1050                 }
1051             } else {
1052                 set level $k
1053                 break
1054             }
1055         }
1056     }
1057     if {$level < 0} {
1058         if {$todo != {}} {
1059             puts "ERROR: none of the pending commits can be done yet:"
1060             foreach p $todo {
1061                 puts "  $p ($ncleft($p))"
1062             }
1063         }
1064         return -1
1065     }
1066
1067     # If we are reducing, put in a null entry
1068     if {$todol < $oldnlines} {
1069         if {$nullentry >= 0} {
1070             set i $nullentry
1071             while {$i < $todol
1072                    && [lindex $oldtodo $i] == [lindex $todo $i]} {
1073                 incr i
1074             }
1075         } else {
1076             set i $oldlevel
1077             if {$level >= $i} {
1078                 incr i
1079             }
1080         }
1081         if {$i < $todol} {
1082             set todo [linsert $todo $i {}]
1083             if {$level >= $i} {
1084                 incr level
1085             }
1086         }
1087     }
1088     return $level
1089 }
1090
1091 proc drawcommit {id} {
1092     global phase todo nchildren datemode nextupdate
1093     global startcommits
1094
1095     if {$phase != "incrdraw"} {
1096         set phase incrdraw
1097         set todo $id
1098         set startcommits $id
1099         initgraph
1100         drawcommitline 0
1101         updatetodo 0 $datemode
1102     } else {
1103         if {$nchildren($id) == 0} {
1104             lappend todo $id
1105             lappend startcommits $id
1106         }
1107         set level [decidenext 1]
1108         if {$level == {} || $id != [lindex $todo $level]} {
1109             return
1110         }
1111         while 1 {
1112             drawslants $level
1113             drawcommitline $level
1114             if {[updatetodo $level $datemode]} {
1115                 set level [decidenext 1]
1116                 if {$level == {}} break
1117             }
1118             set id [lindex $todo $level]
1119             if {![info exists commitlisted($id)]} {
1120                 break
1121             }
1122             if {[clock clicks -milliseconds] >= $nextupdate} {
1123                 doupdate
1124                 if {$stopped} break
1125             }
1126         }
1127     }
1128 }
1129
1130 proc finishcommits {} {
1131     global phase
1132     global startcommits
1133     global canv mainfont ctext maincursor textcursor
1134
1135     if {$phase != "incrdraw"} {
1136         $canv delete all
1137         $canv create text 3 3 -anchor nw -text "No commits selected" \
1138             -font $mainfont -tags textitems
1139         set phase {}
1140     } else {
1141         set level [decidenext]
1142         drawslants $level
1143         drawrest $level [llength $startcommits]
1144     }
1145     . config -cursor $maincursor
1146     settextcursor $textcursor
1147 }
1148
1149 # Don't change the text pane cursor if it is currently the hand cursor,
1150 # showing that we are over a sha1 ID link.
1151 proc settextcursor {c} {
1152     global ctext curtextcursor
1153
1154     if {[$ctext cget -cursor] == $curtextcursor} {
1155         $ctext config -cursor $c
1156     }
1157     set curtextcursor $c
1158 }
1159
1160 proc drawgraph {} {
1161     global nextupdate startmsecs startcommits todo
1162
1163     if {$startcommits == {}} return
1164     set startmsecs [clock clicks -milliseconds]
1165     set nextupdate [expr $startmsecs + 100]
1166     initgraph
1167     set todo [lindex $startcommits 0]
1168     drawrest 0 1
1169 }
1170
1171 proc drawrest {level startix} {
1172     global phase stopped redisplaying selectedline
1173     global datemode currentparents todo
1174     global numcommits
1175     global nextupdate startmsecs startcommits idline
1176
1177     if {$level >= 0} {
1178         set phase drawgraph
1179         set startid [lindex $startcommits $startix]
1180         set startline -1
1181         if {$startid != {}} {
1182             set startline $idline($startid)
1183         }
1184         while 1 {
1185             if {$stopped} break
1186             drawcommitline $level
1187             set hard [updatetodo $level $datemode]
1188             if {$numcommits == $startline} {
1189                 lappend todo $startid
1190                 set hard 1
1191                 incr startix
1192                 set startid [lindex $startcommits $startix]
1193                 set startline -1
1194                 if {$startid != {}} {
1195                     set startline $idline($startid)
1196                 }
1197             }
1198             if {$hard} {
1199                 set level [decidenext]
1200                 if {$level < 0} break
1201                 drawslants $level
1202             }
1203             if {[clock clicks -milliseconds] >= $nextupdate} {
1204                 update
1205                 incr nextupdate 100
1206             }
1207         }
1208     }
1209     set phase {}
1210     set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1211     #puts "overall $drawmsecs ms for $numcommits commits"
1212     if {$redisplaying} {
1213         if {$stopped == 0 && [info exists selectedline]} {
1214             selectline $selectedline 0
1215         }
1216         if {$stopped == 1} {
1217             set stopped 0
1218             after idle drawgraph
1219         } else {
1220             set redisplaying 0
1221         }
1222     }
1223 }
1224
1225 proc findmatches {f} {
1226     global findtype foundstring foundstrlen
1227     if {$findtype == "Regexp"} {
1228         set matches [regexp -indices -all -inline $foundstring $f]
1229     } else {
1230         if {$findtype == "IgnCase"} {
1231             set str [string tolower $f]
1232         } else {
1233             set str $f
1234         }
1235         set matches {}
1236         set i 0
1237         while {[set j [string first $foundstring $str $i]] >= 0} {
1238             lappend matches [list $j [expr $j+$foundstrlen-1]]
1239             set i [expr $j + $foundstrlen]
1240         }
1241     }
1242     return $matches
1243 }
1244
1245 proc dofind {} {
1246     global findtype findloc findstring markedmatches commitinfo
1247     global numcommits lineid linehtag linentag linedtag
1248     global mainfont namefont canv canv2 canv3 selectedline
1249     global matchinglines foundstring foundstrlen
1250
1251     stopfindproc
1252     unmarkmatches
1253     focus .
1254     set matchinglines {}
1255     if {$findloc == "Pickaxe"} {
1256         findpatches
1257         return
1258     }
1259     if {$findtype == "IgnCase"} {
1260         set foundstring [string tolower $findstring]
1261     } else {
1262         set foundstring $findstring
1263     }
1264     set foundstrlen [string length $findstring]
1265     if {$foundstrlen == 0} return
1266     if {$findloc == "Files"} {
1267         findfiles
1268         return
1269     }
1270     if {![info exists selectedline]} {
1271         set oldsel -1
1272     } else {
1273         set oldsel $selectedline
1274     }
1275     set didsel 0
1276     set fldtypes {Headline Author Date Committer CDate Comment}
1277     for {set l 0} {$l < $numcommits} {incr l} {
1278         set id $lineid($l)
1279         set info $commitinfo($id)
1280         set doesmatch 0
1281         foreach f $info ty $fldtypes {
1282             if {$findloc != "All fields" && $findloc != $ty} {
1283                 continue
1284             }
1285             set matches [findmatches $f]
1286             if {$matches == {}} continue
1287             set doesmatch 1
1288             if {$ty == "Headline"} {
1289                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1290             } elseif {$ty == "Author"} {
1291                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1292             } elseif {$ty == "Date"} {
1293                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1294             }
1295         }
1296         if {$doesmatch} {
1297             lappend matchinglines $l
1298             if {!$didsel && $l > $oldsel} {
1299                 findselectline $l
1300                 set didsel 1
1301             }
1302         }
1303     }
1304     if {$matchinglines == {}} {
1305         bell
1306     } elseif {!$didsel} {
1307         findselectline [lindex $matchinglines 0]
1308     }
1309 }
1310
1311 proc findselectline {l} {
1312     global findloc commentend ctext
1313     selectline $l 1
1314     if {$findloc == "All fields" || $findloc == "Comments"} {
1315         # highlight the matches in the comments
1316         set f [$ctext get 1.0 $commentend]
1317         set matches [findmatches $f]
1318         foreach match $matches {
1319             set start [lindex $match 0]
1320             set end [expr [lindex $match 1] + 1]
1321             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1322         }
1323     }
1324 }
1325
1326 proc findnext {restart} {
1327     global matchinglines selectedline
1328     if {![info exists matchinglines]} {
1329         if {$restart} {
1330             dofind
1331         }
1332         return
1333     }
1334     if {![info exists selectedline]} return
1335     foreach l $matchinglines {
1336         if {$l > $selectedline} {
1337             findselectline $l
1338             return
1339         }
1340     }
1341     bell
1342 }
1343
1344 proc findprev {} {
1345     global matchinglines selectedline
1346     if {![info exists matchinglines]} {
1347         dofind
1348         return
1349     }
1350     if {![info exists selectedline]} return
1351     set prev {}
1352     foreach l $matchinglines {
1353         if {$l >= $selectedline} break
1354         set prev $l
1355     }
1356     if {$prev != {}} {
1357         findselectline $prev
1358     } else {
1359         bell
1360     }
1361 }
1362
1363 proc findlocchange {name ix op} {
1364     global findloc findtype findtypemenu
1365     if {$findloc == "Pickaxe"} {
1366         set findtype Exact
1367         set state disabled
1368     } else {
1369         set state normal
1370     }
1371     $findtypemenu entryconf 1 -state $state
1372     $findtypemenu entryconf 2 -state $state
1373 }
1374
1375 proc stopfindproc {{done 0}} {
1376     global findprocpid findprocfile findids
1377     global ctext findoldcursor phase maincursor textcursor
1378     global findinprogress
1379
1380     catch {unset findids}
1381     if {[info exists findprocpid]} {
1382         if {!$done} {
1383             catch {exec kill $findprocpid}
1384         }
1385         catch {close $findprocfile}
1386         unset findprocpid
1387     }
1388     if {[info exists findinprogress]} {
1389         unset findinprogress
1390         if {$phase != "incrdraw"} {
1391             . config -cursor $maincursor
1392             settextcursor $textcursor
1393         }
1394     }
1395 }
1396
1397 proc findpatches {} {
1398     global findstring selectedline numcommits
1399     global findprocpid findprocfile
1400     global finddidsel ctext lineid findinprogress
1401     global findinsertpos
1402
1403     if {$numcommits == 0} return
1404
1405     # make a list of all the ids to search, starting at the one
1406     # after the selected line (if any)
1407     if {[info exists selectedline]} {
1408         set l $selectedline
1409     } else {
1410         set l -1
1411     }
1412     set inputids {}
1413     for {set i 0} {$i < $numcommits} {incr i} {
1414         if {[incr l] >= $numcommits} {
1415             set l 0
1416         }
1417         append inputids $lineid($l) "\n"
1418     }
1419
1420     if {[catch {
1421         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1422                          << $inputids] r]
1423     } err]} {
1424         error_popup "Error starting search process: $err"
1425         return
1426     }
1427
1428     set findinsertpos end
1429     set findprocfile $f
1430     set findprocpid [pid $f]
1431     fconfigure $f -blocking 0
1432     fileevent $f readable readfindproc
1433     set finddidsel 0
1434     . config -cursor watch
1435     settextcursor watch
1436     set findinprogress 1
1437 }
1438
1439 proc readfindproc {} {
1440     global findprocfile finddidsel
1441     global idline matchinglines findinsertpos
1442
1443     set n [gets $findprocfile line]
1444     if {$n < 0} {
1445         if {[eof $findprocfile]} {
1446             stopfindproc 1
1447             if {!$finddidsel} {
1448                 bell
1449             }
1450         }
1451         return
1452     }
1453     if {![regexp {^[0-9a-f]{40}} $line id]} {
1454         error_popup "Can't parse git-diff-tree output: $line"
1455         stopfindproc
1456         return
1457     }
1458     if {![info exists idline($id)]} {
1459         puts stderr "spurious id: $id"
1460         return
1461     }
1462     set l $idline($id)
1463     insertmatch $l $id
1464 }
1465
1466 proc insertmatch {l id} {
1467     global matchinglines findinsertpos finddidsel
1468
1469     if {$findinsertpos == "end"} {
1470         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1471             set matchinglines [linsert $matchinglines 0 $l]
1472             set findinsertpos 1
1473         } else {
1474             lappend matchinglines $l
1475         }
1476     } else {
1477         set matchinglines [linsert $matchinglines $findinsertpos $l]
1478         incr findinsertpos
1479     }
1480     markheadline $l $id
1481     if {!$finddidsel} {
1482         findselectline $l
1483         set finddidsel 1
1484     }
1485 }
1486
1487 proc findfiles {} {
1488     global selectedline numcommits lineid ctext
1489     global ffileline finddidsel parents nparents
1490     global findinprogress findstartline findinsertpos
1491     global treediffs fdiffids fdiffsneeded fdiffpos
1492     global findmergefiles
1493
1494     if {$numcommits == 0} return
1495
1496     if {[info exists selectedline]} {
1497         set l [expr {$selectedline + 1}]
1498     } else {
1499         set l 0
1500     }
1501     set ffileline $l
1502     set findstartline $l
1503     set diffsneeded {}
1504     set fdiffsneeded {}
1505     while 1 {
1506         set id $lineid($l)
1507         if {$findmergefiles || $nparents($id) == 1} {
1508             foreach p $parents($id) {
1509                 if {![info exists treediffs([list $id $p])]} {
1510                     append diffsneeded "$id $p\n"
1511                     lappend fdiffsneeded [list $id $p]
1512                 }
1513             }
1514         }
1515         if {[incr l] >= $numcommits} {
1516             set l 0
1517         }
1518         if {$l == $findstartline} break
1519     }
1520
1521     # start off a git-diff-tree process if needed
1522     if {$diffsneeded ne {}} {
1523         if {[catch {
1524             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1525         } err ]} {
1526             error_popup "Error starting search process: $err"
1527             return
1528         }
1529         catch {unset fdiffids}
1530         set fdiffpos 0
1531         fconfigure $df -blocking 0
1532         fileevent $df readable [list readfilediffs $df]
1533     }
1534
1535     set finddidsel 0
1536     set findinsertpos end
1537     set id $lineid($l)
1538     set p [lindex $parents($id) 0]
1539     . config -cursor watch
1540     settextcursor watch
1541     set findinprogress 1
1542     findcont [list $id $p]
1543     update
1544 }
1545
1546 proc readfilediffs {df} {
1547     global findids fdiffids fdiffs
1548
1549     set n [gets $df line]
1550     if {$n < 0} {
1551         if {[eof $df]} {
1552             donefilediff
1553             if {[catch {close $df} err]} {
1554                 stopfindproc
1555                 bell
1556                 error_popup "Error in git-diff-tree: $err"
1557             } elseif {[info exists findids]} {
1558                 set ids $findids
1559                 stopfindproc
1560                 bell
1561                 error_popup "Couldn't find diffs for {$ids}"
1562             }
1563         }
1564         return
1565     }
1566     if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1567         # start of a new string of diffs
1568         donefilediff
1569         set fdiffids [list $id $p]
1570         set fdiffs {}
1571     } elseif {[string match ":*" $line]} {
1572         lappend fdiffs [lindex $line 5]
1573     }
1574 }
1575
1576 proc donefilediff {} {
1577     global fdiffids fdiffs treediffs findids
1578     global fdiffsneeded fdiffpos
1579
1580     if {[info exists fdiffids]} {
1581         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1582                && $fdiffpos < [llength $fdiffsneeded]} {
1583             # git-diff-tree doesn't output anything for a commit
1584             # which doesn't change anything
1585             set nullids [lindex $fdiffsneeded $fdiffpos]
1586             set treediffs($nullids) {}
1587             if {[info exists findids] && $nullids eq $findids} {
1588                 unset findids
1589                 findcont $nullids
1590             }
1591             incr fdiffpos
1592         }
1593         incr fdiffpos
1594
1595         if {![info exists treediffs($fdiffids)]} {
1596             set treediffs($fdiffids) $fdiffs
1597         }
1598         if {[info exists findids] && $fdiffids eq $findids} {
1599             unset findids
1600             findcont $fdiffids
1601         }
1602     }
1603 }
1604
1605 proc findcont {ids} {
1606     global findids treediffs parents nparents
1607     global ffileline findstartline finddidsel
1608     global lineid numcommits matchinglines findinprogress
1609     global findmergefiles
1610
1611     set id [lindex $ids 0]
1612     set p [lindex $ids 1]
1613     set pi [lsearch -exact $parents($id) $p]
1614     set l $ffileline
1615     while 1 {
1616         if {$findmergefiles || $nparents($id) == 1} {
1617             if {![info exists treediffs($ids)]} {
1618                 set findids $ids
1619                 set ffileline $l
1620                 return
1621             }
1622             set doesmatch 0
1623             foreach f $treediffs($ids) {
1624                 set x [findmatches $f]
1625                 if {$x != {}} {
1626                     set doesmatch 1
1627                     break
1628                 }
1629             }
1630             if {$doesmatch} {
1631                 insertmatch $l $id
1632                 set pi $nparents($id)
1633             }
1634         } else {
1635             set pi $nparents($id)
1636         }
1637         if {[incr pi] >= $nparents($id)} {
1638             set pi 0
1639             if {[incr l] >= $numcommits} {
1640                 set l 0
1641             }
1642             if {$l == $findstartline} break
1643             set id $lineid($l)
1644         }
1645         set p [lindex $parents($id) $pi]
1646         set ids [list $id $p]
1647     }
1648     stopfindproc
1649     if {!$finddidsel} {
1650         bell
1651     }
1652 }
1653
1654 # mark a commit as matching by putting a yellow background
1655 # behind the headline
1656 proc markheadline {l id} {
1657     global canv mainfont linehtag commitinfo
1658
1659     set bbox [$canv bbox $linehtag($l)]
1660     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1661     $canv lower $t
1662 }
1663
1664 # mark the bits of a headline, author or date that match a find string
1665 proc markmatches {canv l str tag matches font} {
1666     set bbox [$canv bbox $tag]
1667     set x0 [lindex $bbox 0]
1668     set y0 [lindex $bbox 1]
1669     set y1 [lindex $bbox 3]
1670     foreach match $matches {
1671         set start [lindex $match 0]
1672         set end [lindex $match 1]
1673         if {$start > $end} continue
1674         set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1675         set xlen [font measure $font [string range $str 0 [expr $end]]]
1676         set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1677                    -outline {} -tags matches -fill yellow]
1678         $canv lower $t
1679     }
1680 }
1681
1682 proc unmarkmatches {} {
1683     global matchinglines findids
1684     allcanvs delete matches
1685     catch {unset matchinglines}
1686     catch {unset findids}
1687 }
1688
1689 proc selcanvline {w x y} {
1690     global canv canvy0 ctext linespc
1691     global lineid linehtag linentag linedtag rowtextx
1692     set ymax [lindex [$canv cget -scrollregion] 3]
1693     if {$ymax == {}} return
1694     set yfrac [lindex [$canv yview] 0]
1695     set y [expr {$y + $yfrac * $ymax}]
1696     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1697     if {$l < 0} {
1698         set l 0
1699     }
1700     if {$w eq $canv} {
1701         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1702     }
1703     unmarkmatches
1704     selectline $l 1
1705 }
1706
1707 proc commit_descriptor {p} {
1708     global commitinfo
1709     set l "..."
1710     if {[info exists commitinfo($p)]} {
1711         set l [lindex $commitinfo($p) 0]
1712     }
1713     return "$p ($l)"
1714 }
1715
1716 proc selectline {l isnew} {
1717     global canv canv2 canv3 ctext commitinfo selectedline
1718     global lineid linehtag linentag linedtag
1719     global canvy0 linespc parents nparents children nchildren
1720     global cflist currentid sha1entry
1721     global commentend idtags idline
1722
1723     $canv delete hover
1724     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1725     $canv delete secsel
1726     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1727                -tags secsel -fill [$canv cget -selectbackground]]
1728     $canv lower $t
1729     $canv2 delete secsel
1730     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1731                -tags secsel -fill [$canv2 cget -selectbackground]]
1732     $canv2 lower $t
1733     $canv3 delete secsel
1734     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1735                -tags secsel -fill [$canv3 cget -selectbackground]]
1736     $canv3 lower $t
1737     set y [expr {$canvy0 + $l * $linespc}]
1738     set ymax [lindex [$canv cget -scrollregion] 3]
1739     set ytop [expr {$y - $linespc - 1}]
1740     set ybot [expr {$y + $linespc + 1}]
1741     set wnow [$canv yview]
1742     set wtop [expr [lindex $wnow 0] * $ymax]
1743     set wbot [expr [lindex $wnow 1] * $ymax]
1744     set wh [expr {$wbot - $wtop}]
1745     set newtop $wtop
1746     if {$ytop < $wtop} {
1747         if {$ybot < $wtop} {
1748             set newtop [expr {$y - $wh / 2.0}]
1749         } else {
1750             set newtop $ytop
1751             if {$newtop > $wtop - $linespc} {
1752                 set newtop [expr {$wtop - $linespc}]
1753             }
1754         }
1755     } elseif {$ybot > $wbot} {
1756         if {$ytop > $wbot} {
1757             set newtop [expr {$y - $wh / 2.0}]
1758         } else {
1759             set newtop [expr {$ybot - $wh}]
1760             if {$newtop < $wtop + $linespc} {
1761                 set newtop [expr {$wtop + $linespc}]
1762             }
1763         }
1764     }
1765     if {$newtop != $wtop} {
1766         if {$newtop < 0} {
1767             set newtop 0
1768         }
1769         allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1770     }
1771
1772     if {$isnew} {
1773         addtohistory [list selectline $l 0]
1774     }
1775
1776     set selectedline $l
1777
1778     set id $lineid($l)
1779     set currentid $id
1780     $sha1entry delete 0 end
1781     $sha1entry insert 0 $id
1782     $sha1entry selection from 0
1783     $sha1entry selection to end
1784
1785     $ctext conf -state normal
1786     $ctext delete 0.0 end
1787     $ctext mark set fmark.0 0.0
1788     $ctext mark gravity fmark.0 left
1789     set info $commitinfo($id)
1790     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
1791     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
1792     if {[info exists idtags($id)]} {
1793         $ctext insert end "Tags:"
1794         foreach tag $idtags($id) {
1795             $ctext insert end " $tag"
1796         }
1797         $ctext insert end "\n"
1798     }
1799
1800     set commentstart [$ctext index "end - 1c"]
1801     set comment {}
1802     if {[info exists parents($id)]} {
1803         foreach p $parents($id) {
1804             append comment "Parent: [commit_descriptor $p]\n"
1805         }
1806     }
1807     if {[info exists children($id)]} {
1808         foreach c $children($id) {
1809             append comment "Child:  [commit_descriptor $c]\n"
1810         }
1811     }
1812     append comment "\n"
1813     append comment [lindex $info 5]
1814     $ctext insert end $comment
1815     $ctext insert end "\n"
1816
1817     # make anything that looks like a SHA1 ID be a clickable link
1818     set links [regexp -indices -all -inline {[0-9a-f]{40}} $comment]
1819     set i 0
1820     foreach l $links {
1821         set s [lindex $l 0]
1822         set e [lindex $l 1]
1823         set linkid [string range $comment $s $e]
1824         if {![info exists idline($linkid)]} continue
1825         incr e
1826         $ctext tag add link "$commentstart + $s c" "$commentstart + $e c"
1827         $ctext tag add link$i "$commentstart + $s c" "$commentstart + $e c"
1828         $ctext tag bind link$i <1> [list selectline $idline($linkid) 1]
1829         incr i
1830     }
1831     $ctext tag conf link -foreground blue -underline 1
1832     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
1833     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
1834
1835     $ctext tag delete Comments
1836     $ctext tag remove found 1.0 end
1837     $ctext conf -state disabled
1838     set commentend [$ctext index "end - 1c"]
1839
1840     $cflist delete 0 end
1841     $cflist insert end "Comments"
1842     if {$nparents($id) == 1} {
1843         startdiff [concat $id $parents($id)]
1844     } elseif {$nparents($id) > 1} {
1845         mergediff $id
1846     }
1847 }
1848
1849 proc selnextline {dir} {
1850     global selectedline
1851     if {![info exists selectedline]} return
1852     set l [expr $selectedline + $dir]
1853     unmarkmatches
1854     selectline $l 1
1855 }
1856
1857 proc unselectline {} {
1858     global selectedline
1859
1860     catch {unset selectedline}
1861     allcanvs delete secsel
1862 }
1863
1864 proc addtohistory {cmd} {
1865     global history historyindex
1866
1867     if {$historyindex > 0
1868         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
1869         return
1870     }
1871
1872     if {$historyindex < [llength $history]} {
1873         set history [lreplace $history $historyindex end $cmd]
1874     } else {
1875         lappend history $cmd
1876     }
1877     incr historyindex
1878     if {$historyindex > 1} {
1879         .ctop.top.bar.leftbut conf -state normal
1880     } else {
1881         .ctop.top.bar.leftbut conf -state disabled
1882     }
1883     .ctop.top.bar.rightbut conf -state disabled
1884 }
1885
1886 proc goback {} {
1887     global history historyindex
1888
1889     if {$historyindex > 1} {
1890         incr historyindex -1
1891         set cmd [lindex $history [expr {$historyindex - 1}]]
1892         eval $cmd
1893         .ctop.top.bar.rightbut conf -state normal
1894     }
1895     if {$historyindex <= 1} {
1896         .ctop.top.bar.leftbut conf -state disabled
1897     }
1898 }
1899
1900 proc goforw {} {
1901     global history historyindex
1902
1903     if {$historyindex < [llength $history]} {
1904         set cmd [lindex $history $historyindex]
1905         incr historyindex
1906         eval $cmd
1907         .ctop.top.bar.leftbut conf -state normal
1908     }
1909     if {$historyindex >= [llength $history]} {
1910         .ctop.top.bar.rightbut conf -state disabled
1911     }
1912 }
1913
1914 proc mergediff {id} {
1915     global parents diffmergeid diffmergegca mergefilelist diffpindex
1916
1917     set diffmergeid $id
1918     set diffpindex -1
1919     set diffmergegca [findgca $parents($id)]
1920     if {[info exists mergefilelist($id)]} {
1921         if {$mergefilelist($id) ne {}} {
1922             showmergediff
1923         }
1924     } else {
1925         contmergediff {}
1926     }
1927 }
1928
1929 proc findgca {ids} {
1930     set gca {}
1931     foreach id $ids {
1932         if {$gca eq {}} {
1933             set gca $id
1934         } else {
1935             if {[catch {
1936                 set gca [exec git-merge-base $gca $id]
1937             } err]} {
1938                 return {}
1939             }
1940         }
1941     }
1942     return $gca
1943 }
1944
1945 proc contmergediff {ids} {
1946     global diffmergeid diffpindex parents nparents diffmergegca
1947     global treediffs mergefilelist diffids treepending
1948
1949     # diff the child against each of the parents, and diff
1950     # each of the parents against the GCA.
1951     while 1 {
1952         if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
1953             set ids [list [lindex $ids 1] $diffmergegca]
1954         } else {
1955             if {[incr diffpindex] >= $nparents($diffmergeid)} break
1956             set p [lindex $parents($diffmergeid) $diffpindex]
1957             set ids [list $diffmergeid $p]
1958         }
1959         if {![info exists treediffs($ids)]} {
1960             set diffids $ids
1961             if {![info exists treepending]} {
1962                 gettreediffs $ids
1963             }
1964             return
1965         }
1966     }
1967
1968     # If a file in some parent is different from the child and also
1969     # different from the GCA, then it's interesting.
1970     # If we don't have a GCA, then a file is interesting if it is
1971     # different from the child in all the parents.
1972     if {$diffmergegca ne {}} {
1973         set files {}
1974         foreach p $parents($diffmergeid) {
1975             set gcadiffs $treediffs([list $p $diffmergegca])
1976             foreach f $treediffs([list $diffmergeid $p]) {
1977                 if {[lsearch -exact $files $f] < 0
1978                     && [lsearch -exact $gcadiffs $f] >= 0} {
1979                     lappend files $f
1980                 }
1981             }
1982         }
1983         set files [lsort $files]
1984     } else {
1985         set p [lindex $parents($diffmergeid) 0]
1986         set files $treediffs([list $diffmergeid $p])
1987         for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
1988             set p [lindex $parents($diffmergeid) $i]
1989             set df $treediffs([list $diffmergeid $p])
1990             set nf {}
1991             foreach f $files {
1992                 if {[lsearch -exact $df $f] >= 0} {
1993                     lappend nf $f
1994                 }
1995             }
1996             set files $nf
1997         }
1998     }
1999
2000     set mergefilelist($diffmergeid) $files
2001     if {$files ne {}} {
2002         showmergediff
2003     }
2004 }
2005
2006 proc showmergediff {} {
2007     global cflist diffmergeid mergefilelist parents
2008     global diffopts diffinhunk currentfile currenthunk filelines
2009     global diffblocked groupfilelast mergefds groupfilenum grouphunks
2010
2011     set files $mergefilelist($diffmergeid)
2012     foreach f $files {
2013         $cflist insert end $f
2014     }
2015     set env(GIT_DIFF_OPTS) $diffopts
2016     set flist {}
2017     catch {unset currentfile}
2018     catch {unset currenthunk}
2019     catch {unset filelines}
2020     catch {unset groupfilenum}
2021     catch {unset grouphunks}
2022     set groupfilelast -1
2023     foreach p $parents($diffmergeid) {
2024         set cmd [list | git-diff-tree -p $p $diffmergeid]
2025         set cmd [concat $cmd $mergefilelist($diffmergeid)]
2026         if {[catch {set f [open $cmd r]} err]} {
2027             error_popup "Error getting diffs: $err"
2028             foreach f $flist {
2029                 catch {close $f}
2030             }
2031             return
2032         }
2033         lappend flist $f
2034         set ids [list $diffmergeid $p]
2035         set mergefds($ids) $f
2036         set diffinhunk($ids) 0
2037         set diffblocked($ids) 0
2038         fconfigure $f -blocking 0
2039         fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2040     }
2041 }
2042
2043 proc getmergediffline {f ids id} {
2044     global diffmergeid diffinhunk diffoldlines diffnewlines
2045     global currentfile currenthunk
2046     global diffoldstart diffnewstart diffoldlno diffnewlno
2047     global diffblocked mergefilelist
2048     global noldlines nnewlines difflcounts filelines
2049
2050     set n [gets $f line]
2051     if {$n < 0} {
2052         if {![eof $f]} return
2053     }
2054
2055     if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2056         if {$n < 0} {
2057             close $f
2058         }
2059         return
2060     }
2061
2062     if {$diffinhunk($ids) != 0} {
2063         set fi $currentfile($ids)
2064         if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2065             # continuing an existing hunk
2066             set line [string range $line 1 end]
2067             set p [lindex $ids 1]
2068             if {$match eq "-" || $match eq " "} {
2069                 set filelines($p,$fi,$diffoldlno($ids)) $line
2070                 incr diffoldlno($ids)
2071             }
2072             if {$match eq "+" || $match eq " "} {
2073                 set filelines($id,$fi,$diffnewlno($ids)) $line
2074                 incr diffnewlno($ids)
2075             }
2076             if {$match eq " "} {
2077                 if {$diffinhunk($ids) == 2} {
2078                     lappend difflcounts($ids) \
2079                         [list $noldlines($ids) $nnewlines($ids)]
2080                     set noldlines($ids) 0
2081                     set diffinhunk($ids) 1
2082                 }
2083                 incr noldlines($ids)
2084             } elseif {$match eq "-" || $match eq "+"} {
2085                 if {$diffinhunk($ids) == 1} {
2086                     lappend difflcounts($ids) [list $noldlines($ids)]
2087                     set noldlines($ids) 0
2088                     set nnewlines($ids) 0
2089                     set diffinhunk($ids) 2
2090                 }
2091                 if {$match eq "-"} {
2092                     incr noldlines($ids)
2093                 } else {
2094                     incr nnewlines($ids)
2095                 }
2096             }
2097             # and if it's \ No newline at end of line, then what?
2098             return
2099         }
2100         # end of a hunk
2101         if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2102             lappend difflcounts($ids) [list $noldlines($ids)]
2103         } elseif {$diffinhunk($ids) == 2
2104                   && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2105             lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2106         }
2107         set currenthunk($ids) [list $currentfile($ids) \
2108                                    $diffoldstart($ids) $diffnewstart($ids) \
2109                                    $diffoldlno($ids) $diffnewlno($ids) \
2110                                    $difflcounts($ids)]
2111         set diffinhunk($ids) 0
2112         # -1 = need to block, 0 = unblocked, 1 = is blocked
2113         set diffblocked($ids) -1
2114         processhunks
2115         if {$diffblocked($ids) == -1} {
2116             fileevent $f readable {}
2117             set diffblocked($ids) 1
2118         }
2119     }
2120
2121     if {$n < 0} {
2122         # eof
2123         if {!$diffblocked($ids)} {
2124             close $f
2125             set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2126             set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2127             processhunks
2128         }
2129     } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2130         # start of a new file
2131         set currentfile($ids) \
2132             [lsearch -exact $mergefilelist($diffmergeid) $fname]
2133     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2134                    $line match f1l f1c f2l f2c rest]} {
2135         if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2136             # start of a new hunk
2137             if {$f1l == 0 && $f1c == 0} {
2138                 set f1l 1
2139             }
2140             if {$f2l == 0 && $f2c == 0} {
2141                 set f2l 1
2142             }
2143             set diffinhunk($ids) 1
2144             set diffoldstart($ids) $f1l
2145             set diffnewstart($ids) $f2l
2146             set diffoldlno($ids) $f1l
2147             set diffnewlno($ids) $f2l
2148             set difflcounts($ids) {}
2149             set noldlines($ids) 0
2150             set nnewlines($ids) 0
2151         }
2152     }
2153 }
2154
2155 proc processhunks {} {
2156     global diffmergeid parents nparents currenthunk
2157     global mergefilelist diffblocked mergefds
2158     global grouphunks grouplinestart grouplineend groupfilenum
2159
2160     set nfiles [llength $mergefilelist($diffmergeid)]
2161     while 1 {
2162         set fi $nfiles
2163         set lno 0
2164         # look for the earliest hunk
2165         foreach p $parents($diffmergeid) {
2166             set ids [list $diffmergeid $p]
2167             if {![info exists currenthunk($ids)]} return
2168             set i [lindex $currenthunk($ids) 0]
2169             set l [lindex $currenthunk($ids) 2]
2170             if {$i < $fi || ($i == $fi && $l < $lno)} {
2171                 set fi $i
2172                 set lno $l
2173                 set pi $p
2174             }
2175         }
2176
2177         if {$fi < $nfiles} {
2178             set ids [list $diffmergeid $pi]
2179             set hunk $currenthunk($ids)
2180             unset currenthunk($ids)
2181             if {$diffblocked($ids) > 0} {
2182                 fileevent $mergefds($ids) readable \
2183                     [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2184             }
2185             set diffblocked($ids) 0
2186
2187             if {[info exists groupfilenum] && $groupfilenum == $fi
2188                 && $lno <= $grouplineend} {
2189                 # add this hunk to the pending group
2190                 lappend grouphunks($pi) $hunk
2191                 set endln [lindex $hunk 4]
2192                 if {$endln > $grouplineend} {
2193                     set grouplineend $endln
2194                 }
2195                 continue
2196             }
2197         }
2198
2199         # succeeding stuff doesn't belong in this group, so
2200         # process the group now
2201         if {[info exists groupfilenum]} {
2202             processgroup
2203             unset groupfilenum
2204             unset grouphunks
2205         }
2206
2207         if {$fi >= $nfiles} break
2208
2209         # start a new group
2210         set groupfilenum $fi
2211         set grouphunks($pi) [list $hunk]
2212         set grouplinestart $lno
2213         set grouplineend [lindex $hunk 4]
2214     }
2215 }
2216
2217 proc processgroup {} {
2218     global groupfilelast groupfilenum difffilestart
2219     global mergefilelist diffmergeid ctext filelines
2220     global parents diffmergeid diffoffset
2221     global grouphunks grouplinestart grouplineend nparents
2222     global mergemax
2223
2224     $ctext conf -state normal
2225     set id $diffmergeid
2226     set f $groupfilenum
2227     if {$groupfilelast != $f} {
2228         $ctext insert end "\n"
2229         set here [$ctext index "end - 1c"]
2230         set difffilestart($f) $here
2231         set mark fmark.[expr {$f + 1}]
2232         $ctext mark set $mark $here
2233         $ctext mark gravity $mark left
2234         set header [lindex $mergefilelist($id) $f]
2235         set l [expr {(78 - [string length $header]) / 2}]
2236         set pad [string range "----------------------------------------" 1 $l]
2237         $ctext insert end "$pad $header $pad\n" filesep
2238         set groupfilelast $f
2239         foreach p $parents($id) {
2240             set diffoffset($p) 0
2241         }
2242     }
2243
2244     $ctext insert end "@@" msep
2245     set nlines [expr {$grouplineend - $grouplinestart}]
2246     set events {}
2247     set pnum 0
2248     foreach p $parents($id) {
2249         set startline [expr {$grouplinestart + $diffoffset($p)}]
2250         set ol $startline
2251         set nl $grouplinestart
2252         if {[info exists grouphunks($p)]} {
2253             foreach h $grouphunks($p) {
2254                 set l [lindex $h 2]
2255                 if {$nl < $l} {
2256                     for {} {$nl < $l} {incr nl} {
2257                         set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2258                         incr ol
2259                     }
2260                 }
2261                 foreach chunk [lindex $h 5] {
2262                     if {[llength $chunk] == 2} {
2263                         set olc [lindex $chunk 0]
2264                         set nlc [lindex $chunk 1]
2265                         set nnl [expr {$nl + $nlc}]
2266                         lappend events [list $nl $nnl $pnum $olc $nlc]
2267                         incr ol $olc
2268                         set nl $nnl
2269                     } else {
2270                         incr ol [lindex $chunk 0]
2271                         incr nl [lindex $chunk 0]
2272                     }
2273                 }
2274             }
2275         }
2276         if {$nl < $grouplineend} {
2277             for {} {$nl < $grouplineend} {incr nl} {
2278                 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2279                 incr ol
2280             }
2281         }
2282         set nlines [expr {$ol - $startline}]
2283         $ctext insert end " -$startline,$nlines" msep
2284         incr pnum
2285     }
2286
2287     set nlines [expr {$grouplineend - $grouplinestart}]
2288     $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2289
2290     set events [lsort -integer -index 0 $events]
2291     set nevents [llength $events]
2292     set nmerge $nparents($diffmergeid)
2293     set l $grouplinestart
2294     for {set i 0} {$i < $nevents} {set i $j} {
2295         set nl [lindex $events $i 0]
2296         while {$l < $nl} {
2297             $ctext insert end " $filelines($id,$f,$l)\n"
2298             incr l
2299         }
2300         set e [lindex $events $i]
2301         set enl [lindex $e 1]
2302         set j $i
2303         set active {}
2304         while 1 {
2305             set pnum [lindex $e 2]
2306             set olc [lindex $e 3]
2307             set nlc [lindex $e 4]
2308             if {![info exists delta($pnum)]} {
2309                 set delta($pnum) [expr {$olc - $nlc}]
2310                 lappend active $pnum
2311             } else {
2312                 incr delta($pnum) [expr {$olc - $nlc}]
2313             }
2314             if {[incr j] >= $nevents} break
2315             set e [lindex $events $j]
2316             if {[lindex $e 0] >= $enl} break
2317             if {[lindex $e 1] > $enl} {
2318                 set enl [lindex $e 1]
2319             }
2320         }
2321         set nlc [expr {$enl - $l}]
2322         set ncol mresult
2323         set bestpn -1
2324         if {[llength $active] == $nmerge - 1} {
2325             # no diff for one of the parents, i.e. it's identical
2326             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2327                 if {![info exists delta($pnum)]} {
2328                     if {$pnum < $mergemax} {
2329                         lappend ncol m$pnum
2330                     } else {
2331                         lappend ncol mmax
2332                     }
2333                     break
2334                 }
2335             }
2336         } elseif {[llength $active] == $nmerge} {
2337             # all parents are different, see if one is very similar
2338             set bestsim 30
2339             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2340                 set sim [similarity $pnum $l $nlc $f \
2341                              [lrange $events $i [expr {$j-1}]]]
2342                 if {$sim > $bestsim} {
2343                     set bestsim $sim
2344                     set bestpn $pnum
2345                 }
2346             }
2347             if {$bestpn >= 0} {
2348                 lappend ncol m$bestpn
2349             }
2350         }
2351         set pnum -1
2352         foreach p $parents($id) {
2353             incr pnum
2354             if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2355             set olc [expr {$nlc + $delta($pnum)}]
2356             set ol [expr {$l + $diffoffset($p)}]
2357             incr diffoffset($p) $delta($pnum)
2358             unset delta($pnum)
2359             for {} {$olc > 0} {incr olc -1} {
2360                 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2361                 incr ol
2362             }
2363         }
2364         set endl [expr {$l + $nlc}]
2365         if {$bestpn >= 0} {
2366             # show this pretty much as a normal diff
2367             set p [lindex $parents($id) $bestpn]
2368             set ol [expr {$l + $diffoffset($p)}]
2369             incr diffoffset($p) $delta($bestpn)
2370             unset delta($bestpn)
2371             for {set k $i} {$k < $j} {incr k} {
2372                 set e [lindex $events $k]
2373                 if {[lindex $e 2] != $bestpn} continue
2374                 set nl [lindex $e 0]
2375                 set ol [expr {$ol + $nl - $l}]
2376                 for {} {$l < $nl} {incr l} {
2377                     $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2378                 }
2379                 set c [lindex $e 3]
2380                 for {} {$c > 0} {incr c -1} {
2381                     $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2382                     incr ol
2383                 }
2384                 set nl [lindex $e 1]
2385                 for {} {$l < $nl} {incr l} {
2386                     $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2387                 }
2388             }
2389         }
2390         for {} {$l < $endl} {incr l} {
2391             $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2392         }
2393     }
2394     while {$l < $grouplineend} {
2395         $ctext insert end " $filelines($id,$f,$l)\n"
2396         incr l
2397     }
2398     $ctext conf -state disabled
2399 }
2400
2401 proc similarity {pnum l nlc f events} {
2402     global diffmergeid parents diffoffset filelines
2403
2404     set id $diffmergeid
2405     set p [lindex $parents($id) $pnum]
2406     set ol [expr {$l + $diffoffset($p)}]
2407     set endl [expr {$l + $nlc}]
2408     set same 0
2409     set diff 0
2410     foreach e $events {
2411         if {[lindex $e 2] != $pnum} continue
2412         set nl [lindex $e 0]
2413         set ol [expr {$ol + $nl - $l}]
2414         for {} {$l < $nl} {incr l} {
2415             incr same [string length $filelines($id,$f,$l)]
2416             incr same
2417         }
2418         set oc [lindex $e 3]
2419         for {} {$oc > 0} {incr oc -1} {
2420             incr diff [string length $filelines($p,$f,$ol)]
2421             incr diff
2422             incr ol
2423         }
2424         set nl [lindex $e 1]
2425         for {} {$l < $nl} {incr l} {
2426             incr diff [string length $filelines($id,$f,$l)]
2427             incr diff
2428         }
2429     }
2430     for {} {$l < $endl} {incr l} {
2431         incr same [string length $filelines($id,$f,$l)]
2432         incr same
2433     }
2434     if {$same == 0} {
2435         return 0
2436     }
2437     return [expr {200 * $same / (2 * $same + $diff)}]
2438 }
2439
2440 proc startdiff {ids} {
2441     global treediffs diffids treepending diffmergeid
2442
2443     set diffids $ids
2444     catch {unset diffmergeid}
2445     if {![info exists treediffs($ids)]} {
2446         if {![info exists treepending]} {
2447             gettreediffs $ids
2448         }
2449     } else {
2450         addtocflist $ids
2451     }
2452 }
2453
2454 proc addtocflist {ids} {
2455     global treediffs cflist
2456     foreach f $treediffs($ids) {
2457         $cflist insert end $f
2458     }
2459     getblobdiffs $ids
2460 }
2461
2462 proc gettreediffs {ids} {
2463     global treediff parents treepending
2464     set treepending $ids
2465     set treediff {}
2466     set id [lindex $ids 0]
2467     set p [lindex $ids 1]
2468     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
2469     fconfigure $gdtf -blocking 0
2470     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2471 }
2472
2473 proc gettreediffline {gdtf ids} {
2474     global treediff treediffs treepending diffids diffmergeid
2475
2476     set n [gets $gdtf line]
2477     if {$n < 0} {
2478         if {![eof $gdtf]} return
2479         close $gdtf
2480         set treediffs($ids) $treediff
2481         unset treepending
2482         if {$ids != $diffids} {
2483             gettreediffs $diffids
2484         } else {
2485             if {[info exists diffmergeid]} {
2486                 contmergediff $ids
2487             } else {
2488                 addtocflist $ids
2489             }
2490         }
2491         return
2492     }
2493     set file [lindex $line 5]
2494     lappend treediff $file
2495 }
2496
2497 proc getblobdiffs {ids} {
2498     global diffopts blobdifffd diffids env curdifftag curtagstart
2499     global difffilestart nextupdate diffinhdr treediffs
2500
2501     set id [lindex $ids 0]
2502     set p [lindex $ids 1]
2503     set env(GIT_DIFF_OPTS) $diffopts
2504     set cmd [list | git-diff-tree -r -p -C $p $id]
2505     if {[catch {set bdf [open $cmd r]} err]} {
2506         puts "error getting diffs: $err"
2507         return
2508     }
2509     set diffinhdr 0
2510     fconfigure $bdf -blocking 0
2511     set blobdifffd($ids) $bdf
2512     set curdifftag Comments
2513     set curtagstart 0.0
2514     catch {unset difffilestart}
2515     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2516     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2517 }
2518
2519 proc getblobdiffline {bdf ids} {
2520     global diffids blobdifffd ctext curdifftag curtagstart
2521     global diffnexthead diffnextnote difffilestart
2522     global nextupdate diffinhdr treediffs
2523     global gaudydiff
2524
2525     set n [gets $bdf line]
2526     if {$n < 0} {
2527         if {[eof $bdf]} {
2528             close $bdf
2529             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2530                 $ctext tag add $curdifftag $curtagstart end
2531             }
2532         }
2533         return
2534     }
2535     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2536         return
2537     }
2538     $ctext conf -state normal
2539     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2540         # start of a new file
2541         $ctext insert end "\n"
2542         $ctext tag add $curdifftag $curtagstart end
2543         set curtagstart [$ctext index "end - 1c"]
2544         set header $newname
2545         set here [$ctext index "end - 1c"]
2546         set i [lsearch -exact $treediffs($diffids) $fname]
2547         if {$i >= 0} {
2548             set difffilestart($i) $here
2549             incr i
2550             $ctext mark set fmark.$i $here
2551             $ctext mark gravity fmark.$i left
2552         }
2553         if {$newname != $fname} {
2554             set i [lsearch -exact $treediffs($diffids) $newname]
2555             if {$i >= 0} {
2556                 set difffilestart($i) $here
2557                 incr i
2558                 $ctext mark set fmark.$i $here
2559                 $ctext mark gravity fmark.$i left
2560             }
2561         }
2562         set curdifftag "f:$fname"
2563         $ctext tag delete $curdifftag
2564         set l [expr {(78 - [string length $header]) / 2}]
2565         set pad [string range "----------------------------------------" 1 $l]
2566         $ctext insert end "$pad $header $pad\n" filesep
2567         set diffinhdr 1
2568     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2569         set diffinhdr 0
2570     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2571                    $line match f1l f1c f2l f2c rest]} {
2572         if {$gaudydiff} {
2573             $ctext insert end "\t" hunksep
2574             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
2575             $ctext insert end "    $rest \n" hunksep
2576         } else {
2577             $ctext insert end "$line\n" hunksep
2578         }
2579         set diffinhdr 0
2580     } else {
2581         set x [string range $line 0 0]
2582         if {$x == "-" || $x == "+"} {
2583             set tag [expr {$x == "+"}]
2584             if {$gaudydiff} {
2585                 set line [string range $line 1 end]
2586             }
2587             $ctext insert end "$line\n" d$tag
2588         } elseif {$x == " "} {
2589             if {$gaudydiff} {
2590                 set line [string range $line 1 end]
2591             }
2592             $ctext insert end "$line\n"
2593         } elseif {$diffinhdr || $x == "\\"} {
2594             # e.g. "\ No newline at end of file"
2595             $ctext insert end "$line\n" filesep
2596         } else {
2597             # Something else we don't recognize
2598             if {$curdifftag != "Comments"} {
2599                 $ctext insert end "\n"
2600                 $ctext tag add $curdifftag $curtagstart end
2601                 set curtagstart [$ctext index "end - 1c"]
2602                 set curdifftag Comments
2603             }
2604             $ctext insert end "$line\n" filesep
2605         }
2606     }
2607     $ctext conf -state disabled
2608     if {[clock clicks -milliseconds] >= $nextupdate} {
2609         incr nextupdate 100
2610         fileevent $bdf readable {}
2611         update
2612         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2613     }
2614 }
2615
2616 proc nextfile {} {
2617     global difffilestart ctext
2618     set here [$ctext index @0,0]
2619     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2620         if {[$ctext compare $difffilestart($i) > $here]} {
2621             if {![info exists pos]
2622                 || [$ctext compare $difffilestart($i) < $pos]} {
2623                 set pos $difffilestart($i)
2624             }
2625         }
2626     }
2627     if {[info exists pos]} {
2628         $ctext yview $pos
2629     }
2630 }
2631
2632 proc listboxsel {} {
2633     global ctext cflist currentid
2634     if {![info exists currentid]} return
2635     set sel [lsort [$cflist curselection]]
2636     if {$sel eq {}} return
2637     set first [lindex $sel 0]
2638     catch {$ctext yview fmark.$first}
2639 }
2640
2641 proc setcoords {} {
2642     global linespc charspc canvx0 canvy0 mainfont
2643     global xspc1 xspc2
2644
2645     set linespc [font metrics $mainfont -linespace]
2646     set charspc [font measure $mainfont "m"]
2647     set canvy0 [expr 3 + 0.5 * $linespc]
2648     set canvx0 [expr 3 + 0.5 * $linespc]
2649     set xspc1(0) $linespc
2650     set xspc2 $linespc
2651 }
2652
2653 proc redisplay {} {
2654     global stopped redisplaying phase
2655     if {$stopped > 1} return
2656     if {$phase == "getcommits"} return
2657     set redisplaying 1
2658     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2659         set stopped 1
2660     } else {
2661         drawgraph
2662     }
2663 }
2664
2665 proc incrfont {inc} {
2666     global mainfont namefont textfont ctext canv phase
2667     global stopped entries
2668     unmarkmatches
2669     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2670     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2671     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2672     setcoords
2673     $ctext conf -font $textfont
2674     $ctext tag conf filesep -font [concat $textfont bold]
2675     foreach e $entries {
2676         $e conf -font $mainfont
2677     }
2678     if {$phase == "getcommits"} {
2679         $canv itemconf textitems -font $mainfont
2680     }
2681     redisplay
2682 }
2683
2684 proc clearsha1 {} {
2685     global sha1entry sha1string
2686     if {[string length $sha1string] == 40} {
2687         $sha1entry delete 0 end
2688     }
2689 }
2690
2691 proc sha1change {n1 n2 op} {
2692     global sha1string currentid sha1but
2693     if {$sha1string == {}
2694         || ([info exists currentid] && $sha1string == $currentid)} {
2695         set state disabled
2696     } else {
2697         set state normal
2698     }
2699     if {[$sha1but cget -state] == $state} return
2700     if {$state == "normal"} {
2701         $sha1but conf -state normal -relief raised -text "Goto: "
2702     } else {
2703         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2704     }
2705 }
2706
2707 proc gotocommit {} {
2708     global sha1string currentid idline tagids
2709     global lineid numcommits
2710
2711     if {$sha1string == {}
2712         || ([info exists currentid] && $sha1string == $currentid)} return
2713     if {[info exists tagids($sha1string)]} {
2714         set id $tagids($sha1string)
2715     } else {
2716         set id [string tolower $sha1string]
2717         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2718             set matches {}
2719             for {set l 0} {$l < $numcommits} {incr l} {
2720                 if {[string match $id* $lineid($l)]} {
2721                     lappend matches $lineid($l)
2722                 }
2723             }
2724             if {$matches ne {}} {
2725                 if {[llength $matches] > 1} {
2726                     error_popup "Short SHA1 id $id is ambiguous"
2727                     return
2728                 }
2729                 set id [lindex $matches 0]
2730             }
2731         }
2732     }
2733     if {[info exists idline($id)]} {
2734         selectline $idline($id) 1
2735         return
2736     }
2737     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2738         set type "SHA1 id"
2739     } else {
2740         set type "Tag"
2741     }
2742     error_popup "$type $sha1string is not known"
2743 }
2744
2745 proc lineenter {x y id} {
2746     global hoverx hovery hoverid hovertimer
2747     global commitinfo canv
2748
2749     if {![info exists commitinfo($id)]} return
2750     set hoverx $x
2751     set hovery $y
2752     set hoverid $id
2753     if {[info exists hovertimer]} {
2754         after cancel $hovertimer
2755     }
2756     set hovertimer [after 500 linehover]
2757     $canv delete hover
2758 }
2759
2760 proc linemotion {x y id} {
2761     global hoverx hovery hoverid hovertimer
2762
2763     if {[info exists hoverid] && $id == $hoverid} {
2764         set hoverx $x
2765         set hovery $y
2766         if {[info exists hovertimer]} {
2767             after cancel $hovertimer
2768         }
2769         set hovertimer [after 500 linehover]
2770     }
2771 }
2772
2773 proc lineleave {id} {
2774     global hoverid hovertimer canv
2775
2776     if {[info exists hoverid] && $id == $hoverid} {
2777         $canv delete hover
2778         if {[info exists hovertimer]} {
2779             after cancel $hovertimer
2780             unset hovertimer
2781         }
2782         unset hoverid
2783     }
2784 }
2785
2786 proc linehover {} {
2787     global hoverx hovery hoverid hovertimer
2788     global canv linespc lthickness
2789     global commitinfo mainfont
2790
2791     set text [lindex $commitinfo($hoverid) 0]
2792     set ymax [lindex [$canv cget -scrollregion] 3]
2793     if {$ymax == {}} return
2794     set yfrac [lindex [$canv yview] 0]
2795     set x [expr {$hoverx + 2 * $linespc}]
2796     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2797     set x0 [expr {$x - 2 * $lthickness}]
2798     set y0 [expr {$y - 2 * $lthickness}]
2799     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2800     set y1 [expr {$y + $linespc + 2 * $lthickness}]
2801     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2802                -fill \#ffff80 -outline black -width 1 -tags hover]
2803     $canv raise $t
2804     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2805     $canv raise $t
2806 }
2807
2808 proc lineclick {x y id isnew} {
2809     global ctext commitinfo children cflist canv
2810
2811     unmarkmatches
2812     unselectline
2813     if {$isnew} {
2814         addtohistory [list lineclick $x $x $id 0]
2815     }
2816     $canv delete hover
2817     # fill the details pane with info about this line
2818     $ctext conf -state normal
2819     $ctext delete 0.0 end
2820     $ctext tag conf link -foreground blue -underline 1
2821     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2822     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2823     $ctext insert end "Parent:\t"
2824     $ctext insert end $id [list link link0]
2825     $ctext tag bind link0 <1> [list selbyid $id]
2826     set info $commitinfo($id)
2827     $ctext insert end "\n\t[lindex $info 0]\n"
2828     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2829     $ctext insert end "\tDate:\t[lindex $info 2]\n"
2830     if {[info exists children($id)]} {
2831         $ctext insert end "\nChildren:"
2832         set i 0
2833         foreach child $children($id) {
2834             incr i
2835             set info $commitinfo($child)
2836             $ctext insert end "\n\t"
2837             $ctext insert end $child [list link link$i]
2838             $ctext tag bind link$i <1> [list selbyid $child]
2839             $ctext insert end "\n\t[lindex $info 0]"
2840             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2841             $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
2842         }
2843     }
2844     $ctext conf -state disabled
2845
2846     $cflist delete 0 end
2847 }
2848
2849 proc selbyid {id} {
2850     global idline
2851     if {[info exists idline($id)]} {
2852         selectline $idline($id) 1
2853     }
2854 }
2855
2856 proc mstime {} {
2857     global startmstime
2858     if {![info exists startmstime]} {
2859         set startmstime [clock clicks -milliseconds]
2860     }
2861     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2862 }
2863
2864 proc rowmenu {x y id} {
2865     global rowctxmenu idline selectedline rowmenuid
2866
2867     if {![info exists selectedline] || $idline($id) eq $selectedline} {
2868         set state disabled
2869     } else {
2870         set state normal
2871     }
2872     $rowctxmenu entryconfigure 0 -state $state
2873     $rowctxmenu entryconfigure 1 -state $state
2874     $rowctxmenu entryconfigure 2 -state $state
2875     set rowmenuid $id
2876     tk_popup $rowctxmenu $x $y
2877 }
2878
2879 proc diffvssel {dirn} {
2880     global rowmenuid selectedline lineid
2881
2882     if {![info exists selectedline]} return
2883     if {$dirn} {
2884         set oldid $lineid($selectedline)
2885         set newid $rowmenuid
2886     } else {
2887         set oldid $rowmenuid
2888         set newid $lineid($selectedline)
2889     }
2890     addtohistory [list doseldiff $oldid $newid]
2891     doseldiff $oldid $newid
2892 }
2893
2894 proc doseldiff {oldid newid} {
2895     global ctext cflist
2896     global commitinfo
2897
2898     $ctext conf -state normal
2899     $ctext delete 0.0 end
2900     $ctext mark set fmark.0 0.0
2901     $ctext mark gravity fmark.0 left
2902     $cflist delete 0 end
2903     $cflist insert end "Top"
2904     $ctext insert end "From "
2905     $ctext tag conf link -foreground blue -underline 1
2906     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2907     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2908     $ctext tag bind link0 <1> [list selbyid $oldid]
2909     $ctext insert end $oldid [list link link0]
2910     $ctext insert end "\n     "
2911     $ctext insert end [lindex $commitinfo($oldid) 0]
2912     $ctext insert end "\n\nTo   "
2913     $ctext tag bind link1 <1> [list selbyid $newid]
2914     $ctext insert end $newid [list link link1]
2915     $ctext insert end "\n     "
2916     $ctext insert end [lindex $commitinfo($newid) 0]
2917     $ctext insert end "\n"
2918     $ctext conf -state disabled
2919     $ctext tag delete Comments
2920     $ctext tag remove found 1.0 end
2921     startdiff [list $newid $oldid]
2922 }
2923
2924 proc mkpatch {} {
2925     global rowmenuid currentid commitinfo patchtop patchnum
2926
2927     if {![info exists currentid]} return
2928     set oldid $currentid
2929     set oldhead [lindex $commitinfo($oldid) 0]
2930     set newid $rowmenuid
2931     set newhead [lindex $commitinfo($newid) 0]
2932     set top .patch
2933     set patchtop $top
2934     catch {destroy $top}
2935     toplevel $top
2936     label $top.title -text "Generate patch"
2937     grid $top.title - -pady 10
2938     label $top.from -text "From:"
2939     entry $top.fromsha1 -width 40 -relief flat
2940     $top.fromsha1 insert 0 $oldid
2941     $top.fromsha1 conf -state readonly
2942     grid $top.from $top.fromsha1 -sticky w
2943     entry $top.fromhead -width 60 -relief flat
2944     $top.fromhead insert 0 $oldhead
2945     $top.fromhead conf -state readonly
2946     grid x $top.fromhead -sticky w
2947     label $top.to -text "To:"
2948     entry $top.tosha1 -width 40 -relief flat
2949     $top.tosha1 insert 0 $newid
2950     $top.tosha1 conf -state readonly
2951     grid $top.to $top.tosha1 -sticky w
2952     entry $top.tohead -width 60 -relief flat
2953     $top.tohead insert 0 $newhead
2954     $top.tohead conf -state readonly
2955     grid x $top.tohead -sticky w
2956     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2957     grid $top.rev x -pady 10
2958     label $top.flab -text "Output file:"
2959     entry $top.fname -width 60
2960     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2961     incr patchnum
2962     grid $top.flab $top.fname -sticky w
2963     frame $top.buts
2964     button $top.buts.gen -text "Generate" -command mkpatchgo
2965     button $top.buts.can -text "Cancel" -command mkpatchcan
2966     grid $top.buts.gen $top.buts.can
2967     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2968     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2969     grid $top.buts - -pady 10 -sticky ew
2970     focus $top.fname
2971 }
2972
2973 proc mkpatchrev {} {
2974     global patchtop
2975
2976     set oldid [$patchtop.fromsha1 get]
2977     set oldhead [$patchtop.fromhead get]
2978     set newid [$patchtop.tosha1 get]
2979     set newhead [$patchtop.tohead get]
2980     foreach e [list fromsha1 fromhead tosha1 tohead] \
2981             v [list $newid $newhead $oldid $oldhead] {
2982         $patchtop.$e conf -state normal
2983         $patchtop.$e delete 0 end
2984         $patchtop.$e insert 0 $v
2985         $patchtop.$e conf -state readonly
2986     }
2987 }
2988
2989 proc mkpatchgo {} {
2990     global patchtop
2991
2992     set oldid [$patchtop.fromsha1 get]
2993     set newid [$patchtop.tosha1 get]
2994     set fname [$patchtop.fname get]
2995     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
2996         error_popup "Error creating patch: $err"
2997     }
2998     catch {destroy $patchtop}
2999     unset patchtop
3000 }
3001
3002 proc mkpatchcan {} {
3003     global patchtop
3004
3005     catch {destroy $patchtop}
3006     unset patchtop
3007 }
3008
3009 proc mktag {} {
3010     global rowmenuid mktagtop commitinfo
3011
3012     set top .maketag
3013     set mktagtop $top
3014     catch {destroy $top}
3015     toplevel $top
3016     label $top.title -text "Create tag"
3017     grid $top.title - -pady 10
3018     label $top.id -text "ID:"
3019     entry $top.sha1 -width 40 -relief flat
3020     $top.sha1 insert 0 $rowmenuid
3021     $top.sha1 conf -state readonly
3022     grid $top.id $top.sha1 -sticky w
3023     entry $top.head -width 60 -relief flat
3024     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3025     $top.head conf -state readonly
3026     grid x $top.head -sticky w
3027     label $top.tlab -text "Tag name:"
3028     entry $top.tag -width 60
3029     grid $top.tlab $top.tag -sticky w
3030     frame $top.buts
3031     button $top.buts.gen -text "Create" -command mktaggo
3032     button $top.buts.can -text "Cancel" -command mktagcan
3033     grid $top.buts.gen $top.buts.can
3034     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3035     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3036     grid $top.buts - -pady 10 -sticky ew
3037     focus $top.tag
3038 }
3039
3040 proc domktag {} {
3041     global mktagtop env tagids idtags
3042     global idpos idline linehtag canv selectedline
3043
3044     set id [$mktagtop.sha1 get]
3045     set tag [$mktagtop.tag get]
3046     if {$tag == {}} {
3047         error_popup "No tag name specified"
3048         return
3049     }
3050     if {[info exists tagids($tag)]} {
3051         error_popup "Tag \"$tag\" already exists"
3052         return
3053     }
3054     if {[catch {
3055         set dir [gitdir]
3056         set fname [file join $dir "refs/tags" $tag]
3057         set f [open $fname w]
3058         puts $f $id
3059         close $f
3060     } err]} {
3061         error_popup "Error creating tag: $err"
3062         return
3063     }
3064
3065     set tagids($tag) $id
3066     lappend idtags($id) $tag
3067     $canv delete tag.$id
3068     set xt [eval drawtags $id $idpos($id)]
3069     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3070     if {[info exists selectedline] && $selectedline == $idline($id)} {
3071         selectline $selectedline 0
3072     }
3073 }
3074
3075 proc mktagcan {} {
3076     global mktagtop
3077
3078     catch {destroy $mktagtop}
3079     unset mktagtop
3080 }
3081
3082 proc mktaggo {} {
3083     domktag
3084     mktagcan
3085 }
3086
3087 proc writecommit {} {
3088     global rowmenuid wrcomtop commitinfo wrcomcmd
3089
3090     set top .writecommit
3091     set wrcomtop $top
3092     catch {destroy $top}
3093     toplevel $top
3094     label $top.title -text "Write commit to file"
3095     grid $top.title - -pady 10
3096     label $top.id -text "ID:"
3097     entry $top.sha1 -width 40 -relief flat
3098     $top.sha1 insert 0 $rowmenuid
3099     $top.sha1 conf -state readonly
3100     grid $top.id $top.sha1 -sticky w
3101     entry $top.head -width 60 -relief flat
3102     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3103     $top.head conf -state readonly
3104     grid x $top.head -sticky w
3105     label $top.clab -text "Command:"
3106     entry $top.cmd -width 60 -textvariable wrcomcmd
3107     grid $top.clab $top.cmd -sticky w -pady 10
3108     label $top.flab -text "Output file:"
3109     entry $top.fname -width 60
3110     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3111     grid $top.flab $top.fname -sticky w
3112     frame $top.buts
3113     button $top.buts.gen -text "Write" -command wrcomgo
3114     button $top.buts.can -text "Cancel" -command wrcomcan
3115     grid $top.buts.gen $top.buts.can
3116     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3117     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3118     grid $top.buts - -pady 10 -sticky ew
3119     focus $top.fname
3120 }
3121
3122 proc wrcomgo {} {
3123     global wrcomtop
3124
3125     set id [$wrcomtop.sha1 get]
3126     set cmd "echo $id | [$wrcomtop.cmd get]"
3127     set fname [$wrcomtop.fname get]
3128     if {[catch {exec sh -c $cmd >$fname &} err]} {
3129         error_popup "Error writing commit: $err"
3130     }
3131     catch {destroy $wrcomtop}
3132     unset wrcomtop
3133 }
3134
3135 proc wrcomcan {} {
3136     global wrcomtop
3137
3138     catch {destroy $wrcomtop}
3139     unset wrcomtop
3140 }
3141
3142 proc doquit {} {
3143     global stopped
3144     set stopped 100
3145     destroy .
3146 }
3147
3148 # defaults...
3149 set datemode 0
3150 set boldnames 0
3151 set diffopts "-U 5 -p"
3152 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3153
3154 set mainfont {Helvetica 9}
3155 set textfont {Courier 9}
3156 set findmergefiles 0
3157 set gaudydiff 0
3158 set maxgraphpct 50
3159
3160 set colors {green red blue magenta darkgrey brown orange}
3161
3162 catch {source ~/.gitk}
3163
3164 set namefont $mainfont
3165 if {$boldnames} {
3166     lappend namefont bold
3167 }
3168
3169 set revtreeargs {}
3170 foreach arg $argv {
3171     switch -regexp -- $arg {
3172         "^$" { }
3173         "^-b" { set boldnames 1 }
3174         "^-d" { set datemode 1 }
3175         default {
3176             lappend revtreeargs $arg
3177         }
3178     }
3179 }
3180
3181 set history {}
3182 set historyindex 0
3183
3184 set stopped 0
3185 set redisplaying 0
3186 set stuffsaved 0
3187 set patchnum 0
3188 setcoords
3189 makewindow
3190 readrefs
3191 getcommits $revtreeargs