gitk

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