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