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