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