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