gitk

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