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         showmergediff
1733     } else {
1734         contmergediff {}
1735     }
1736 }
1737
1738 proc findgca {ids} {
1739     set gca {}
1740     foreach id $ids {
1741         if {$gca eq {}} {
1742             set gca $id
1743         } else {
1744             if {[catch {
1745                 set gca [exec git-merge-base $gca $id]
1746             } err]} {
1747                 return {}
1748             }
1749         }
1750     }
1751     return $gca
1752 }
1753
1754 proc contmergediff {ids} {
1755     global diffmergeid diffpindex parents nparents diffmergegca
1756     global treediffs mergefilelist diffids
1757
1758     # diff the child against each of the parents, and diff
1759     # each of the parents against the GCA.
1760     while 1 {
1761         if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
1762             set ids [list [lindex $ids 1] $diffmergegca]
1763         } else {
1764             if {[incr diffpindex] >= $nparents($diffmergeid)} break
1765             set p [lindex $parents($diffmergeid) $diffpindex]
1766             set ids [list $diffmergeid $p]
1767         }
1768         if {![info exists treediffs($ids)]} {
1769             set diffids $ids
1770             if {![info exists treepending]} {
1771                 gettreediffs $ids
1772             }
1773             return
1774         }
1775     }
1776
1777     # If a file in some parent is different from the child and also
1778     # different from the GCA, then it's interesting.
1779     # If we don't have a GCA, then a file is interesting if it is
1780     # different from the child in all the parents.
1781     if {$diffmergegca ne {}} {
1782         set files {}
1783         foreach p $parents($diffmergeid) {
1784             set gcadiffs $treediffs([list $p $diffmergegca])
1785             foreach f $treediffs([list $diffmergeid $p]) {
1786                 if {[lsearch -exact $files $f] < 0
1787                     && [lsearch -exact $gcadiffs $f] >= 0} {
1788                     lappend files $f
1789                 }
1790             }
1791         }
1792         set files [lsort $files]
1793     } else {
1794         set p [lindex $parents($diffmergeid) 0]
1795         set files $treediffs([list $diffmergeid $p])
1796         for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
1797             set p [lindex $parents($diffmergeid) $i]
1798             set df $treediffs([list $diffmergeid $p])
1799             set nf {}
1800             foreach f $files {
1801                 if {[lsearch -exact $df $f] >= 0} {
1802                     lappend nf $f
1803                 }
1804             }
1805             set files $nf
1806         }
1807     }
1808
1809     set mergefilelist($diffmergeid) $files
1810     if {$files ne {}} {
1811         showmergediff
1812     }
1813 }
1814
1815 proc showmergediff {} {
1816     global cflist diffmergeid mergefilelist parents
1817     global diffopts diffinhunk currentfile diffblocked
1818     global groupfilelast mergefds
1819
1820     set files $mergefilelist($diffmergeid)
1821     foreach f $files {
1822         $cflist insert end $f
1823     }
1824     set env(GIT_DIFF_OPTS) $diffopts
1825     set flist {}
1826     catch {unset currentfile}
1827     catch {unset currenthunk}
1828     catch {unset filelines}
1829     set groupfilelast -1
1830     foreach p $parents($diffmergeid) {
1831         set cmd [list | git-diff-tree -p $p $diffmergeid]
1832         set cmd [concat $cmd $mergefilelist($diffmergeid)]
1833         if {[catch {set f [open $cmd r]} err]} {
1834             error_popup "Error getting diffs: $err"
1835             foreach f $flist {
1836                 catch {close $f}
1837             }
1838             return
1839         }
1840         lappend flist $f
1841         set ids [list $diffmergeid $p]
1842         set mergefds($ids) $f
1843         set diffinhunk($ids) 0
1844         set diffblocked($ids) 0
1845         fconfigure $f -blocking 0
1846         fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
1847     }
1848 }
1849
1850 proc getmergediffline {f ids id} {
1851     global diffmergeid diffinhunk diffoldlines diffnewlines
1852     global currentfile currenthunk
1853     global diffoldstart diffnewstart diffoldlno diffnewlno
1854     global diffblocked mergefilelist
1855     global noldlines nnewlines difflcounts filelines
1856
1857     set n [gets $f line]
1858     if {$n < 0} {
1859         if {![eof $f]} return
1860     }
1861
1862     if {!([info exists diffmergeid] && $diffmergeid == $id)} {
1863         if {$n < 0} {
1864             close $f
1865         }
1866         return
1867     }
1868
1869     if {$diffinhunk($ids) != 0} {
1870         set fi $currentfile($ids)
1871         if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
1872             # continuing an existing hunk
1873             set line [string range $line 1 end]
1874             set p [lindex $ids 1]
1875             if {$match eq "-" || $match eq " "} {
1876                 set filelines($p,$fi,$diffoldlno($ids)) $line
1877                 incr diffoldlno($ids)
1878             }
1879             if {$match eq "+" || $match eq " "} {
1880                 set filelines($id,$fi,$diffnewlno($ids)) $line
1881                 incr diffnewlno($ids)
1882             }
1883             if {$match eq " "} {
1884                 if {$diffinhunk($ids) == 2} {
1885                     lappend difflcounts($ids) \
1886                         [list $noldlines($ids) $nnewlines($ids)]
1887                     set noldlines($ids) 0
1888                     set diffinhunk($ids) 1
1889                 }
1890                 incr noldlines($ids)
1891             } elseif {$match eq "-" || $match eq "+"} {
1892                 if {$diffinhunk($ids) == 1} {
1893                     lappend difflcounts($ids) [list $noldlines($ids)]
1894                     set noldlines($ids) 0
1895                     set nnewlines($ids) 0
1896                     set diffinhunk($ids) 2
1897                 }
1898                 if {$match eq "-"} {
1899                     incr noldlines($ids)
1900                 } else {
1901                     incr nnewlines($ids)
1902                 }
1903             }
1904             # and if it's \ No newline at end of line, then what?
1905             return
1906         }
1907         # end of a hunk
1908         if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
1909             lappend difflcounts($ids) [list $noldlines($ids)]
1910         } elseif {$diffinhunk($ids) == 2
1911                   && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
1912             lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
1913         }
1914         set currenthunk($ids) [list $currentfile($ids) \
1915                                    $diffoldstart($ids) $diffnewstart($ids) \
1916                                    $diffoldlno($ids) $diffnewlno($ids) \
1917                                    $difflcounts($ids)]
1918         set diffinhunk($ids) 0
1919         # -1 = need to block, 0 = unblocked, 1 = is blocked
1920         set diffblocked($ids) -1
1921         processhunks
1922         if {$diffblocked($ids) == -1} {
1923             fileevent $f readable {}
1924             set diffblocked($ids) 1
1925         }
1926     }
1927
1928     if {$n < 0} {
1929         # eof
1930         if {!$diffblocked($ids)} {
1931             close $f
1932             set currentfile($ids) [llength $mergefilelist($diffmergeid)]
1933             set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
1934             processhunks
1935         }
1936     } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
1937         # start of a new file
1938         set currentfile($ids) \
1939             [lsearch -exact $mergefilelist($diffmergeid) $fname]
1940     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1941                    $line match f1l f1c f2l f2c rest]} {
1942         if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
1943             # start of a new hunk
1944             if {$f1l == 0 && $f1c == 0} {
1945                 set f1l 1
1946             }
1947             if {$f2l == 0 && $f2c == 0} {
1948                 set f2l 1
1949             }
1950             set diffinhunk($ids) 1
1951             set diffoldstart($ids) $f1l
1952             set diffnewstart($ids) $f2l
1953             set diffoldlno($ids) $f1l
1954             set diffnewlno($ids) $f2l
1955             set difflcounts($ids) {}
1956             set noldlines($ids) 0
1957             set nnewlines($ids) 0
1958         }
1959     }
1960 }
1961
1962 proc processhunks {} {
1963     global diffmergeid parents nparents currenthunk
1964     global mergefilelist diffblocked mergefds
1965     global grouphunks grouplinestart grouplineend groupfilenum
1966
1967     set nfiles [llength $mergefilelist($diffmergeid)]
1968     while 1 {
1969         set fi $nfiles
1970         set lno 0
1971         # look for the earliest hunk
1972         foreach p $parents($diffmergeid) {
1973             set ids [list $diffmergeid $p]
1974             if {![info exists currenthunk($ids)]} return
1975             set i [lindex $currenthunk($ids) 0]
1976             set l [lindex $currenthunk($ids) 2]
1977             if {$i < $fi || ($i == $fi && $l < $lno)} {
1978                 set fi $i
1979                 set lno $l
1980                 set pi $p
1981             }
1982         }
1983
1984         if {$fi < $nfiles} {
1985             set ids [list $diffmergeid $pi]
1986             set hunk $currenthunk($ids)
1987             unset currenthunk($ids)
1988             if {$diffblocked($ids) > 0} {
1989                 fileevent $mergefds($ids) readable \
1990                     [list getmergediffline $mergefds($ids) $ids $diffmergeid]
1991             }
1992             set diffblocked($ids) 0
1993
1994             if {[info exists groupfilenum] && $groupfilenum == $fi
1995                 && $lno <= $grouplineend} {
1996                 # add this hunk to the pending group
1997                 lappend grouphunks($pi) $hunk
1998                 set endln [lindex $hunk 4]
1999                 if {$endln > $grouplineend} {
2000                     set grouplineend $endln
2001                 }
2002                 continue
2003             }
2004         }
2005
2006         # succeeding stuff doesn't belong in this group, so
2007         # process the group now
2008         if {[info exists groupfilenum]} {
2009             processgroup
2010             unset groupfilenum
2011             unset grouphunks
2012         }
2013
2014         if {$fi >= $nfiles} break
2015
2016         # start a new group
2017         set groupfilenum $fi
2018         set grouphunks($pi) [list $hunk]
2019         set grouplinestart $lno
2020         set grouplineend [lindex $hunk 4]
2021     }
2022 }
2023
2024 proc processgroup {} {
2025     global groupfilelast groupfilenum difffilestart
2026     global mergefilelist diffmergeid ctext filelines
2027     global parents diffmergeid diffoffset
2028     global grouphunks grouplinestart grouplineend nparents
2029     global mergemax
2030
2031     $ctext conf -state normal
2032     set id $diffmergeid
2033     set f $groupfilenum
2034     if {$groupfilelast != $f} {
2035         $ctext insert end "\n"
2036         set here [$ctext index "end - 1c"]
2037         set difffilestart($f) $here
2038         set mark fmark.[expr {$f + 1}]
2039         $ctext mark set $mark $here
2040         $ctext mark gravity $mark left
2041         set header [lindex $mergefilelist($id) $f]
2042         set l [expr {(78 - [string length $header]) / 2}]
2043         set pad [string range "----------------------------------------" 1 $l]
2044         $ctext insert end "$pad $header $pad\n" filesep
2045         set groupfilelast $f
2046         foreach p $parents($id) {
2047             set diffoffset($p) 0
2048         }
2049     }
2050
2051     $ctext insert end "@@" msep
2052     set nlines [expr {$grouplineend - $grouplinestart}]
2053     set events {}
2054     set pnum 0
2055     foreach p $parents($id) {
2056         set startline [expr {$grouplinestart + $diffoffset($p)}]
2057         set ol $startline
2058         set nl $grouplinestart
2059         if {[info exists grouphunks($p)]} {
2060             foreach h $grouphunks($p) {
2061                 set l [lindex $h 2]
2062                 if {$nl < $l} {
2063                     for {} {$nl < $l} {incr nl} {
2064                         set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2065                         incr ol
2066                     }
2067                 }
2068                 foreach chunk [lindex $h 5] {
2069                     if {[llength $chunk] == 2} {
2070                         set olc [lindex $chunk 0]
2071                         set nlc [lindex $chunk 1]
2072                         set nnl [expr {$nl + $nlc}]
2073                         lappend events [list $nl $nnl $pnum $olc $nlc]
2074                         incr ol $olc
2075                         set nl $nnl
2076                     } else {
2077                         incr ol [lindex $chunk 0]
2078                         incr nl [lindex $chunk 0]
2079                     }
2080                 }
2081             }
2082         }
2083         if {$nl < $grouplineend} {
2084             for {} {$nl < $grouplineend} {incr nl} {
2085                 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2086                 incr ol
2087             }
2088         }
2089         set nlines [expr {$ol - $startline}]
2090         $ctext insert end " -$startline,$nlines" msep
2091         incr pnum
2092     }
2093
2094     set nlines [expr {$grouplineend - $grouplinestart}]
2095     $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2096
2097     set events [lsort -integer -index 0 $events]
2098     set nevents [llength $events]
2099     set nmerge $nparents($diffmergeid)
2100     set l $grouplinestart
2101     for {set i 0} {$i < $nevents} {set i $j} {
2102         set nl [lindex $events $i 0]
2103         while {$l < $nl} {
2104             $ctext insert end " $filelines($id,$f,$l)\n"
2105             incr l
2106         }
2107         set e [lindex $events $i]
2108         set enl [lindex $e 1]
2109         set j $i
2110         set active {}
2111         while 1 {
2112             set pnum [lindex $e 2]
2113             set olc [lindex $e 3]
2114             set nlc [lindex $e 4]
2115             if {![info exists delta($pnum)]} {
2116                 set delta($pnum) [expr {$olc - $nlc}]
2117                 lappend active $pnum
2118             } else {
2119                 incr delta($pnum) [expr {$olc - $nlc}]
2120             }
2121             if {[incr j] >= $nevents} break
2122             set e [lindex $events $j]
2123             if {[lindex $e 0] >= $enl} break
2124             if {[lindex $e 1] > $enl} {
2125                 set enl [lindex $e 1]
2126             }
2127         }
2128         set nlc [expr {$enl - $l}]
2129         set ncol mresult
2130         set bestpn -1
2131         if {[llength $active] == $nmerge - 1} {
2132             # no diff for one of the parents, i.e. it's identical
2133             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2134                 if {![info exists delta($pnum)]} {
2135                     if {$pnum < $mergemax} {
2136                         lappend ncol m$pnum
2137                     } else {
2138                         lappend ncol mmax
2139                     }
2140                     break
2141                 }
2142             }
2143         } elseif {[llength $active] == $nmerge} {
2144             # all parents are different, see if one is very similar
2145             set bestsim 30
2146             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2147                 set sim [similarity $pnum $l $nlc $f \
2148                              [lrange $events $i [expr {$j-1}]]]
2149                 if {$sim > $bestsim} {
2150                     set bestsim $sim
2151                     set bestpn $pnum
2152                 }
2153             }
2154             if {$bestpn >= 0} {
2155                 lappend ncol m$bestpn
2156             }
2157         }
2158         set pnum -1
2159         foreach p $parents($id) {
2160             incr pnum
2161             if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2162             set olc [expr {$nlc + $delta($pnum)}]
2163             set ol [expr {$l + $diffoffset($p)}]
2164             incr diffoffset($p) $delta($pnum)
2165             unset delta($pnum)
2166             for {} {$olc > 0} {incr olc -1} {
2167                 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2168                 incr ol
2169             }
2170         }
2171         set endl [expr {$l + $nlc}]
2172         if {$bestpn >= 0} {
2173             # show this pretty much as a normal diff
2174             set p [lindex $parents($id) $bestpn]
2175             set ol [expr {$l + $diffoffset($p)}]
2176             incr diffoffset($p) $delta($bestpn)
2177             unset delta($bestpn)
2178             for {set k $i} {$k < $j} {incr k} {
2179                 set e [lindex $events $k]
2180                 if {[lindex $e 2] != $bestpn} continue
2181                 set nl [lindex $e 0]
2182                 set ol [expr {$ol + $nl - $l}]
2183                 for {} {$l < $nl} {incr l} {
2184                     $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2185                 }
2186                 set c [lindex $e 3]
2187                 for {} {$c > 0} {incr c -1} {
2188                     $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2189                     incr ol
2190                 }
2191                 set nl [lindex $e 1]
2192                 for {} {$l < $nl} {incr l} {
2193                     $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2194                 }
2195             }
2196         }
2197         for {} {$l < $endl} {incr l} {
2198             $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2199         }
2200     }
2201     while {$l < $grouplineend} {
2202         $ctext insert end " $filelines($id,$f,$l)\n"
2203         incr l
2204     }
2205     $ctext conf -state disabled
2206 }
2207
2208 proc similarity {pnum l nlc f events} {
2209     global diffmergeid parents diffoffset filelines
2210
2211     set id $diffmergeid
2212     set p [lindex $parents($id) $pnum]
2213     set ol [expr {$l + $diffoffset($p)}]
2214     set endl [expr {$l + $nlc}]
2215     set same 0
2216     set diff 0
2217     foreach e $events {
2218         if {[lindex $e 2] != $pnum} continue
2219         set nl [lindex $e 0]
2220         set ol [expr {$ol + $nl - $l}]
2221         for {} {$l < $nl} {incr l} {
2222             incr same [string length $filelines($id,$f,$l)]
2223             incr same
2224         }
2225         set oc [lindex $e 3]
2226         for {} {$oc > 0} {incr oc -1} {
2227             incr diff [string length $filelines($p,$f,$ol)]
2228             incr diff
2229             incr ol
2230         }
2231         set nl [lindex $e 1]
2232         for {} {$l < $nl} {incr l} {
2233             incr diff [string length $filelines($id,$f,$l)]
2234             incr diff
2235         }
2236     }
2237     for {} {$l < $endl} {incr l} {
2238         incr same [string length $filelines($id,$f,$l)]
2239         incr same
2240     }
2241     if {$same == 0} {
2242         return 0
2243     }
2244     return [expr {200 * $same / (2 * $same + $diff)}]
2245 }
2246
2247 proc startdiff {ids} {
2248     global treediffs diffids treepending diffmergeid
2249
2250     set diffids $ids
2251     catch {unset diffmergeid}
2252     if {![info exists treediffs($ids)]} {
2253         if {![info exists treepending]} {
2254             gettreediffs $ids
2255         }
2256     } else {
2257         addtocflist $ids
2258     }
2259 }
2260
2261 proc addtocflist {ids} {
2262     global treediffs cflist
2263     foreach f $treediffs($ids) {
2264         $cflist insert end $f
2265     }
2266     getblobdiffs $ids
2267 }
2268
2269 proc gettreediffs {ids} {
2270     global treediff parents treepending
2271     set treepending $ids
2272     set treediff {}
2273     set id [lindex $ids 0]
2274     set p [lindex $ids 1]
2275     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
2276     fconfigure $gdtf -blocking 0
2277     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2278 }
2279
2280 proc gettreediffline {gdtf ids} {
2281     global treediff treediffs treepending diffids diffmergeid
2282
2283     set n [gets $gdtf line]
2284     if {$n < 0} {
2285         if {![eof $gdtf]} return
2286         close $gdtf
2287         set treediffs($ids) $treediff
2288         unset treepending
2289         if {$ids != $diffids} {
2290             gettreediffs $diffids
2291         } else {
2292             if {[info exists diffmergeid]} {
2293                 contmergediff $ids
2294             } else {
2295                 addtocflist $ids
2296             }
2297         }
2298         return
2299     }
2300     set file [lindex $line 5]
2301     lappend treediff $file
2302 }
2303
2304 proc getblobdiffs {ids} {
2305     global diffopts blobdifffd diffids env curdifftag curtagstart
2306     global difffilestart nextupdate diffinhdr treediffs
2307
2308     set id [lindex $ids 0]
2309     set p [lindex $ids 1]
2310     set env(GIT_DIFF_OPTS) $diffopts
2311     set cmd [list | git-diff-tree -r -p -C $p $id]
2312     if {[catch {set bdf [open $cmd r]} err]} {
2313         puts "error getting diffs: $err"
2314         return
2315     }
2316     set diffinhdr 0
2317     fconfigure $bdf -blocking 0
2318     set blobdifffd($ids) $bdf
2319     set curdifftag Comments
2320     set curtagstart 0.0
2321     catch {unset difffilestart}
2322     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2323     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2324 }
2325
2326 proc getblobdiffline {bdf ids} {
2327     global diffids blobdifffd ctext curdifftag curtagstart
2328     global diffnexthead diffnextnote difffilestart
2329     global nextupdate diffinhdr treediffs
2330     global gaudydiff
2331
2332     set n [gets $bdf line]
2333     if {$n < 0} {
2334         if {[eof $bdf]} {
2335             close $bdf
2336             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2337                 $ctext tag add $curdifftag $curtagstart end
2338             }
2339         }
2340         return
2341     }
2342     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2343         return
2344     }
2345     $ctext conf -state normal
2346     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2347         # start of a new file
2348         $ctext insert end "\n"
2349         $ctext tag add $curdifftag $curtagstart end
2350         set curtagstart [$ctext index "end - 1c"]
2351         set header $newname
2352         set here [$ctext index "end - 1c"]
2353         set i [lsearch -exact $treediffs($diffids) $fname]
2354         if {$i >= 0} {
2355             set difffilestart($i) $here
2356             incr i
2357             $ctext mark set fmark.$i $here
2358             $ctext mark gravity fmark.$i left
2359         }
2360         if {$newname != $fname} {
2361             set i [lsearch -exact $treediffs($diffids) $newname]
2362             if {$i >= 0} {
2363                 set difffilestart($i) $here
2364                 incr i
2365                 $ctext mark set fmark.$i $here
2366                 $ctext mark gravity fmark.$i left
2367             }
2368         }
2369         set curdifftag "f:$fname"
2370         $ctext tag delete $curdifftag
2371         set l [expr {(78 - [string length $header]) / 2}]
2372         set pad [string range "----------------------------------------" 1 $l]
2373         $ctext insert end "$pad $header $pad\n" filesep
2374         set diffinhdr 1
2375     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2376         set diffinhdr 0
2377     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2378                    $line match f1l f1c f2l f2c rest]} {
2379         if {$gaudydiff} {
2380             $ctext insert end "\t" hunksep
2381             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
2382             $ctext insert end "    $rest \n" hunksep
2383         } else {
2384             $ctext insert end "$line\n" hunksep
2385         }
2386         set diffinhdr 0
2387     } else {
2388         set x [string range $line 0 0]
2389         if {$x == "-" || $x == "+"} {
2390             set tag [expr {$x == "+"}]
2391             if {$gaudydiff} {
2392                 set line [string range $line 1 end]
2393             }
2394             $ctext insert end "$line\n" d$tag
2395         } elseif {$x == " "} {
2396             if {$gaudydiff} {
2397                 set line [string range $line 1 end]
2398             }
2399             $ctext insert end "$line\n"
2400         } elseif {$diffinhdr || $x == "\\"} {
2401             # e.g. "\ No newline at end of file"
2402             $ctext insert end "$line\n" filesep
2403         } else {
2404             # Something else we don't recognize
2405             if {$curdifftag != "Comments"} {
2406                 $ctext insert end "\n"
2407                 $ctext tag add $curdifftag $curtagstart end
2408                 set curtagstart [$ctext index "end - 1c"]
2409                 set curdifftag Comments
2410             }
2411             $ctext insert end "$line\n" filesep
2412         }
2413     }
2414     $ctext conf -state disabled
2415     if {[clock clicks -milliseconds] >= $nextupdate} {
2416         incr nextupdate 100
2417         fileevent $bdf readable {}
2418         update
2419         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2420     }
2421 }
2422
2423 proc nextfile {} {
2424     global difffilestart ctext
2425     set here [$ctext index @0,0]
2426     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2427         if {[$ctext compare $difffilestart($i) > $here]} {
2428             if {![info exists pos]
2429                 || [$ctext compare $difffilestart($i) < $pos]} {
2430                 set pos $difffilestart($i)
2431             }
2432         }
2433     }
2434     if {[info exists pos]} {
2435         $ctext yview $pos
2436     }
2437 }
2438
2439 proc listboxsel {} {
2440     global ctext cflist currentid
2441     if {![info exists currentid]} return
2442     set sel [lsort [$cflist curselection]]
2443     if {$sel eq {}} return
2444     set first [lindex $sel 0]
2445     catch {$ctext yview fmark.$first}
2446 }
2447
2448 proc setcoords {} {
2449     global linespc charspc canvx0 canvy0 mainfont
2450     set linespc [font metrics $mainfont -linespace]
2451     set charspc [font measure $mainfont "m"]
2452     set canvy0 [expr 3 + 0.5 * $linespc]
2453     set canvx0 [expr 3 + 0.5 * $linespc]
2454 }
2455
2456 proc redisplay {} {
2457     global selectedline stopped redisplaying phase
2458     if {$stopped > 1} return
2459     if {$phase == "getcommits"} return
2460     set redisplaying 1
2461     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2462         set stopped 1
2463     } else {
2464         drawgraph
2465     }
2466 }
2467
2468 proc incrfont {inc} {
2469     global mainfont namefont textfont selectedline ctext canv phase
2470     global stopped entries
2471     unmarkmatches
2472     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2473     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2474     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2475     setcoords
2476     $ctext conf -font $textfont
2477     $ctext tag conf filesep -font [concat $textfont bold]
2478     foreach e $entries {
2479         $e conf -font $mainfont
2480     }
2481     if {$phase == "getcommits"} {
2482         $canv itemconf textitems -font $mainfont
2483     }
2484     redisplay
2485 }
2486
2487 proc clearsha1 {} {
2488     global sha1entry sha1string
2489     if {[string length $sha1string] == 40} {
2490         $sha1entry delete 0 end
2491     }
2492 }
2493
2494 proc sha1change {n1 n2 op} {
2495     global sha1string currentid sha1but
2496     if {$sha1string == {}
2497         || ([info exists currentid] && $sha1string == $currentid)} {
2498         set state disabled
2499     } else {
2500         set state normal
2501     }
2502     if {[$sha1but cget -state] == $state} return
2503     if {$state == "normal"} {
2504         $sha1but conf -state normal -relief raised -text "Goto: "
2505     } else {
2506         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2507     }
2508 }
2509
2510 proc gotocommit {} {
2511     global sha1string currentid idline tagids
2512     global lineid numcommits
2513
2514     if {$sha1string == {}
2515         || ([info exists currentid] && $sha1string == $currentid)} return
2516     if {[info exists tagids($sha1string)]} {
2517         set id $tagids($sha1string)
2518     } else {
2519         set id [string tolower $sha1string]
2520         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2521             set matches {}
2522             for {set l 0} {$l < $numcommits} {incr l} {
2523                 if {[string match $id* $lineid($l)]} {
2524                     lappend matches $lineid($l)
2525                 }
2526             }
2527             if {$matches ne {}} {
2528                 if {[llength $matches] > 1} {
2529                     error_popup "Short SHA1 id $id is ambiguous"
2530                     return
2531                 }
2532                 set id [lindex $matches 0]
2533             }
2534         }
2535     }
2536     if {[info exists idline($id)]} {
2537         selectline $idline($id)
2538         return
2539     }
2540     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2541         set type "SHA1 id"
2542     } else {
2543         set type "Tag"
2544     }
2545     error_popup "$type $sha1string is not known"
2546 }
2547
2548 proc lineenter {x y id} {
2549     global hoverx hovery hoverid hovertimer
2550     global commitinfo canv
2551
2552     if {![info exists commitinfo($id)]} return
2553     set hoverx $x
2554     set hovery $y
2555     set hoverid $id
2556     if {[info exists hovertimer]} {
2557         after cancel $hovertimer
2558     }
2559     set hovertimer [after 500 linehover]
2560     $canv delete hover
2561 }
2562
2563 proc linemotion {x y id} {
2564     global hoverx hovery hoverid hovertimer
2565
2566     if {[info exists hoverid] && $id == $hoverid} {
2567         set hoverx $x
2568         set hovery $y
2569         if {[info exists hovertimer]} {
2570             after cancel $hovertimer
2571         }
2572         set hovertimer [after 500 linehover]
2573     }
2574 }
2575
2576 proc lineleave {id} {
2577     global hoverid hovertimer canv
2578
2579     if {[info exists hoverid] && $id == $hoverid} {
2580         $canv delete hover
2581         if {[info exists hovertimer]} {
2582             after cancel $hovertimer
2583             unset hovertimer
2584         }
2585         unset hoverid
2586     }
2587 }
2588
2589 proc linehover {} {
2590     global hoverx hovery hoverid hovertimer
2591     global canv linespc lthickness
2592     global commitinfo mainfont
2593
2594     set text [lindex $commitinfo($hoverid) 0]
2595     set ymax [lindex [$canv cget -scrollregion] 3]
2596     if {$ymax == {}} return
2597     set yfrac [lindex [$canv yview] 0]
2598     set x [expr {$hoverx + 2 * $linespc}]
2599     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2600     set x0 [expr {$x - 2 * $lthickness}]
2601     set y0 [expr {$y - 2 * $lthickness}]
2602     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2603     set y1 [expr {$y + $linespc + 2 * $lthickness}]
2604     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2605                -fill \#ffff80 -outline black -width 1 -tags hover]
2606     $canv raise $t
2607     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2608     $canv raise $t
2609 }
2610
2611 proc lineclick {x y id} {
2612     global ctext commitinfo children cflist canv
2613
2614     unmarkmatches
2615     $canv delete hover
2616     # fill the details pane with info about this line
2617     $ctext conf -state normal
2618     $ctext delete 0.0 end
2619     $ctext insert end "Parent:\n "
2620     catch {destroy $ctext.$id}
2621     button $ctext.$id -text "Go:" -command "selbyid $id" \
2622         -padx 4 -pady 0
2623     $ctext window create end -window $ctext.$id -align center
2624     set info $commitinfo($id)
2625     $ctext insert end "\t[lindex $info 0]\n"
2626     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2627     $ctext insert end "\tDate:\t[lindex $info 2]\n"
2628     $ctext insert end "\tID:\t$id\n"
2629     if {[info exists children($id)]} {
2630         $ctext insert end "\nChildren:"
2631         foreach child $children($id) {
2632             $ctext insert end "\n "
2633             catch {destroy $ctext.$child}
2634             button $ctext.$child -text "Go:" -command "selbyid $child" \
2635                 -padx 4 -pady 0
2636             $ctext window create end -window $ctext.$child -align center
2637             set info $commitinfo($child)
2638             $ctext insert end "\t[lindex $info 0]"
2639         }
2640     }
2641     $ctext conf -state disabled
2642
2643     $cflist delete 0 end
2644 }
2645
2646 proc selbyid {id} {
2647     global idline
2648     if {[info exists idline($id)]} {
2649         selectline $idline($id)
2650     }
2651 }
2652
2653 proc mstime {} {
2654     global startmstime
2655     if {![info exists startmstime]} {
2656         set startmstime [clock clicks -milliseconds]
2657     }
2658     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2659 }
2660
2661 proc rowmenu {x y id} {
2662     global rowctxmenu idline selectedline rowmenuid
2663
2664     if {![info exists selectedline] || $idline($id) eq $selectedline} {
2665         set state disabled
2666     } else {
2667         set state normal
2668     }
2669     $rowctxmenu entryconfigure 0 -state $state
2670     $rowctxmenu entryconfigure 1 -state $state
2671     $rowctxmenu entryconfigure 2 -state $state
2672     set rowmenuid $id
2673     tk_popup $rowctxmenu $x $y
2674 }
2675
2676 proc diffvssel {dirn} {
2677     global rowmenuid selectedline lineid
2678     global ctext cflist
2679     global commitinfo
2680
2681     if {![info exists selectedline]} return
2682     if {$dirn} {
2683         set oldid $lineid($selectedline)
2684         set newid $rowmenuid
2685     } else {
2686         set oldid $rowmenuid
2687         set newid $lineid($selectedline)
2688     }
2689     $ctext conf -state normal
2690     $ctext delete 0.0 end
2691     $ctext mark set fmark.0 0.0
2692     $ctext mark gravity fmark.0 left
2693     $cflist delete 0 end
2694     $cflist insert end "Top"
2695     $ctext insert end "From $oldid\n     "
2696     $ctext insert end [lindex $commitinfo($oldid) 0]
2697     $ctext insert end "\n\nTo   $newid\n     "
2698     $ctext insert end [lindex $commitinfo($newid) 0]
2699     $ctext insert end "\n"
2700     $ctext conf -state disabled
2701     $ctext tag delete Comments
2702     $ctext tag remove found 1.0 end
2703     startdiff $newid [list $oldid]
2704 }
2705
2706 proc mkpatch {} {
2707     global rowmenuid currentid commitinfo patchtop patchnum
2708
2709     if {![info exists currentid]} return
2710     set oldid $currentid
2711     set oldhead [lindex $commitinfo($oldid) 0]
2712     set newid $rowmenuid
2713     set newhead [lindex $commitinfo($newid) 0]
2714     set top .patch
2715     set patchtop $top
2716     catch {destroy $top}
2717     toplevel $top
2718     label $top.title -text "Generate patch"
2719     grid $top.title - -pady 10
2720     label $top.from -text "From:"
2721     entry $top.fromsha1 -width 40 -relief flat
2722     $top.fromsha1 insert 0 $oldid
2723     $top.fromsha1 conf -state readonly
2724     grid $top.from $top.fromsha1 -sticky w
2725     entry $top.fromhead -width 60 -relief flat
2726     $top.fromhead insert 0 $oldhead
2727     $top.fromhead conf -state readonly
2728     grid x $top.fromhead -sticky w
2729     label $top.to -text "To:"
2730     entry $top.tosha1 -width 40 -relief flat
2731     $top.tosha1 insert 0 $newid
2732     $top.tosha1 conf -state readonly
2733     grid $top.to $top.tosha1 -sticky w
2734     entry $top.tohead -width 60 -relief flat
2735     $top.tohead insert 0 $newhead
2736     $top.tohead conf -state readonly
2737     grid x $top.tohead -sticky w
2738     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2739     grid $top.rev x -pady 10
2740     label $top.flab -text "Output file:"
2741     entry $top.fname -width 60
2742     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2743     incr patchnum
2744     grid $top.flab $top.fname -sticky w
2745     frame $top.buts
2746     button $top.buts.gen -text "Generate" -command mkpatchgo
2747     button $top.buts.can -text "Cancel" -command mkpatchcan
2748     grid $top.buts.gen $top.buts.can
2749     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2750     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2751     grid $top.buts - -pady 10 -sticky ew
2752     focus $top.fname
2753 }
2754
2755 proc mkpatchrev {} {
2756     global patchtop
2757
2758     set oldid [$patchtop.fromsha1 get]
2759     set oldhead [$patchtop.fromhead get]
2760     set newid [$patchtop.tosha1 get]
2761     set newhead [$patchtop.tohead get]
2762     foreach e [list fromsha1 fromhead tosha1 tohead] \
2763             v [list $newid $newhead $oldid $oldhead] {
2764         $patchtop.$e conf -state normal
2765         $patchtop.$e delete 0 end
2766         $patchtop.$e insert 0 $v
2767         $patchtop.$e conf -state readonly
2768     }
2769 }
2770
2771 proc mkpatchgo {} {
2772     global patchtop
2773
2774     set oldid [$patchtop.fromsha1 get]
2775     set newid [$patchtop.tosha1 get]
2776     set fname [$patchtop.fname get]
2777     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
2778         error_popup "Error creating patch: $err"
2779     }
2780     catch {destroy $patchtop}
2781     unset patchtop
2782 }
2783
2784 proc mkpatchcan {} {
2785     global patchtop
2786
2787     catch {destroy $patchtop}
2788     unset patchtop
2789 }
2790
2791 proc mktag {} {
2792     global rowmenuid mktagtop commitinfo
2793
2794     set top .maketag
2795     set mktagtop $top
2796     catch {destroy $top}
2797     toplevel $top
2798     label $top.title -text "Create tag"
2799     grid $top.title - -pady 10
2800     label $top.id -text "ID:"
2801     entry $top.sha1 -width 40 -relief flat
2802     $top.sha1 insert 0 $rowmenuid
2803     $top.sha1 conf -state readonly
2804     grid $top.id $top.sha1 -sticky w
2805     entry $top.head -width 60 -relief flat
2806     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2807     $top.head conf -state readonly
2808     grid x $top.head -sticky w
2809     label $top.tlab -text "Tag name:"
2810     entry $top.tag -width 60
2811     grid $top.tlab $top.tag -sticky w
2812     frame $top.buts
2813     button $top.buts.gen -text "Create" -command mktaggo
2814     button $top.buts.can -text "Cancel" -command mktagcan
2815     grid $top.buts.gen $top.buts.can
2816     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2817     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2818     grid $top.buts - -pady 10 -sticky ew
2819     focus $top.tag
2820 }
2821
2822 proc domktag {} {
2823     global mktagtop env tagids idtags
2824     global idpos idline linehtag canv selectedline
2825
2826     set id [$mktagtop.sha1 get]
2827     set tag [$mktagtop.tag get]
2828     if {$tag == {}} {
2829         error_popup "No tag name specified"
2830         return
2831     }
2832     if {[info exists tagids($tag)]} {
2833         error_popup "Tag \"$tag\" already exists"
2834         return
2835     }
2836     if {[catch {
2837         set dir [gitdir]
2838         set fname [file join $dir "refs/tags" $tag]
2839         set f [open $fname w]
2840         puts $f $id
2841         close $f
2842     } err]} {
2843         error_popup "Error creating tag: $err"
2844         return
2845     }
2846
2847     set tagids($tag) $id
2848     lappend idtags($id) $tag
2849     $canv delete tag.$id
2850     set xt [eval drawtags $id $idpos($id)]
2851     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
2852     if {[info exists selectedline] && $selectedline == $idline($id)} {
2853         selectline $selectedline
2854     }
2855 }
2856
2857 proc mktagcan {} {
2858     global mktagtop
2859
2860     catch {destroy $mktagtop}
2861     unset mktagtop
2862 }
2863
2864 proc mktaggo {} {
2865     domktag
2866     mktagcan
2867 }
2868
2869 proc writecommit {} {
2870     global rowmenuid wrcomtop commitinfo wrcomcmd
2871
2872     set top .writecommit
2873     set wrcomtop $top
2874     catch {destroy $top}
2875     toplevel $top
2876     label $top.title -text "Write commit to file"
2877     grid $top.title - -pady 10
2878     label $top.id -text "ID:"
2879     entry $top.sha1 -width 40 -relief flat
2880     $top.sha1 insert 0 $rowmenuid
2881     $top.sha1 conf -state readonly
2882     grid $top.id $top.sha1 -sticky w
2883     entry $top.head -width 60 -relief flat
2884     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2885     $top.head conf -state readonly
2886     grid x $top.head -sticky w
2887     label $top.clab -text "Command:"
2888     entry $top.cmd -width 60 -textvariable wrcomcmd
2889     grid $top.clab $top.cmd -sticky w -pady 10
2890     label $top.flab -text "Output file:"
2891     entry $top.fname -width 60
2892     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
2893     grid $top.flab $top.fname -sticky w
2894     frame $top.buts
2895     button $top.buts.gen -text "Write" -command wrcomgo
2896     button $top.buts.can -text "Cancel" -command wrcomcan
2897     grid $top.buts.gen $top.buts.can
2898     grid columnconfigure $top.buts 0 -weight 1 -uniform a
2899     grid columnconfigure $top.buts 1 -weight 1 -uniform a
2900     grid $top.buts - -pady 10 -sticky ew
2901     focus $top.fname
2902 }
2903
2904 proc wrcomgo {} {
2905     global wrcomtop
2906
2907     set id [$wrcomtop.sha1 get]
2908     set cmd "echo $id | [$wrcomtop.cmd get]"
2909     set fname [$wrcomtop.fname get]
2910     if {[catch {exec sh -c $cmd >$fname &} err]} {
2911         error_popup "Error writing commit: $err"
2912     }
2913     catch {destroy $wrcomtop}
2914     unset wrcomtop
2915 }
2916
2917 proc wrcomcan {} {
2918     global wrcomtop
2919
2920     catch {destroy $wrcomtop}
2921     unset wrcomtop
2922 }
2923
2924 proc doquit {} {
2925     global stopped
2926     set stopped 100
2927     destroy .
2928 }
2929
2930 # defaults...
2931 set datemode 0
2932 set boldnames 0
2933 set diffopts "-U 5 -p"
2934 set wrcomcmd "git-diff-tree --stdin -p --pretty"
2935
2936 set mainfont {Helvetica 9}
2937 set textfont {Courier 9}
2938 set findmergefiles 0
2939 set gaudydiff 0
2940
2941 set colors {green red blue magenta darkgrey brown orange}
2942
2943 catch {source ~/.gitk}
2944
2945 set namefont $mainfont
2946 if {$boldnames} {
2947     lappend namefont bold
2948 }
2949
2950 set revtreeargs {}
2951 foreach arg $argv {
2952     switch -regexp -- $arg {
2953         "^$" { }
2954         "^-b" { set boldnames 1 }
2955         "^-d" { set datemode 1 }
2956         default {
2957             lappend revtreeargs $arg
2958         }
2959     }
2960 }
2961
2962 set stopped 0
2963 set redisplaying 0
2964 set stuffsaved 0
2965 set patchnum 0
2966 setcoords
2967 makewindow
2968 readrefs
2969 getcommits $revtreeargs