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