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