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