gitk

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