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