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 --topo-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 treepending
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     startdiff $id $parents($id)
1696 }
1697
1698 proc startdiff {id vs} {
1699     global diffpending diffpindex
1700     global diffindex difffilestart
1701     global curdifftag curtagstart
1702
1703     set diffpending $vs
1704     set diffpindex 0
1705     set diffindex 0
1706     catch {unset difffilestart}
1707     set curdifftag Comments
1708     set curtagstart 0.0
1709     contdiff [list $id [lindex $vs 0]]
1710 }
1711
1712 proc contdiff {ids} {
1713     global treediffs diffids treepending
1714
1715     set diffids $ids
1716     if {![info exists treediffs($ids)]} {
1717         if {![info exists treepending]} {
1718             gettreediffs $ids
1719         }
1720     } else {
1721         addtocflist $ids
1722     }
1723 }
1724
1725 proc selnextline {dir} {
1726     global selectedline
1727     if {![info exists selectedline]} return
1728     set l [expr $selectedline + $dir]
1729     unmarkmatches
1730     selectline $l
1731 }
1732
1733 proc addtocflist {ids} {
1734     global treediffs cflist diffpindex
1735
1736     set colors {black blue green red cyan magenta}
1737     set color [lindex $colors [expr {$diffpindex % [llength $colors]}]]
1738     foreach f $treediffs($ids) {
1739         $cflist insert end $f
1740         $cflist itemconf end -foreground $color
1741     }
1742     getblobdiffs $ids
1743 }
1744
1745 proc gettreediffs {ids} {
1746     global treediffs parents treepending
1747     set treepending $ids
1748     set treediffs($ids) {}
1749     set id [lindex $ids 0]
1750     set p [lindex $ids 1]
1751     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1752     fconfigure $gdtf -blocking 0
1753     fileevent $gdtf readable "gettreediffline $gdtf {$ids}"
1754 }
1755
1756 proc gettreediffline {gdtf ids} {
1757     global treediffs treepending diffids
1758     set n [gets $gdtf line]
1759     if {$n < 0} {
1760         if {![eof $gdtf]} return
1761         close $gdtf
1762         unset treepending
1763         if {[info exists diffids]} {
1764             if {$ids != $diffids} {
1765                 gettreediffs $diffids
1766             } else {
1767                 addtocflist $ids
1768             }
1769         }
1770         return
1771     }
1772     set file [lindex $line 5]
1773     lappend treediffs($ids) $file
1774 }
1775
1776 proc getblobdiffs {ids} {
1777     global diffopts blobdifffd diffids env
1778     global nextupdate diffinhdr
1779
1780     set id [lindex $ids 0]
1781     set p [lindex $ids 1]
1782     set env(GIT_DIFF_OPTS) $diffopts
1783     if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1784         puts "error getting diffs: $err"
1785         return
1786     }
1787     set diffinhdr 0
1788     fconfigure $bdf -blocking 0
1789     set blobdifffd($ids) $bdf
1790     fileevent $bdf readable [list getblobdiffline $bdf $ids]
1791     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1792 }
1793
1794 proc getblobdiffline {bdf ids} {
1795     global diffids blobdifffd ctext curdifftag curtagstart
1796     global diffnexthead diffnextnote diffindex difffilestart
1797     global nextupdate diffpending diffpindex diffinhdr
1798     global gaudydiff
1799
1800     set n [gets $bdf line]
1801     if {$n < 0} {
1802         if {[eof $bdf]} {
1803             close $bdf
1804             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
1805                 $ctext tag add $curdifftag $curtagstart end
1806                 if {[incr diffpindex] < [llength $diffpending]} {
1807                     set id [lindex $ids 0]
1808                     set p [lindex $diffpending $diffpindex]
1809                     contdiff [list $id $p]
1810                 }
1811             }
1812         }
1813         return
1814     }
1815     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
1816         return
1817     }
1818     $ctext conf -state normal
1819     if {[regexp {^diff --git a/(.*) b/} $line match fname]} {
1820         # start of a new file
1821         $ctext insert end "\n"
1822         $ctext tag add $curdifftag $curtagstart end
1823         set curtagstart [$ctext index "end - 1c"]
1824         set header $fname
1825         set here [$ctext index "end - 1c"]
1826         set difffilestart($diffindex) $here
1827         incr diffindex
1828         # start mark names at fmark.1 for first file
1829         $ctext mark set fmark.$diffindex $here
1830         $ctext mark gravity fmark.$diffindex left
1831         set curdifftag "f:$fname"
1832         $ctext tag delete $curdifftag
1833         set l [expr {(78 - [string length $header]) / 2}]
1834         set pad [string range "----------------------------------------" 1 $l]
1835         $ctext insert end "$pad $header $pad\n" filesep
1836         set diffinhdr 1
1837     } elseif {[regexp {^(---|\+\+\+)} $line]} {
1838         set diffinhdr 0
1839     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1840                    $line match f1l f1c f2l f2c rest]} {
1841         if {$gaudydiff} {
1842             $ctext insert end "\t" hunksep
1843             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
1844             $ctext insert end "    $rest \n" hunksep
1845         } else {
1846             $ctext insert end "$line\n" hunksep
1847         }
1848         set diffinhdr 0
1849     } else {
1850         set x [string range $line 0 0]
1851         if {$x == "-" || $x == "+"} {
1852             set tag [expr {$x == "+"}]
1853             if {$gaudydiff} {
1854                 set line [string range $line 1 end]
1855             }
1856             $ctext insert end "$line\n" d$tag
1857         } elseif {$x == " "} {
1858             if {$gaudydiff} {
1859                 set line [string range $line 1 end]
1860             }
1861             $ctext insert end "$line\n"
1862         } elseif {$diffinhdr || $x == "\\"} {
1863             # e.g. "\ No newline at end of file"
1864             $ctext insert end "$line\n" filesep
1865         } else {
1866             # Something else we don't recognize
1867             if {$curdifftag != "Comments"} {
1868                 $ctext insert end "\n"
1869                 $ctext tag add $curdifftag $curtagstart end
1870                 set curtagstart [$ctext index "end - 1c"]
1871                 set curdifftag Comments
1872             }
1873             $ctext insert end "$line\n" filesep
1874         }
1875     }
1876     $ctext conf -state disabled
1877     if {[clock clicks -milliseconds] >= $nextupdate} {
1878         incr nextupdate 100
1879         fileevent $bdf readable {}
1880         update
1881         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1882     }
1883 }
1884
1885 proc nextfile {} {
1886     global difffilestart ctext
1887     set here [$ctext index @0,0]
1888     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1889         if {[$ctext compare $difffilestart($i) > $here]} {
1890             $ctext yview $difffilestart($i)
1891             break
1892         }
1893     }
1894 }
1895
1896 proc listboxsel {} {
1897     global ctext cflist currentid treediffs
1898     if {![info exists currentid]} return
1899     set sel [lsort [$cflist curselection]]
1900     if {$sel eq {}} return
1901     set first [lindex $sel 0]
1902     catch {$ctext yview fmark.$first}
1903 }
1904
1905 proc setcoords {} {
1906     global linespc charspc canvx0 canvy0 mainfont
1907     set linespc [font metrics $mainfont -linespace]
1908     set charspc [font measure $mainfont "m"]
1909     set canvy0 [expr 3 + 0.5 * $linespc]
1910     set canvx0 [expr 3 + 0.5 * $linespc]
1911 }
1912
1913 proc redisplay {} {
1914     global selectedline stopped redisplaying phase
1915     if {$stopped > 1} return
1916     if {$phase == "getcommits"} return
1917     set redisplaying 1
1918     if {$phase == "drawgraph" || $phase == "incrdraw"} {
1919         set stopped 1
1920     } else {
1921         drawgraph
1922     }
1923 }
1924
1925 proc incrfont {inc} {
1926     global mainfont namefont textfont selectedline ctext canv phase
1927     global stopped entries
1928     unmarkmatches
1929     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1930     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1931     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1932     setcoords
1933     $ctext conf -font $textfont
1934     $ctext tag conf filesep -font [concat $textfont bold]
1935     foreach e $entries {
1936         $e conf -font $mainfont
1937     }
1938     if {$phase == "getcommits"} {
1939         $canv itemconf textitems -font $mainfont
1940     }
1941     redisplay
1942 }
1943
1944 proc clearsha1 {} {
1945     global sha1entry sha1string
1946     if {[string length $sha1string] == 40} {
1947         $sha1entry delete 0 end
1948     }
1949 }
1950
1951 proc sha1change {n1 n2 op} {
1952     global sha1string currentid sha1but
1953     if {$sha1string == {}
1954         || ([info exists currentid] && $sha1string == $currentid)} {
1955         set state disabled
1956     } else {
1957         set state normal
1958     }
1959     if {[$sha1but cget -state] == $state} return
1960     if {$state == "normal"} {
1961         $sha1but conf -state normal -relief raised -text "Goto: "
1962     } else {
1963         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1964     }
1965 }
1966
1967 proc gotocommit {} {
1968     global sha1string currentid idline tagids
1969     global lineid numcommits
1970
1971     if {$sha1string == {}
1972         || ([info exists currentid] && $sha1string == $currentid)} return
1973     if {[info exists tagids($sha1string)]} {
1974         set id $tagids($sha1string)
1975     } else {
1976         set id [string tolower $sha1string]
1977         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
1978             set matches {}
1979             for {set l 0} {$l < $numcommits} {incr l} {
1980                 if {[string match $id* $lineid($l)]} {
1981                     lappend matches $lineid($l)
1982                 }
1983             }
1984             if {$matches ne {}} {
1985                 if {[llength $matches] > 1} {
1986                     error_popup "Short SHA1 id $id is ambiguous"
1987                     return
1988                 }
1989                 set id [lindex $matches 0]
1990             }
1991         }
1992     }
1993     if {[info exists idline($id)]} {
1994         selectline $idline($id)
1995         return
1996     }
1997     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
1998         set type "SHA1 id"
1999     } else {
2000         set type "Tag"
2001     }
2002     error_popup "$type $sha1string is not known"
2003 }
2004
2005 proc lineenter {x y id} {
2006     global hoverx hovery hoverid hovertimer
2007     global commitinfo canv
2008
2009     if {![info exists commitinfo($id)]} return
2010     set hoverx $x
2011     set hovery $y
2012     set hoverid $id
2013     if {[info exists hovertimer]} {
2014         after cancel $hovertimer
2015     }
2016     set hovertimer [after 500 linehover]
2017     $canv delete hover
2018 }
2019
2020 proc linemotion {x y id} {
2021     global hoverx hovery hoverid hovertimer
2022
2023     if {[info exists hoverid] && $id == $hoverid} {
2024         set hoverx $x
2025         set hovery $y
2026         if {[info exists hovertimer]} {
2027             after cancel $hovertimer
2028         }
2029         set hovertimer [after 500 linehover]
2030     }
2031 }
2032
2033 proc lineleave {id} {
2034     global hoverid hovertimer canv
2035
2036     if {[info exists hoverid] && $id == $hoverid} {
2037         $canv delete hover
2038         if {[info exists hovertimer]} {
2039             after cancel $hovertimer
2040             unset hovertimer
2041         }
2042         unset hoverid
2043     }
2044 }
2045
2046 proc linehover {} {
2047     global hoverx hovery hoverid hovertimer
2048     global canv linespc lthickness
2049     global commitinfo mainfont
2050
2051     set text [lindex $commitinfo($hoverid) 0]
2052     set ymax [lindex [$canv cget -scrollregion] 3]
2053     if {$ymax == {}} return
2054     set yfrac [lindex [$canv yview] 0]
2055     set x [expr {$hoverx + 2 * $linespc}]
2056     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2057     set x0 [expr {$x - 2 * $lthickness}]
2058     set y0 [expr {$y - 2 * $lthickness}]
2059     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2060     set y1 [expr {$y + $linespc + 2 * $lthickness}]
2061     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2062                -fill \#ffff80 -outline black -width 1 -tags hover]
2063     $canv raise $t
2064     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2065     $canv raise $t
2066 }
2067
2068 proc lineclick {x y id} {
2069     global ctext commitinfo children cflist canv
2070
2071     unmarkmatches
2072     $canv delete hover
2073     # fill the details pane with info about this line
2074     $ctext conf -state normal
2075     $ctext delete 0.0 end
2076     $ctext insert end "Parent:\n "
2077     catch {destroy $ctext.$id}
2078     button $ctext.$id -text "Go:" -command "selbyid $id" \
2079         -padx 4 -pady 0
2080     $ctext window create end -window $ctext.$id -align center
2081     set info $commitinfo($id)
2082     $ctext insert end "\t[lindex $info 0]\n"
2083     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2084     $ctext insert end "\tDate:\t[lindex $info 2]\n"
2085     $ctext insert end "\tID:\t$id\n"
2086     if {[info exists children($id)]} {
2087         $ctext insert end "\nChildren:"
2088         foreach child $children($id) {
2089             $ctext insert end "\n "
2090             catch {destroy $ctext.$child}
2091             button $ctext.$child -text "Go:" -command "selbyid $child" \
2092                 -padx 4 -pady 0
2093             $ctext window create end -window $ctext.$child -align center
2094             set info $commitinfo($child)
2095             $ctext insert end "\t[lindex $info 0]"
2096         }
2097     }
2098     $ctext conf -state disabled
2099
2100     $cflist delete 0 end
2101 }
2102
2103 proc selbyid {id} {
2104     global idline
2105     if {[info exists idline($id)]} {
2106         selectline $idline($id)
2107     }
2108 }
2109
2110 proc mstime {} {
2111     global startmstime
2112     if {![info exists startmstime]} {
2113         set startmstime [clock clicks -milliseconds]
2114     }
2115     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2116 }
2117
2118 proc rowmenu {x y id} {
2119     global rowctxmenu idline selectedline rowmenuid
2120
2121     if {![info exists selectedline] || $idline($id) eq $selectedline} {
2122         set state disabled
2123     } else {
2124         set state normal
2125     }
2126     $rowctxmenu entryconfigure 0 -state $state
2127     $rowctxmenu entryconfigure 1 -state $state
2128     $rowctxmenu entryconfigure 2 -state $state
2129     set rowmenuid $id
2130     tk_popup $rowctxmenu $x $y
2131 }
2132
2133 proc diffvssel {dirn} {
2134     global rowmenuid selectedline lineid
2135     global ctext cflist
2136     global commitinfo
2137
2138     if {![info exists selectedline]} return
2139     if {$dirn} {
2140         set oldid $lineid($selectedline)
2141         set newid $rowmenuid
2142     } else {
2143         set oldid $rowmenuid
2144         set newid $lineid($selectedline)
2145     }
2146     $ctext conf -state normal
2147     $ctext delete 0.0 end
2148     $ctext mark set fmark.0 0.0
2149     $ctext mark gravity fmark.0 left
2150     $cflist delete 0 end
2151     $cflist insert end "Top"
2152     $ctext insert end "From $oldid\n     "
2153     $ctext insert end [lindex $commitinfo($oldid) 0]
2154     $ctext insert end "\n\nTo   $newid\n     "
2155     $ctext insert end [lindex $commitinfo($newid) 0]
2156     $ctext insert end "\n"
2157     $ctext conf -state disabled
2158     $ctext tag delete Comments
2159     $ctext tag remove found 1.0 end
2160     startdiff [list $newid $oldid]
2161 }
2162
2163 proc mkpatch {} {
2164     global rowmenuid currentid commitinfo patchtop patchnum
2165
2166     if {![info exists currentid]} return
2167     set oldid $currentid
2168     set oldhead [lindex $commitinfo($oldid) 0]
2169     set newid $rowmenuid
2170     set newhead [lindex $commitinfo($newid) 0]
2171     set top .patch
2172     set patchtop $top
2173     catch {destroy $top}
2174     toplevel $top
2175     label $top.title -text "Generate patch"
2176     grid $top.title - -pady 10
2177     label $top.from -text "From:"
2178     entry $top.fromsha1 -width 40 -relief flat
2179     $top.fromsha1 insert 0 $oldid
2180     $top.fromsha1 conf -state readonly
2181     grid $top.from $top.fromsha1 -sticky w
2182     entry $top.fromhead -width 60 -relief flat
2183     $top.fromhead insert 0 $oldhead
2184     $top.fromhead conf -state readonly
2185     grid x $top.fromhead -sticky w
2186     label $top.to -text "To:"
2187     entry $top.tosha1 -width 40 -relief flat
2188     $top.tosha1 insert 0 $newid
2189     $top.tosha1 conf -state readonly
2190     grid $top.to $top.tosha1 -sticky w
2191     entry $top.tohead -width 60 -relief flat
2192     $top.tohead insert 0 $newhead
2193     $top.tohead conf -state readonly
2194     grid x $top.tohead -sticky w
2195     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2196     grid $top.rev x -pady 10
2197     label $top.flab -text "Output file:"
2198     entry $top.fname -width 60
2199     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2200     incr patchnum
2201     grid $top.flab $top.fname -sticky w
2202     frame $top.buts
2203     button $top.buts.gen -text "Generate" -command mkpatchgo
2204     button $top.buts.can -text "Cancel" -command mkpatchcan
2205     grid $top.buts.gen $top.buts.can
2206     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2207     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2208     grid $top.buts - -pady 10 -sticky ew
2209     focus $top.fname
2210 }
2211
2212 proc mkpatchrev {} {
2213     global patchtop
2214
2215     set oldid [$patchtop.fromsha1 get]
2216     set oldhead [$patchtop.fromhead get]
2217     set newid [$patchtop.tosha1 get]
2218     set newhead [$patchtop.tohead get]
2219     foreach e [list fromsha1 fromhead tosha1 tohead] \
2220             v [list $newid $newhead $oldid $oldhead] {
2221         $patchtop.$e conf -state normal
2222         $patchtop.$e delete 0 end
2223         $patchtop.$e insert 0 $v
2224         $patchtop.$e conf -state readonly
2225     }
2226 }
2227
2228 proc mkpatchgo {} {
2229     global patchtop
2230
2231     set oldid [$patchtop.fromsha1 get]
2232     set newid [$patchtop.tosha1 get]
2233     set fname [$patchtop.fname get]
2234     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
2235         error_popup "Error creating patch: $err"
2236     }
2237     catch {destroy $patchtop}
2238     unset patchtop
2239 }
2240
2241 proc mkpatchcan {} {
2242     global patchtop
2243
2244     catch {destroy $patchtop}
2245     unset patchtop
2246 }
2247
2248 proc mktag {} {
2249     global rowmenuid mktagtop commitinfo
2250
2251     set top .maketag
2252     set mktagtop $top
2253     catch {destroy $top}
2254     toplevel $top
2255     label $top.title -text "Create tag"
2256     grid $top.title - -pady 10
2257     label $top.id -text "ID:"
2258     entry $top.sha1 -width 40 -relief flat
2259     $top.sha1 insert 0 $rowmenuid
2260     $top.sha1 conf -state readonly
2261     grid $top.id $top.sha1 -sticky w
2262     entry $top.head -width 60 -relief flat
2263     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2264     $top.head conf -state readonly
2265     grid x $top.head -sticky w
2266     label $top.tlab -text "Tag name:"
2267     entry $top.tag -width 60
2268     grid $top.tlab $top.tag -sticky w
2269     frame $top.buts
2270     button $top.buts.gen -text "Create" -command mktaggo
2271     button $top.buts.can -text "Cancel" -command mktagcan
2272     grid $top.buts.gen $top.buts.can
2273     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2274     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2275     grid $top.buts - -pady 10 -sticky ew
2276     focus $top.tag
2277 }
2278
2279 proc domktag {} {
2280     global mktagtop env tagids idtags
2281     global idpos idline linehtag canv selectedline
2282
2283     set id [$mktagtop.sha1 get]
2284     set tag [$mktagtop.tag get]
2285     if {$tag == {}} {
2286         error_popup "No tag name specified"
2287         return
2288     }
2289     if {[info exists tagids($tag)]} {
2290         error_popup "Tag \"$tag\" already exists"
2291         return
2292     }
2293     if {[catch {
2294         set dir ".git"
2295         if {[info exists env(GIT_DIR)]} {
2296             set dir $env(GIT_DIR)
2297         }
2298         set fname [file join $dir "refs/tags" $tag]
2299         set f [open $fname w]
2300         puts $f $id
2301         close $f
2302     } err]} {
2303         error_popup "Error creating tag: $err"
2304         return
2305     }
2306
2307     set tagids($tag) $id
2308     lappend idtags($id) $tag
2309     $canv delete tag.$id
2310     set xt [eval drawtags $id $idpos($id)]
2311     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
2312     if {[info exists selectedline] && $selectedline == $idline($id)} {
2313         selectline $selectedline
2314     }
2315 }
2316
2317 proc mktagcan {} {
2318     global mktagtop
2319
2320     catch {destroy $mktagtop}
2321     unset mktagtop
2322 }
2323
2324 proc mktaggo {} {
2325     domktag
2326     mktagcan
2327 }
2328
2329 proc writecommit {} {
2330     global rowmenuid wrcomtop commitinfo wrcomcmd
2331
2332     set top .writecommit
2333     set wrcomtop $top
2334     catch {destroy $top}
2335     toplevel $top
2336     label $top.title -text "Write commit to file"
2337     grid $top.title - -pady 10
2338     label $top.id -text "ID:"
2339     entry $top.sha1 -width 40 -relief flat
2340     $top.sha1 insert 0 $rowmenuid
2341     $top.sha1 conf -state readonly
2342     grid $top.id $top.sha1 -sticky w
2343     entry $top.head -width 60 -relief flat
2344     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2345     $top.head conf -state readonly
2346     grid x $top.head -sticky w
2347     label $top.clab -text "Command:"
2348     entry $top.cmd -width 60 -textvariable wrcomcmd
2349     grid $top.clab $top.cmd -sticky w -pady 10
2350     label $top.flab -text "Output file:"
2351     entry $top.fname -width 60
2352     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
2353     grid $top.flab $top.fname -sticky w
2354     frame $top.buts
2355     button $top.buts.gen -text "Write" -command wrcomgo
2356     button $top.buts.can -text "Cancel" -command wrcomcan
2357     grid $top.buts.gen $top.buts.can
2358     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2359     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2360     grid $top.buts - -pady 10 -sticky ew
2361     focus $top.fname
2362 }
2363
2364 proc wrcomgo {} {
2365     global wrcomtop
2366
2367     set id [$wrcomtop.sha1 get]
2368     set cmd "echo $id | [$wrcomtop.cmd get]"
2369     set fname [$wrcomtop.fname get]
2370     if {[catch {exec sh -c $cmd >$fname &} err]} {
2371         error_popup "Error writing commit: $err"
2372     }
2373     catch {destroy $wrcomtop}
2374     unset wrcomtop
2375 }
2376
2377 proc wrcomcan {} {
2378     global wrcomtop
2379
2380     catch {destroy $wrcomtop}
2381     unset wrcomtop
2382 }
2383
2384 proc doquit {} {
2385     global stopped
2386     set stopped 100
2387     destroy .
2388 }
2389
2390 # defaults...
2391 set datemode 0
2392 set boldnames 0
2393 set diffopts "-U 5 -p"
2394 set wrcomcmd "git-diff-tree --stdin -p --pretty"
2395
2396 set mainfont {Helvetica 9}
2397 set textfont {Courier 9}
2398 set findmergefiles 0
2399 set gaudydiff 0
2400
2401 set colors {green red blue magenta darkgrey brown orange}
2402
2403 catch {source ~/.gitk}
2404
2405 set namefont $mainfont
2406 if {$boldnames} {
2407     lappend namefont bold
2408 }
2409
2410 set revtreeargs {}
2411 foreach arg $argv {
2412     switch -regexp -- $arg {
2413         "^$" { }
2414         "^-b" { set boldnames 1 }
2415         "^-d" { set datemode 1 }
2416         default {
2417             lappend revtreeargs $arg
2418         }
2419     }
2420 }
2421
2422 set stopped 0
2423 set redisplaying 0
2424 set stuffsaved 0
2425 set patchnum 0
2426 setcoords
2427 makewindow
2428 readrefs
2429 getcommits $revtreeargs