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