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 diffindex difffilestart nextupdate diffinhdr
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     set diffindex 0
1880     catch {unset difffilestart}
1881     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
1882     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1883 }
1884
1885 proc getblobdiffline {bdf ids} {
1886     global diffids blobdifffd ctext curdifftag curtagstart
1887     global diffnexthead diffnextnote diffindex difffilestart
1888     global nextupdate diffinhdr
1889     global gaudydiff
1890
1891     set n [gets $bdf line]
1892     if {$n < 0} {
1893         if {[eof $bdf]} {
1894             close $bdf
1895             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
1896                 $ctext tag add $curdifftag $curtagstart end
1897             }
1898         }
1899         return
1900     }
1901     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
1902         return
1903     }
1904     $ctext conf -state normal
1905     if {[regexp {^diff --git a/(.*) b/} $line match fname]} {
1906         # start of a new file
1907         $ctext insert end "\n"
1908         $ctext tag add $curdifftag $curtagstart end
1909         set curtagstart [$ctext index "end - 1c"]
1910         set header $fname
1911         set here [$ctext index "end - 1c"]
1912         set difffilestart($diffindex) $here
1913         incr diffindex
1914         # start mark names at fmark.1 for first file
1915         $ctext mark set fmark.$diffindex $here
1916         $ctext mark gravity fmark.$diffindex left
1917         set curdifftag "f:$fname"
1918         $ctext tag delete $curdifftag
1919         set l [expr {(78 - [string length $header]) / 2}]
1920         set pad [string range "----------------------------------------" 1 $l]
1921         $ctext insert end "$pad $header $pad\n" filesep
1922         set diffinhdr 1
1923     } elseif {[regexp {^(---|\+\+\+)} $line]} {
1924         set diffinhdr 0
1925     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1926                    $line match f1l f1c f2l f2c rest]} {
1927         if {$gaudydiff} {
1928             $ctext insert end "\t" hunksep
1929             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
1930             $ctext insert end "    $rest \n" hunksep
1931         } else {
1932             $ctext insert end "$line\n" hunksep
1933         }
1934         set diffinhdr 0
1935     } else {
1936         set x [string range $line 0 0]
1937         if {$x == "-" || $x == "+"} {
1938             set tag [expr {$x == "+"}]
1939             if {$gaudydiff} {
1940                 set line [string range $line 1 end]
1941             }
1942             $ctext insert end "$line\n" d$tag
1943         } elseif {$x == " "} {
1944             if {$gaudydiff} {
1945                 set line [string range $line 1 end]
1946             }
1947             $ctext insert end "$line\n"
1948         } elseif {$diffinhdr || $x == "\\"} {
1949             # e.g. "\ No newline at end of file"
1950             $ctext insert end "$line\n" filesep
1951         } else {
1952             # Something else we don't recognize
1953             if {$curdifftag != "Comments"} {
1954                 $ctext insert end "\n"
1955                 $ctext tag add $curdifftag $curtagstart end
1956                 set curtagstart [$ctext index "end - 1c"]
1957                 set curdifftag Comments
1958             }
1959             $ctext insert end "$line\n" filesep
1960         }
1961     }
1962     $ctext conf -state disabled
1963     if {[clock clicks -milliseconds] >= $nextupdate} {
1964         incr nextupdate 100
1965         fileevent $bdf readable {}
1966         update
1967         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1968     }
1969 }
1970
1971 proc nextfile {} {
1972     global difffilestart ctext
1973     set here [$ctext index @0,0]
1974     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1975         if {[$ctext compare $difffilestart($i) > $here]} {
1976             $ctext yview $difffilestart($i)
1977             break
1978         }
1979     }
1980 }
1981
1982 proc listboxsel {} {
1983     global ctext cflist currentid treediffs
1984     if {![info exists currentid]} return
1985     set sel [lsort [$cflist curselection]]
1986     if {$sel eq {}} return
1987     set first [lindex $sel 0]
1988     catch {$ctext yview fmark.$first}
1989 }
1990
1991 proc setcoords {} {
1992     global linespc charspc canvx0 canvy0 mainfont
1993     set linespc [font metrics $mainfont -linespace]
1994     set charspc [font measure $mainfont "m"]
1995     set canvy0 [expr 3 + 0.5 * $linespc]
1996     set canvx0 [expr 3 + 0.5 * $linespc]
1997 }
1998
1999 proc redisplay {} {
2000     global selectedline stopped redisplaying phase
2001     if {$stopped > 1} return
2002     if {$phase == "getcommits"} return
2003     set redisplaying 1
2004     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2005         set stopped 1
2006     } else {
2007         drawgraph
2008     }
2009 }
2010
2011 proc incrfont {inc} {
2012     global mainfont namefont textfont selectedline ctext canv phase
2013     global stopped entries
2014     unmarkmatches
2015     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2016     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2017     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2018     setcoords
2019     $ctext conf -font $textfont
2020     $ctext tag conf filesep -font [concat $textfont bold]
2021     foreach e $entries {
2022         $e conf -font $mainfont
2023     }
2024     if {$phase == "getcommits"} {
2025         $canv itemconf textitems -font $mainfont
2026     }
2027     redisplay
2028 }
2029
2030 proc clearsha1 {} {
2031     global sha1entry sha1string
2032     if {[string length $sha1string] == 40} {
2033         $sha1entry delete 0 end
2034     }
2035 }
2036
2037 proc sha1change {n1 n2 op} {
2038     global sha1string currentid sha1but
2039     if {$sha1string == {}
2040         || ([info exists currentid] && $sha1string == $currentid)} {
2041         set state disabled
2042     } else {
2043         set state normal
2044     }
2045     if {[$sha1but cget -state] == $state} return
2046     if {$state == "normal"} {
2047         $sha1but conf -state normal -relief raised -text "Goto: "
2048     } else {
2049         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2050     }
2051 }
2052
2053 proc gotocommit {} {
2054     global sha1string currentid idline tagids
2055     global lineid numcommits
2056
2057     if {$sha1string == {}
2058         || ([info exists currentid] && $sha1string == $currentid)} return
2059     if {[info exists tagids($sha1string)]} {
2060         set id $tagids($sha1string)
2061     } else {
2062         set id [string tolower $sha1string]
2063         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2064             set matches {}
2065             for {set l 0} {$l < $numcommits} {incr l} {
2066                 if {[string match $id* $lineid($l)]} {
2067                     lappend matches $lineid($l)
2068                 }
2069             }
2070             if {$matches ne {}} {
2071                 if {[llength $matches] > 1} {
2072                     error_popup "Short SHA1 id $id is ambiguous"
2073                     return
2074                 }
2075                 set id [lindex $matches 0]
2076             }
2077         }
2078     }
2079     if {[info exists idline($id)]} {
2080         selectline $idline($id)
2081         return
2082     }
2083     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2084         set type "SHA1 id"
2085     } else {
2086         set type "Tag"
2087     }
2088     error_popup "$type $sha1string is not known"
2089 }
2090
2091 proc lineenter {x y id} {
2092     global hoverx hovery hoverid hovertimer
2093     global commitinfo canv
2094
2095     if {![info exists commitinfo($id)]} return
2096     set hoverx $x
2097     set hovery $y
2098     set hoverid $id
2099     if {[info exists hovertimer]} {
2100         after cancel $hovertimer
2101     }
2102     set hovertimer [after 500 linehover]
2103     $canv delete hover
2104 }
2105
2106 proc linemotion {x y id} {
2107     global hoverx hovery hoverid hovertimer
2108
2109     if {[info exists hoverid] && $id == $hoverid} {
2110         set hoverx $x
2111         set hovery $y
2112         if {[info exists hovertimer]} {
2113             after cancel $hovertimer
2114         }
2115         set hovertimer [after 500 linehover]
2116     }
2117 }
2118
2119 proc lineleave {id} {
2120     global hoverid hovertimer canv
2121
2122     if {[info exists hoverid] && $id == $hoverid} {
2123         $canv delete hover
2124         if {[info exists hovertimer]} {
2125             after cancel $hovertimer
2126             unset hovertimer
2127         }
2128         unset hoverid
2129     }
2130 }
2131
2132 proc linehover {} {
2133     global hoverx hovery hoverid hovertimer
2134     global canv linespc lthickness
2135     global commitinfo mainfont
2136
2137     set text [lindex $commitinfo($hoverid) 0]
2138     set ymax [lindex [$canv cget -scrollregion] 3]
2139     if {$ymax == {}} return
2140     set yfrac [lindex [$canv yview] 0]
2141     set x [expr {$hoverx + 2 * $linespc}]
2142     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2143     set x0 [expr {$x - 2 * $lthickness}]
2144     set y0 [expr {$y - 2 * $lthickness}]
2145     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2146     set y1 [expr {$y + $linespc + 2 * $lthickness}]
2147     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2148                -fill \#ffff80 -outline black -width 1 -tags hover]
2149     $canv raise $t
2150     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2151     $canv raise $t
2152 }
2153
2154 proc lineclick {x y id} {
2155     global ctext commitinfo children cflist canv
2156
2157     unmarkmatches
2158     $canv delete hover
2159     # fill the details pane with info about this line
2160     $ctext conf -state normal
2161     $ctext delete 0.0 end
2162     $ctext insert end "Parent:\n "
2163     catch {destroy $ctext.$id}
2164     button $ctext.$id -text "Go:" -command "selbyid $id" \
2165         -padx 4 -pady 0
2166     $ctext window create end -window $ctext.$id -align center
2167     set info $commitinfo($id)
2168     $ctext insert end "\t[lindex $info 0]\n"
2169     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2170     $ctext insert end "\tDate:\t[lindex $info 2]\n"
2171     $ctext insert end "\tID:\t$id\n"
2172     if {[info exists children($id)]} {
2173         $ctext insert end "\nChildren:"
2174         foreach child $children($id) {
2175             $ctext insert end "\n "
2176             catch {destroy $ctext.$child}
2177             button $ctext.$child -text "Go:" -command "selbyid $child" \
2178                 -padx 4 -pady 0
2179             $ctext window create end -window $ctext.$child -align center
2180             set info $commitinfo($child)
2181             $ctext insert end "\t[lindex $info 0]"
2182         }
2183     }
2184     $ctext conf -state disabled
2185
2186     $cflist delete 0 end
2187 }
2188
2189 proc selbyid {id} {
2190     global idline
2191     if {[info exists idline($id)]} {
2192         selectline $idline($id)
2193     }
2194 }
2195
2196 proc mstime {} {
2197     global startmstime
2198     if {![info exists startmstime]} {
2199         set startmstime [clock clicks -milliseconds]
2200     }
2201     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2202 }
2203
2204 proc rowmenu {x y id} {
2205     global rowctxmenu idline selectedline rowmenuid
2206
2207     if {![info exists selectedline] || $idline($id) eq $selectedline} {
2208         set state disabled
2209     } else {
2210         set state normal
2211     }
2212     $rowctxmenu entryconfigure 0 -state $state
2213     $rowctxmenu entryconfigure 1 -state $state
2214     $rowctxmenu entryconfigure 2 -state $state
2215     set rowmenuid $id
2216     tk_popup $rowctxmenu $x $y
2217 }
2218
2219 proc diffvssel {dirn} {
2220     global rowmenuid selectedline lineid
2221     global ctext cflist
2222     global commitinfo
2223
2224     if {![info exists selectedline]} return
2225     if {$dirn} {
2226         set oldid $lineid($selectedline)
2227         set newid $rowmenuid
2228     } else {
2229         set oldid $rowmenuid
2230         set newid $lineid($selectedline)
2231     }
2232     $ctext conf -state normal
2233     $ctext delete 0.0 end
2234     $ctext mark set fmark.0 0.0
2235     $ctext mark gravity fmark.0 left
2236     $cflist delete 0 end
2237     $cflist insert end "Top"
2238     $ctext insert end "From $oldid\n     "
2239     $ctext insert end [lindex $commitinfo($oldid) 0]
2240     $ctext insert end "\n\nTo   $newid\n     "
2241     $ctext insert end [lindex $commitinfo($newid) 0]
2242     $ctext insert end "\n"
2243     $ctext conf -state disabled
2244     $ctext tag delete Comments
2245     $ctext tag remove found 1.0 end
2246     startdiff $newid [list $oldid]
2247 }
2248
2249 proc mkpatch {} {
2250     global rowmenuid currentid commitinfo patchtop patchnum
2251
2252     if {![info exists currentid]} return
2253     set oldid $currentid
2254     set oldhead [lindex $commitinfo($oldid) 0]
2255     set newid $rowmenuid
2256     set newhead [lindex $commitinfo($newid) 0]
2257     set top .patch
2258     set patchtop $top
2259     catch {destroy $top}
2260     toplevel $top
2261     label $top.title -text "Generate patch"
2262     grid $top.title - -pady 10
2263     label $top.from -text "From:"
2264     entry $top.fromsha1 -width 40 -relief flat
2265     $top.fromsha1 insert 0 $oldid
2266     $top.fromsha1 conf -state readonly
2267     grid $top.from $top.fromsha1 -sticky w
2268     entry $top.fromhead -width 60 -relief flat
2269     $top.fromhead insert 0 $oldhead
2270     $top.fromhead conf -state readonly
2271     grid x $top.fromhead -sticky w
2272     label $top.to -text "To:"
2273     entry $top.tosha1 -width 40 -relief flat
2274     $top.tosha1 insert 0 $newid
2275     $top.tosha1 conf -state readonly
2276     grid $top.to $top.tosha1 -sticky w
2277     entry $top.tohead -width 60 -relief flat
2278     $top.tohead insert 0 $newhead
2279     $top.tohead conf -state readonly
2280     grid x $top.tohead -sticky w
2281     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2282     grid $top.rev x -pady 10
2283     label $top.flab -text "Output file:"
2284     entry $top.fname -width 60
2285     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2286     incr patchnum
2287     grid $top.flab $top.fname -sticky w
2288     frame $top.buts
2289     button $top.buts.gen -text "Generate" -command mkpatchgo
2290     button $top.buts.can -text "Cancel" -command mkpatchcan
2291     grid $top.buts.gen $top.buts.can
2292     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2293     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2294     grid $top.buts - -pady 10 -sticky ew
2295     focus $top.fname
2296 }
2297
2298 proc mkpatchrev {} {
2299     global patchtop
2300
2301     set oldid [$patchtop.fromsha1 get]
2302     set oldhead [$patchtop.fromhead get]
2303     set newid [$patchtop.tosha1 get]
2304     set newhead [$patchtop.tohead get]
2305     foreach e [list fromsha1 fromhead tosha1 tohead] \
2306             v [list $newid $newhead $oldid $oldhead] {
2307         $patchtop.$e conf -state normal
2308         $patchtop.$e delete 0 end
2309         $patchtop.$e insert 0 $v
2310         $patchtop.$e conf -state readonly
2311     }
2312 }
2313
2314 proc mkpatchgo {} {
2315     global patchtop
2316
2317     set oldid [$patchtop.fromsha1 get]
2318     set newid [$patchtop.tosha1 get]
2319     set fname [$patchtop.fname get]
2320     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
2321         error_popup "Error creating patch: $err"
2322     }
2323     catch {destroy $patchtop}
2324     unset patchtop
2325 }
2326
2327 proc mkpatchcan {} {
2328     global patchtop
2329
2330     catch {destroy $patchtop}
2331     unset patchtop
2332 }
2333
2334 proc mktag {} {
2335     global rowmenuid mktagtop commitinfo
2336
2337     set top .maketag
2338     set mktagtop $top
2339     catch {destroy $top}
2340     toplevel $top
2341     label $top.title -text "Create tag"
2342     grid $top.title - -pady 10
2343     label $top.id -text "ID:"
2344     entry $top.sha1 -width 40 -relief flat
2345     $top.sha1 insert 0 $rowmenuid
2346     $top.sha1 conf -state readonly
2347     grid $top.id $top.sha1 -sticky w
2348     entry $top.head -width 60 -relief flat
2349     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2350     $top.head conf -state readonly
2351     grid x $top.head -sticky w
2352     label $top.tlab -text "Tag name:"
2353     entry $top.tag -width 60
2354     grid $top.tlab $top.tag -sticky w
2355     frame $top.buts
2356     button $top.buts.gen -text "Create" -command mktaggo
2357     button $top.buts.can -text "Cancel" -command mktagcan
2358     grid $top.buts.gen $top.buts.can
2359     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2360     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2361     grid $top.buts - -pady 10 -sticky ew
2362     focus $top.tag
2363 }
2364
2365 proc domktag {} {
2366     global mktagtop env tagids idtags
2367     global idpos idline linehtag canv selectedline
2368
2369     set id [$mktagtop.sha1 get]
2370     set tag [$mktagtop.tag get]
2371     if {$tag == {}} {
2372         error_popup "No tag name specified"
2373         return
2374     }
2375     if {[info exists tagids($tag)]} {
2376         error_popup "Tag \"$tag\" already exists"
2377         return
2378     }
2379     if {[catch {
2380         set dir ".git"
2381         if {[info exists env(GIT_DIR)]} {
2382             set dir $env(GIT_DIR)
2383         }
2384         set fname [file join $dir "refs/tags" $tag]
2385         set f [open $fname w]
2386         puts $f $id
2387         close $f
2388     } err]} {
2389         error_popup "Error creating tag: $err"
2390         return
2391     }
2392
2393     set tagids($tag) $id
2394     lappend idtags($id) $tag
2395     $canv delete tag.$id
2396     set xt [eval drawtags $id $idpos($id)]
2397     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
2398     if {[info exists selectedline] && $selectedline == $idline($id)} {
2399         selectline $selectedline
2400     }
2401 }
2402
2403 proc mktagcan {} {
2404     global mktagtop
2405
2406     catch {destroy $mktagtop}
2407     unset mktagtop
2408 }
2409
2410 proc mktaggo {} {
2411     domktag
2412     mktagcan
2413 }
2414
2415 proc writecommit {} {
2416     global rowmenuid wrcomtop commitinfo wrcomcmd
2417
2418     set top .writecommit
2419     set wrcomtop $top
2420     catch {destroy $top}
2421     toplevel $top
2422     label $top.title -text "Write commit to file"
2423     grid $top.title - -pady 10
2424     label $top.id -text "ID:"
2425     entry $top.sha1 -width 40 -relief flat
2426     $top.sha1 insert 0 $rowmenuid
2427     $top.sha1 conf -state readonly
2428     grid $top.id $top.sha1 -sticky w
2429     entry $top.head -width 60 -relief flat
2430     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2431     $top.head conf -state readonly
2432     grid x $top.head -sticky w
2433     label $top.clab -text "Command:"
2434     entry $top.cmd -width 60 -textvariable wrcomcmd
2435     grid $top.clab $top.cmd -sticky w -pady 10
2436     label $top.flab -text "Output file:"
2437     entry $top.fname -width 60
2438     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
2439     grid $top.flab $top.fname -sticky w
2440     frame $top.buts
2441     button $top.buts.gen -text "Write" -command wrcomgo
2442     button $top.buts.can -text "Cancel" -command wrcomcan
2443     grid $top.buts.gen $top.buts.can
2444     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2445     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2446     grid $top.buts - -pady 10 -sticky ew
2447     focus $top.fname
2448 }
2449
2450 proc wrcomgo {} {
2451     global wrcomtop
2452
2453     set id [$wrcomtop.sha1 get]
2454     set cmd "echo $id | [$wrcomtop.cmd get]"
2455     set fname [$wrcomtop.fname get]
2456     if {[catch {exec sh -c $cmd >$fname &} err]} {
2457         error_popup "Error writing commit: $err"
2458     }
2459     catch {destroy $wrcomtop}
2460     unset wrcomtop
2461 }
2462
2463 proc wrcomcan {} {
2464     global wrcomtop
2465
2466     catch {destroy $wrcomtop}
2467     unset wrcomtop
2468 }
2469
2470 proc doquit {} {
2471     global stopped
2472     set stopped 100
2473     destroy .
2474 }
2475
2476 # defaults...
2477 set datemode 0
2478 set boldnames 0
2479 set diffopts "-U 5 -p"
2480 set wrcomcmd "git-diff-tree --stdin -p --pretty"
2481
2482 set mainfont {Helvetica 9}
2483 set textfont {Courier 9}
2484 set findmergefiles 0
2485 set gaudydiff 0
2486
2487 set colors {green red blue magenta darkgrey brown orange}
2488
2489 catch {source ~/.gitk}
2490
2491 set namefont $mainfont
2492 if {$boldnames} {
2493     lappend namefont bold
2494 }
2495
2496 set revtreeargs {}
2497 foreach arg $argv {
2498     switch -regexp -- $arg {
2499         "^$" { }
2500         "^-b" { set boldnames 1 }
2501         "^-d" { set datemode 1 }
2502         default {
2503             lappend revtreeargs $arg
2504         }
2505     }
2506 }
2507
2508 set stopped 0
2509 set redisplaying 0
2510 set stuffsaved 0
2511 set patchnum 0
2512 setcoords
2513 makewindow
2514 readrefs
2515 getcommits $revtreeargs