gitk

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