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