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 # CVS $Revision: 1.24 $
  11
  12 proc getcommits {rargs} {
  13     global commits commfd phase canv mainfont
  14     global startmsecs nextupdate
  15     global ctext maincursor textcursor leftover
  16
  17     set commits {}
  18     set phase getcommits
  19     set startmsecs [clock clicks -milliseconds]
  20     set nextupdate [expr $startmsecs + 100]
  21     if [catch {
  22         set parse_args [concat --default HEAD $rargs]
  23         set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
  24     }] {
  25         # if git-rev-parse failed for some reason...
  26         if {$rargs == {}} {
  27             set rargs HEAD
  28         }
  29         set parsed_args $rargs
  30     }
  31     if [catch {
  32         set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]
  33     } err] {
  34         puts stderr "Error executing git-rev-list: $err"
  35         exit 1
  36     }
  37     set leftover {}
  38     fconfigure $commfd -blocking 0 -translation binary
  39     fileevent $commfd readable "getcommitlines $commfd"
  40     $canv delete all
  41     $canv create text 3 3 -anchor nw -text "Reading commits..." \
  42         -font $mainfont -tags textitems
  43     . config -cursor watch
  44     $ctext config -cursor watch
  45 }
  46
  47 proc getcommitlines {commfd}  {
  48     global commits parents cdate children nchildren
  49     global commitlisted phase commitinfo nextupdate
  50     global stopped redisplaying leftover
  51
  52     set stuff [read $commfd]
  53     if {$stuff == {}} {
  54         if {![eof $commfd]} return
  55         # this works around what is apparently a bug in Tcl...
  56         fconfigure $commfd -blocking 1
  57         if {![catch {close $commfd} err]} {
  58             after idle finishcommits
  59             return
  60         }
  61         if {[string range $err 0 4] == "usage"} {
  62             set err \
  63 {Gitk: error reading commits: bad arguments to git-rev-list.
  64 (Note: arguments to gitk are passed to git-rev-list
  65 to allow selection of commits to be displayed.)}
  66         } else {
  67             set err "Error reading commits: $err"
  68         }
  69         error_popup $err
  70         exit 1
  71     }
  72     set start 0
  73     while 1 {
  74         set i [string first "\0" $stuff $start]
  75         if {$i < 0} {
  76             set leftover [string range $stuff $start end]
  77             return
  78         }
  79         set cmit [string range $stuff $start [expr {$i - 1}]]
  80         if {$start == 0} {
  81             set cmit "$leftover$cmit"
  82         }
  83         set start [expr {$i + 1}]
  84         if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
  85             error_popup "Can't parse git-rev-list output: {$cmit}"
  86             exit 1
  87         }
  88         set cmit [string range $cmit 41 end]
  89         lappend commits $id
  90         set commitlisted($id) 1
  91         parsecommit $id $cmit 1
  92         drawcommit $id
  93         if {[clock clicks -milliseconds] >= $nextupdate} {
  94             doupdate
  95         }
  96         while {$redisplaying} {
  97             set redisplaying 0
  98             if {$stopped == 1} {
  99                 set stopped 0
 100                 set phase "getcommits"
 101                 foreach id $commits {
 102                     drawcommit $id
 103                     if {$stopped} break
 104                     if {[clock clicks -milliseconds] >= $nextupdate} {
 105                         doupdate
 106                     }
 107                 }
 108             }
 109         }
 110     }
 111 }
 112
 113 proc doupdate {} {
 114     global commfd nextupdate
 115
 116     incr nextupdate 100
 117     fileevent $commfd readable {}
 118     update
 119     fileevent $commfd readable "getcommitlines $commfd"
 120 }
 121
 122 proc readcommit {id} {
 123     if [catch {set contents [exec git-cat-file commit $id]}] return
 124     parsecommit $id $contents 0
 125 }
 126
 127 proc parsecommit {id contents listed} {
 128     global commitinfo children nchildren parents nparents cdate ncleft
 129
 130     set inhdr 1
 131     set comment {}
 132     set headline {}
 133     set auname {}
 134     set audate {}
 135     set comname {}
 136     set comdate {}
 137     if {![info exists nchildren($id)]} {
 138         set children($id) {}
 139         set nchildren($id) 0
 140         set ncleft($id) 0
 141     }
 142     set parents($id) {}
 143     set nparents($id) 0
 144     foreach line [split $contents "\n"] {
 145         if {$inhdr} {
 146             if {$line == {}} {
 147                 set inhdr 0
 148             } else {
 149                 set tag [lindex $line 0]
 150                 if {$tag == "parent"} {
 151                     set p [lindex $line 1]
 152                     if {![info exists nchildren($p)]} {
 153                         set children($p) {}
 154                         set nchildren($p) 0
 155                         set ncleft($p) 0
 156                     }
 157                     lappend parents($id) $p
 158                     incr nparents($id)
 159                     # sometimes we get a commit that lists a parent twice...
 160                     if {$listed && [lsearch -exact $children($p) $id] < 0} {
 161                         lappend children($p) $id
 162                         incr nchildren($p)
 163                         incr ncleft($p)
 164                     }
 165                 } elseif {$tag == "author"} {
 166                     set x [expr {[llength $line] - 2}]
 167                     set audate [lindex $line $x]
 168                     set auname [lrange $line 1 [expr {$x - 1}]]
 169                 } elseif {$tag == "committer"} {
 170                     set x [expr {[llength $line] - 2}]
 171                     set comdate [lindex $line $x]
 172                     set comname [lrange $line 1 [expr {$x - 1}]]
 173                 }
 174             }
 175         } else {
 176             if {$comment == {}} {
 177                 set headline [string trim $line]
 178             } else {
 179                 append comment "\n"
 180             }
 181             if {!$listed} {
 182                 # git-rev-list indents the comment by 4 spaces;
 183                 # if we got this via git-cat-file, add the indentation
 184                 append comment "    "
 185             }
 186             append comment $line
 187         }
 188     }
 189     if {$audate != {}} {
 190         set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 191     }
 192     if {$comdate != {}} {
 193         set cdate($id) $comdate
 194         set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 195     }
 196     set commitinfo($id) [list $headline $auname $audate \
 197                              $comname $comdate $comment]
 198 }
 199
 200 proc readrefs {} {
 201     global tagids idtags headids idheads
 202     set tags [glob -nocomplain -types f .git/refs/tags/*]
 203     foreach f $tags {
 204         catch {
 205             set fd [open $f r]
 206             set line [read $fd]
 207             if {[regexp {^[0-9a-f]{40}} $line id]} {
 208                 set direct [file tail $f]
 209                 set tagids($direct) $id
 210                 lappend idtags($id) $direct
 211                 set contents [split [exec git-cat-file tag $id] "\n"]
 212                 set obj {}
 213                 set type {}
 214                 set tag {}
 215                 foreach l $contents {
 216                     if {$l == {}} break
 217                     switch -- [lindex $l 0] {
 218                         "object" {set obj [lindex $l 1]}
 219                         "type" {set type [lindex $l 1]}
 220                         "tag" {set tag [string range $l 4 end]}
 221                     }
 222                 }
 223                 if {$obj != {} && $type == "commit" && $tag != {}} {
 224                     set tagids($tag) $obj
 225                     lappend idtags($obj) $tag
 226                 }
 227             }
 228             close $fd
 229         }
 230     }
 231     set heads [glob -nocomplain -types f .git/refs/heads/*]
 232     foreach f $heads {
 233         catch {
 234             set fd [open $f r]
 235             set line [read $fd 40]
 236             if {[regexp {^[0-9a-f]{40}} $line id]} {
 237                 set head [file tail $f]
 238                 set headids($head) $line
 239                 lappend idheads($line) $head
 240             }
 241             close $fd
 242         }
 243     }
 244 }
 245
 246 proc error_popup msg {
 247     set w .error
 248     toplevel $w
 249     wm transient $w .
 250     message $w.m -text $msg -justify center -aspect 400
 251     pack $w.m -side top -fill x -padx 20 -pady 20
 252     button $w.ok -text OK -command "destroy $w"
 253     pack $w.ok -side bottom -fill x
 254     bind $w <Visibility> "grab $w; focus $w"
 255     tkwait window $w
 256 }
 257
 258 proc makewindow {} {
 259     global canv canv2 canv3 linespc charspc ctext cflist textfont
 260     global findtype findloc findstring fstring geometry
 261     global entries sha1entry sha1string sha1but
 262     global maincursor textcursor
 263     global linectxmenu
 264
 265     menu .bar
 266     .bar add cascade -label "File" -menu .bar.file
 267     menu .bar.file
 268     .bar.file add command -label "Quit" -command doquit
 269     menu .bar.help
 270     .bar add cascade -label "Help" -menu .bar.help
 271     .bar.help add command -label "About gitk" -command about
 272     . configure -menu .bar
 273
 274     if {![info exists geometry(canv1)]} {
 275         set geometry(canv1) [expr 45 * $charspc]
 276         set geometry(canv2) [expr 30 * $charspc]
 277         set geometry(canv3) [expr 15 * $charspc]
 278         set geometry(canvh) [expr 25 * $linespc + 4]
 279         set geometry(ctextw) 80
 280         set geometry(ctexth) 30
 281         set geometry(cflistw) 30
 282     }
 283     panedwindow .ctop -orient vertical
 284     if {[info exists geometry(width)]} {
 285         .ctop conf -width $geometry(width) -height $geometry(height)
 286         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 287         set geometry(ctexth) [expr {($texth - 8) /
 288                                     [font metrics $textfont -linespace]}]
 289     }
 290     frame .ctop.top
 291     frame .ctop.top.bar
 292     pack .ctop.top.bar -side bottom -fill x
 293     set cscroll .ctop.top.csb
 294     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 295     pack $cscroll -side right -fill y
 296     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 297     pack .ctop.top.clist -side top -fill both -expand 1
 298     .ctop add .ctop.top
 299     set canv .ctop.top.clist.canv
 300     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 301         -bg white -bd 0 \
 302         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 303     .ctop.top.clist add $canv
 304     set canv2 .ctop.top.clist.canv2
 305     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 306         -bg white -bd 0 -yscrollincr $linespc
 307     .ctop.top.clist add $canv2
 308     set canv3 .ctop.top.clist.canv3
 309     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 310         -bg white -bd 0 -yscrollincr $linespc
 311     .ctop.top.clist add $canv3
 312     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 313
 314     set sha1entry .ctop.top.bar.sha1
 315     set entries $sha1entry
 316     set sha1but .ctop.top.bar.sha1label
 317     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 318         -command gotocommit -width 8
 319     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 320     pack .ctop.top.bar.sha1label -side left
 321     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 322     trace add variable sha1string write sha1change
 323     pack $sha1entry -side left -pady 2
 324     button .ctop.top.bar.findbut -text "Find" -command dofind
 325     pack .ctop.top.bar.findbut -side left
 326     set findstring {}
 327     set fstring .ctop.top.bar.findstring
 328     lappend entries $fstring
 329     entry $fstring -width 30 -font $textfont -textvariable findstring
 330     pack $fstring -side left -expand 1 -fill x
 331     set findtype Exact
 332     tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
 333     set findloc "All fields"
 334     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 335         Comments Author Committer
 336     pack .ctop.top.bar.findloc -side right
 337     pack .ctop.top.bar.findtype -side right
 338
 339     panedwindow .ctop.cdet -orient horizontal
 340     .ctop add .ctop.cdet
 341     frame .ctop.cdet.left
 342     set ctext .ctop.cdet.left.ctext
 343     text $ctext -bg white -state disabled -font $textfont \
 344         -width $geometry(ctextw) -height $geometry(ctexth) \
 345         -yscrollcommand ".ctop.cdet.left.sb set"
 346     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 347     pack .ctop.cdet.left.sb -side right -fill y
 348     pack $ctext -side left -fill both -expand 1
 349     .ctop.cdet add .ctop.cdet.left
 350
 351     $ctext tag conf filesep -font [concat $textfont bold]
 352     $ctext tag conf hunksep -back blue -fore white
 353     $ctext tag conf d0 -back "#ff8080"
 354     $ctext tag conf d1 -back green
 355     $ctext tag conf found -back yellow
 356
 357     frame .ctop.cdet.right
 358     set cflist .ctop.cdet.right.cfiles
 359     listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 360         -yscrollcommand ".ctop.cdet.right.sb set"
 361     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 362     pack .ctop.cdet.right.sb -side right -fill y
 363     pack $cflist -side left -fill both -expand 1
 364     .ctop.cdet add .ctop.cdet.right
 365     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 366
 367     pack .ctop -side top -fill both -expand 1
 368
 369     bindall <1> {selcanvline %x %y}
 370     bindall <B1-Motion> {selcanvline %x %y}
 371     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 372     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 373     bindall <2> "allcanvs scan mark 0 %y"
 374     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 375     bind . <Key-Up> "selnextline -1"
 376     bind . <Key-Down> "selnextline 1"
 377     bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 378     bind . <Key-Next> "allcanvs yview scroll 1 pages"
 379     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 380     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 381     bindkey <Key-space> "$ctext yview scroll 1 pages"
 382     bindkey p "selnextline -1"
 383     bindkey n "selnextline 1"
 384     bindkey b "$ctext yview scroll -1 pages"
 385     bindkey d "$ctext yview scroll 18 units"
 386     bindkey u "$ctext yview scroll -18 units"
 387     bindkey / findnext
 388     bindkey ? findprev
 389     bindkey f nextfile
 390     bind . <Control-q> doquit
 391     bind . <Control-f> dofind
 392     bind . <Control-g> findnext
 393     bind . <Control-r> findprev
 394     bind . <Control-equal> {incrfont 1}
 395     bind . <Control-KP_Add> {incrfont 1}
 396     bind . <Control-minus> {incrfont -1}
 397     bind . <Control-KP_Subtract> {incrfont -1}
 398     bind $cflist <<ListboxSelect>> listboxsel
 399     bind . <Destroy> {savestuff %W}
 400     bind . <Button-1> "click %W"
 401     bind $fstring <Key-Return> dofind
 402     bind $sha1entry <Key-Return> gotocommit
 403
 404     set maincursor [. cget -cursor]
 405     set textcursor [$ctext cget -cursor]
 406
 407     set linectxmenu .linectxmenu
 408     menu $linectxmenu -tearoff 0
 409     $linectxmenu add command -label "Select" -command lineselect
 410 }
 411
 412 # when we make a key binding for the toplevel, make sure
 413 # it doesn't get triggered when that key is pressed in the
 414 # find string entry widget.
 415 proc bindkey {ev script} {
 416     global entries
 417     bind . $ev $script
 418     set escript [bind Entry $ev]
 419     if {$escript == {}} {
 420         set escript [bind Entry <Key>]
 421     }
 422     foreach e $entries {
 423         bind $e $ev "$escript; break"
 424     }
 425 }
 426
 427 # set the focus back to the toplevel for any click outside
 428 # the entry widgets
 429 proc click {w} {
 430     global entries
 431     foreach e $entries {
 432         if {$w == $e} return
 433     }
 434     focus .
 435 }
 436
 437 proc savestuff {w} {
 438     global canv canv2 canv3 ctext cflist mainfont textfont
 439     global stuffsaved
 440     if {$stuffsaved} return
 441     if {![winfo viewable .]} return
 442     catch {
 443         set f [open "~/.gitk-new" w]
 444         puts $f "set mainfont {$mainfont}"
 445         puts $f "set textfont {$textfont}"
 446         puts $f "set geometry(width) [winfo width .ctop]"
 447         puts $f "set geometry(height) [winfo height .ctop]"
 448         puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
 449         puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
 450         puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
 451         puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
 452         set wid [expr {([winfo width $ctext] - 8) \
 453                            / [font measure $textfont "0"]}]
 454         puts $f "set geometry(ctextw) $wid"
 455         set wid [expr {([winfo width $cflist] - 11) \
 456                            / [font measure [$cflist cget -font] "0"]}]
 457         puts $f "set geometry(cflistw) $wid"
 458         close $f
 459         file rename -force "~/.gitk-new" "~/.gitk"
 460     }
 461     set stuffsaved 1
 462 }
 463
 464 proc resizeclistpanes {win w} {
 465     global oldwidth
 466     if [info exists oldwidth($win)] {
 467         set s0 [$win sash coord 0]
 468         set s1 [$win sash coord 1]
 469         if {$w < 60} {
 470             set sash0 [expr {int($w/2 - 2)}]
 471             set sash1 [expr {int($w*5/6 - 2)}]
 472         } else {
 473             set factor [expr {1.0 * $w / $oldwidth($win)}]
 474             set sash0 [expr {int($factor * [lindex $s0 0])}]
 475             set sash1 [expr {int($factor * [lindex $s1 0])}]
 476             if {$sash0 < 30} {
 477                 set sash0 30
 478             }
 479             if {$sash1 < $sash0 + 20} {
 480                 set sash1 [expr $sash0 + 20]
 481             }
 482             if {$sash1 > $w - 10} {
 483                 set sash1 [expr $w - 10]
 484                 if {$sash0 > $sash1 - 20} {
 485                     set sash0 [expr $sash1 - 20]
 486                 }
 487             }
 488         }
 489         $win sash place 0 $sash0 [lindex $s0 1]
 490         $win sash place 1 $sash1 [lindex $s1 1]
 491     }
 492     set oldwidth($win) $w
 493 }
 494
 495 proc resizecdetpanes {win w} {
 496     global oldwidth
 497     if [info exists oldwidth($win)] {
 498         set s0 [$win sash coord 0]
 499         if {$w < 60} {
 500             set sash0 [expr {int($w*3/4 - 2)}]
 501         } else {
 502             set factor [expr {1.0 * $w / $oldwidth($win)}]
 503             set sash0 [expr {int($factor * [lindex $s0 0])}]
 504             if {$sash0 < 45} {
 505                 set sash0 45
 506             }
 507             if {$sash0 > $w - 15} {
 508                 set sash0 [expr $w - 15]
 509             }
 510         }
 511         $win sash place 0 $sash0 [lindex $s0 1]
 512     }
 513     set oldwidth($win) $w
 514 }
 515
 516 proc allcanvs args {
 517     global canv canv2 canv3
 518     eval $canv $args
 519     eval $canv2 $args
 520     eval $canv3 $args
 521 }
 522
 523 proc bindall {event action} {
 524     global canv canv2 canv3
 525     bind $canv $event $action
 526     bind $canv2 $event $action
 527     bind $canv3 $event $action
 528 }
 529
 530 proc about {} {
 531     set w .about
 532     if {[winfo exists $w]} {
 533         raise $w
 534         return
 535     }
 536     toplevel $w
 537     wm title $w "About gitk"
 538     message $w.m -text {
 539 Gitk version 1.1
 540
 541 Copyright © 2005 Paul Mackerras
 542
 543 Use and redistribute under the terms of the GNU General Public License
 544
 545 (CVS $Revision: 1.24 $)} \
 546             -justify center -aspect 400
 547     pack $w.m -side top -fill x -padx 20 -pady 20
 548     button $w.ok -text Close -command "destroy $w"
 549     pack $w.ok -side bottom
 550 }
 551
 552 proc assigncolor {id} {
 553     global commitinfo colormap commcolors colors nextcolor
 554     global parents nparents children nchildren
 555     if [info exists colormap($id)] return
 556     set ncolors [llength $colors]
 557     if {$nparents($id) <= 1 && $nchildren($id) == 1} {
 558         set child [lindex $children($id) 0]
 559         if {[info exists colormap($child)]
 560             && $nparents($child) == 1} {
 561             set colormap($id) $colormap($child)
 562             return
 563         }
 564     }
 565     set badcolors {}
 566     foreach child $children($id) {
 567         if {[info exists colormap($child)]
 568             && [lsearch -exact $badcolors $colormap($child)] < 0} {
 569             lappend badcolors $colormap($child)
 570         }
 571         if {[info exists parents($child)]} {
 572             foreach p $parents($child) {
 573                 if {[info exists colormap($p)]
 574                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
 575                     lappend badcolors $colormap($p)
 576                 }
 577             }
 578         }
 579     }
 580     if {[llength $badcolors] >= $ncolors} {
 581         set badcolors {}
 582     }
 583     for {set i 0} {$i <= $ncolors} {incr i} {
 584         set c [lindex $colors $nextcolor]
 585         if {[incr nextcolor] >= $ncolors} {
 586             set nextcolor 0
 587         }
 588         if {[lsearch -exact $badcolors $c]} break
 589     }
 590     set colormap($id) $c
 591 }
 592
 593 proc initgraph {} {
 594     global canvy canvy0 lineno numcommits lthickness nextcolor linespc
 595     global mainline sidelines
 596     global nchildren ncleft
 597
 598     allcanvs delete all
 599     set nextcolor 0
 600     set canvy $canvy0
 601     set lineno -1
 602     set numcommits 0
 603     set lthickness [expr {int($linespc / 9) + 1}]
 604     catch {unset mainline}
 605     catch {unset sidelines}
 606     foreach id [array names nchildren] {
 607         set ncleft($id) $nchildren($id)
 608     }
 609 }
 610
 611 proc bindline {t id} {
 612     global canv
 613
 614     $canv bind $t <Button-3> "linemenu %X %Y $id"
 615     $canv bind $t <Enter> "lineenter %x %y $id"
 616     $canv bind $t <Motion> "linemotion %x %y $id"
 617     $canv bind $t <Leave> "lineleave $id"
 618 }
 619
 620 proc drawcommitline {level} {
 621     global parents children nparents nchildren todo
 622     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 623     global lineid linehtag linentag linedtag commitinfo
 624     global colormap numcommits currentparents dupparents
 625     global oldlevel oldnlines oldtodo
 626     global idtags idline idheads
 627     global lineno lthickness mainline sidelines
 628     global commitlisted
 629
 630     incr numcommits
 631     incr lineno
 632     set id [lindex $todo $level]
 633     set lineid($lineno) $id
 634     set idline($id) $lineno
 635     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 636     if {![info exists commitinfo($id)]} {
 637         readcommit $id
 638         if {![info exists commitinfo($id)]} {
 639             set commitinfo($id) {"No commit information available"}
 640             set nparents($id) 0
 641         }
 642     }
 643     assigncolor $id
 644     set currentparents {}
 645     set dupparents {}
 646     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 647         foreach p $parents($id) {
 648             if {[lsearch -exact $currentparents $p] < 0} {
 649                 lappend currentparents $p
 650             } else {
 651                 # remember that this parent was listed twice
 652                 lappend dupparents $p
 653             }
 654         }
 655     }
 656     set x [expr $canvx0 + $level * $linespc]
 657     set y1 $canvy
 658     set canvy [expr $canvy + $linespc]
 659     allcanvs conf -scrollregion \
 660         [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
 661     if {[info exists mainline($id)]} {
 662         lappend mainline($id) $x $y1
 663         set t [$canv create line $mainline($id) \
 664                    -width $lthickness -fill $colormap($id)]
 665         $canv lower $t
 666         bindline $t $id
 667     }
 668     if {[info exists sidelines($id)]} {
 669         foreach ls $sidelines($id) {
 670             set coords [lindex $ls 0]
 671             set thick [lindex $ls 1]
 672             set t [$canv create line $coords -fill $colormap($id) \
 673                        -width [expr {$thick * $lthickness}]]
 674             $canv lower $t
 675             bindline $t $id
 676         }
 677     }
 678     set orad [expr {$linespc / 3}]
 679     set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
 680                [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
 681                -fill $ofill -outline black -width 1]
 682     $canv raise $t
 683     set xt [expr $canvx0 + [llength $todo] * $linespc]
 684     if {[llength $currentparents] > 2} {
 685         set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
 686     }
 687     set marks {}
 688     set ntags 0
 689     if {[info exists idtags($id)]} {
 690         set marks $idtags($id)
 691         set ntags [llength $marks]
 692     }
 693     if {[info exists idheads($id)]} {
 694         set marks [concat $marks $idheads($id)]
 695     }
 696     if {$marks != {}} {
 697         set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 698         set yt [expr $y1 - 0.5 * $linespc]
 699         set yb [expr $yt + $linespc - 1]
 700         set xvals {}
 701         set wvals {}
 702         foreach tag $marks {
 703             set wid [font measure $mainfont $tag]
 704             lappend xvals $xt
 705             lappend wvals $wid
 706             set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 707         }
 708         set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 709                    -width $lthickness -fill black]
 710         $canv lower $t
 711         foreach tag $marks x $xvals wid $wvals {
 712             set xl [expr $x + $delta]
 713             set xr [expr $x + $delta + $wid + $lthickness]
 714             if {[incr ntags -1] >= 0} {
 715                 # draw a tag
 716                 $canv create polygon $x [expr $yt + $delta] $xl $yt\
 717                     $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
 718                     -width 1 -outline black -fill yellow
 719             } else {
 720                 # draw a head
 721                 set xl [expr $xl - $delta/2]
 722                 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 723                     -width 1 -outline black -fill green
 724             }
 725             $canv create text $xl $y1 -anchor w -text $tag \
 726                 -font $mainfont
 727         }
 728     }
 729     set headline [lindex $commitinfo($id) 0]
 730     set name [lindex $commitinfo($id) 1]
 731     set date [lindex $commitinfo($id) 2]
 732     set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 733                                -text $headline -font $mainfont ]
 734     set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 735                                -text $name -font $namefont]
 736     set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 737                                -text $date -font $mainfont]
 738 }
 739
 740 proc updatetodo {level noshortcut} {
 741     global currentparents ncleft todo
 742     global mainline oldlevel oldtodo oldnlines
 743     global canvx0 canvy linespc mainline
 744     global commitinfo
 745
 746     set oldlevel $level
 747     set oldtodo $todo
 748     set oldnlines [llength $todo]
 749     if {!$noshortcut && [llength $currentparents] == 1} {
 750         set p [lindex $currentparents 0]
 751         if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
 752             set ncleft($p) 0
 753             set x [expr $canvx0 + $level * $linespc]
 754             set y [expr $canvy - $linespc]
 755             set mainline($p) [list $x $y]
 756             set todo [lreplace $todo $level $level $p]
 757             return 0
 758         }
 759     }
 760
 761     set todo [lreplace $todo $level $level]
 762     set i $level
 763     foreach p $currentparents {
 764         incr ncleft($p) -1
 765         set k [lsearch -exact $todo $p]
 766         if {$k < 0} {
 767             set todo [linsert $todo $i $p]
 768             incr i
 769         }
 770     }
 771     return 1
 772 }
 773
 774 proc drawslants {} {
 775     global canv mainline sidelines canvx0 canvy linespc
 776     global oldlevel oldtodo todo currentparents dupparents
 777     global lthickness linespc canvy colormap
 778
 779     set y1 [expr $canvy - $linespc]
 780     set y2 $canvy
 781     set i -1
 782     foreach id $oldtodo {
 783         incr i
 784         if {$id == {}} continue
 785         set xi [expr {$canvx0 + $i * $linespc}]
 786         if {$i == $oldlevel} {
 787             foreach p $currentparents {
 788                 set j [lsearch -exact $todo $p]
 789                 set coords [list $xi $y1]
 790                 set xj [expr {$canvx0 + $j * $linespc}]
 791                 if {$j < $i - 1} {
 792                     lappend coords [expr $xj + $linespc] $y1
 793                 } elseif {$j > $i + 1} {
 794                     lappend coords [expr $xj - $linespc] $y1
 795                 }
 796                 if {[lsearch -exact $dupparents $p] >= 0} {
 797                     # draw a double-width line to indicate the doubled parent
 798                     lappend coords $xj $y2
 799                     lappend sidelines($p) [list $coords 2]
 800                     if {![info exists mainline($p)]} {
 801                         set mainline($p) [list $xj $y2]
 802                     }
 803                 } else {
 804                     # normal case, no parent duplicated
 805                     if {![info exists mainline($p)]} {
 806                         if {$i != $j} {
 807                             lappend coords $xj $y2
 808                         }
 809                         set mainline($p) $coords
 810                     } else {
 811                         lappend coords $xj $y2
 812                         lappend sidelines($p) [list $coords 1]
 813                     }
 814                 }
 815             }
 816         } elseif {[lindex $todo $i] != $id} {
 817             set j [lsearch -exact $todo $id]
 818             set xj [expr {$canvx0 + $j * $linespc}]
 819             lappend mainline($id) $xi $y1 $xj $y2
 820         }
 821     }
 822 }
 823
 824 proc decidenext {} {
 825     global parents children nchildren ncleft todo
 826     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 827     global datemode cdate
 828     global lineid linehtag linentag linedtag commitinfo
 829     global currentparents oldlevel oldnlines oldtodo
 830     global lineno lthickness
 831
 832     # remove the null entry if present
 833     set nullentry [lsearch -exact $todo {}]
 834     if {$nullentry >= 0} {
 835         set todo [lreplace $todo $nullentry $nullentry]
 836     }
 837
 838     # choose which one to do next time around
 839     set todol [llength $todo]
 840     set level -1
 841     set latest {}
 842     for {set k $todol} {[incr k -1] >= 0} {} {
 843         set p [lindex $todo $k]
 844         if {$ncleft($p) == 0} {
 845             if {$datemode} {
 846                 if {$latest == {} || $cdate($p) > $latest} {
 847                     set level $k
 848                     set latest $cdate($p)
 849                 }
 850             } else {
 851                 set level $k
 852                 break
 853             }
 854         }
 855     }
 856     if {$level < 0} {
 857         if {$todo != {}} {
 858             puts "ERROR: none of the pending commits can be done yet:"
 859             foreach p $todo {
 860                 puts "  $p ($ncleft($p))"
 861             }
 862         }
 863         return -1
 864     }
 865
 866     # If we are reducing, put in a null entry
 867     if {$todol < $oldnlines} {
 868         if {$nullentry >= 0} {
 869             set i $nullentry
 870             while {$i < $todol
 871                    && [lindex $oldtodo $i] == [lindex $todo $i]} {
 872                 incr i
 873             }
 874         } else {
 875             set i $oldlevel
 876             if {$level >= $i} {
 877                 incr i
 878             }
 879         }
 880         if {$i < $todol} {
 881             set todo [linsert $todo $i {}]
 882             if {$level >= $i} {
 883                 incr level
 884             }
 885         }
 886     }
 887     return $level
 888 }
 889
 890 proc drawcommit {id} {
 891     global phase todo nchildren datemode nextupdate
 892     global startcommits
 893
 894     if {$phase != "incrdraw"} {
 895         set phase incrdraw
 896         set todo $id
 897         set startcommits $id
 898         initgraph
 899         drawcommitline 0
 900         updatetodo 0 $datemode
 901     } else {
 902         if {$nchildren($id) == 0} {
 903             lappend todo $id
 904             lappend startcommits $id
 905         }
 906         set level [decidenext]
 907         if {$id != [lindex $todo $level]} {
 908             return
 909         }
 910         while 1 {
 911             drawslants
 912             drawcommitline $level
 913             if {[updatetodo $level $datemode]} {
 914                 set level [decidenext]
 915             }
 916             set id [lindex $todo $level]
 917             if {![info exists commitlisted($id)]} {
 918                 break
 919             }
 920             if {[clock clicks -milliseconds] >= $nextupdate} {
 921                 doupdate
 922                 if {$stopped} break
 923             }
 924         }
 925     }
 926 }
 927
 928 proc finishcommits {} {
 929     global phase
 930     global startcommits
 931     global ctext maincursor textcursor
 932
 933     if {$phase != "incrdraw"} {
 934         $canv delete all
 935         $canv create text 3 3 -anchor nw -text "No commits selected" \
 936             -font $mainfont -tags textitems
 937         set phase {}
 938         return
 939     }
 940     drawslants
 941     set level [decidenext]
 942     drawrest $level [llength $startcommits]
 943     . config -cursor $maincursor
 944     $ctext config -cursor $textcursor
 945 }
 946
 947 proc drawgraph {} {
 948     global nextupdate startmsecs startcommits todo
 949
 950     if {$startcommits == {}} return
 951     set startmsecs [clock clicks -milliseconds]
 952     set nextupdate [expr $startmsecs + 100]
 953     initgraph
 954     set todo [lindex $startcommits 0]
 955     drawrest 0 1
 956 }
 957
 958 proc drawrest {level startix} {
 959     global phase stopped redisplaying selectedline
 960     global datemode currentparents todo
 961     global numcommits
 962     global nextupdate startmsecs startcommits idline
 963
 964     if {$level >= 0} {
 965         set phase drawgraph
 966         set startid [lindex $startcommits $startix]
 967         set startline -1
 968         if {$startid != {}} {
 969             set startline $idline($startid)
 970         }
 971         while 1 {
 972             if {$stopped} break
 973             drawcommitline $level
 974             set hard [updatetodo $level $datemode]
 975             if {$numcommits == $startline} {
 976                 lappend todo $startid
 977                 set hard 1
 978                 incr startix
 979                 set startid [lindex $startcommits $startix]
 980                 set startline -1
 981                 if {$startid != {}} {
 982                     set startline $idline($startid)
 983                 }
 984             }
 985             if {$hard} {
 986                 set level [decidenext]
 987                 if {$level < 0} break
 988                 drawslants
 989             }
 990             if {[clock clicks -milliseconds] >= $nextupdate} {
 991                 update
 992                 incr nextupdate 100
 993             }
 994         }
 995     }
 996     set phase {}
 997     set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
 998     #puts "overall $drawmsecs ms for $numcommits commits"
 999     if {$redisplaying} {
1000         if {$stopped == 0 && [info exists selectedline]} {
1001             selectline $selectedline
1002         }
1003         if {$stopped == 1} {
1004             set stopped 0
1005             after idle drawgraph
1006         } else {
1007             set redisplaying 0
1008         }
1009     }
1010 }
1011
1012 proc findmatches {f} {
1013     global findtype foundstring foundstrlen
1014     if {$findtype == "Regexp"} {
1015         set matches [regexp -indices -all -inline $foundstring $f]
1016     } else {
1017         if {$findtype == "IgnCase"} {
1018             set str [string tolower $f]
1019         } else {
1020             set str $f
1021         }
1022         set matches {}
1023         set i 0
1024         while {[set j [string first $foundstring $str $i]] >= 0} {
1025             lappend matches [list $j [expr $j+$foundstrlen-1]]
1026             set i [expr $j + $foundstrlen]
1027         }
1028     }
1029     return $matches
1030 }
1031
1032 proc dofind {} {
1033     global findtype findloc findstring markedmatches commitinfo
1034     global numcommits lineid linehtag linentag linedtag
1035     global mainfont namefont canv canv2 canv3 selectedline
1036     global matchinglines foundstring foundstrlen
1037     unmarkmatches
1038     focus .
1039     set matchinglines {}
1040     set fldtypes {Headline Author Date Committer CDate Comment}
1041     if {$findtype == "IgnCase"} {
1042         set foundstring [string tolower $findstring]
1043     } else {
1044         set foundstring $findstring
1045     }
1046     set foundstrlen [string length $findstring]
1047     if {$foundstrlen == 0} return
1048     if {![info exists selectedline]} {
1049         set oldsel -1
1050     } else {
1051         set oldsel $selectedline
1052     }
1053     set didsel 0
1054     for {set l 0} {$l < $numcommits} {incr l} {
1055         set id $lineid($l)
1056         set info $commitinfo($id)
1057         set doesmatch 0
1058         foreach f $info ty $fldtypes {
1059             if {$findloc != "All fields" && $findloc != $ty} {
1060                 continue
1061             }
1062             set matches [findmatches $f]
1063             if {$matches == {}} continue
1064             set doesmatch 1
1065             if {$ty == "Headline"} {
1066                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1067             } elseif {$ty == "Author"} {
1068                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1069             } elseif {$ty == "Date"} {
1070                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1071             }
1072         }
1073         if {$doesmatch} {
1074             lappend matchinglines $l
1075             if {!$didsel && $l > $oldsel} {
1076                 findselectline $l
1077                 set didsel 1
1078             }
1079         }
1080     }
1081     if {$matchinglines == {}} {
1082         bell
1083     } elseif {!$didsel} {
1084         findselectline [lindex $matchinglines 0]
1085     }
1086 }
1087
1088 proc findselectline {l} {
1089     global findloc commentend ctext
1090     selectline $l
1091     if {$findloc == "All fields" || $findloc == "Comments"} {
1092         # highlight the matches in the comments
1093         set f [$ctext get 1.0 $commentend]
1094         set matches [findmatches $f]
1095         foreach match $matches {
1096             set start [lindex $match 0]
1097             set end [expr [lindex $match 1] + 1]
1098             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1099         }
1100     }
1101 }
1102
1103 proc findnext {} {
1104     global matchinglines selectedline
1105     if {![info exists matchinglines]} {
1106         dofind
1107         return
1108     }
1109     if {![info exists selectedline]} return
1110     foreach l $matchinglines {
1111         if {$l > $selectedline} {
1112             findselectline $l
1113             return
1114         }
1115     }
1116     bell
1117 }
1118
1119 proc findprev {} {
1120     global matchinglines selectedline
1121     if {![info exists matchinglines]} {
1122         dofind
1123         return
1124     }
1125     if {![info exists selectedline]} return
1126     set prev {}
1127     foreach l $matchinglines {
1128         if {$l >= $selectedline} break
1129         set prev $l
1130     }
1131     if {$prev != {}} {
1132         findselectline $prev
1133     } else {
1134         bell
1135     }
1136 }
1137
1138 proc markmatches {canv l str tag matches font} {
1139     set bbox [$canv bbox $tag]
1140     set x0 [lindex $bbox 0]
1141     set y0 [lindex $bbox 1]
1142     set y1 [lindex $bbox 3]
1143     foreach match $matches {
1144         set start [lindex $match 0]
1145         set end [lindex $match 1]
1146         if {$start > $end} continue
1147         set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1148         set xlen [font measure $font [string range $str 0 [expr $end]]]
1149         set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1150                    -outline {} -tags matches -fill yellow]
1151         $canv lower $t
1152     }
1153 }
1154
1155 proc unmarkmatches {} {
1156     global matchinglines
1157     allcanvs delete matches
1158     catch {unset matchinglines}
1159 }
1160
1161 proc selcanvline {x y} {
1162     global canv canvy0 ctext linespc selectedline
1163     global lineid linehtag linentag linedtag
1164     set ymax [lindex [$canv cget -scrollregion] 3]
1165     if {$ymax == {}} return
1166     set yfrac [lindex [$canv yview] 0]
1167     set y [expr {$y + $yfrac * $ymax}]
1168     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1169     if {$l < 0} {
1170         set l 0
1171     }
1172     if {[info exists selectedline] && $selectedline == $l} return
1173     unmarkmatches
1174     selectline $l
1175 }
1176
1177 proc selectline {l} {
1178     global canv canv2 canv3 ctext commitinfo selectedline
1179     global lineid linehtag linentag linedtag
1180     global canvy0 linespc nparents treepending
1181     global cflist treediffs currentid sha1entry
1182     global commentend seenfile idtags
1183     $canv delete hover
1184     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1185     $canv delete secsel
1186     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1187                -tags secsel -fill [$canv cget -selectbackground]]
1188     $canv lower $t
1189     $canv2 delete secsel
1190     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1191                -tags secsel -fill [$canv2 cget -selectbackground]]
1192     $canv2 lower $t
1193     $canv3 delete secsel
1194     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1195                -tags secsel -fill [$canv3 cget -selectbackground]]
1196     $canv3 lower $t
1197     set y [expr {$canvy0 + $l * $linespc}]
1198     set ymax [lindex [$canv cget -scrollregion] 3]
1199     set ytop [expr {$y - $linespc - 1}]
1200     set ybot [expr {$y + $linespc + 1}]
1201     set wnow [$canv yview]
1202     set wtop [expr [lindex $wnow 0] * $ymax]
1203     set wbot [expr [lindex $wnow 1] * $ymax]
1204     set wh [expr {$wbot - $wtop}]
1205     set newtop $wtop
1206     if {$ytop < $wtop} {
1207         if {$ybot < $wtop} {
1208             set newtop [expr {$y - $wh / 2.0}]
1209         } else {
1210             set newtop $ytop
1211             if {$newtop > $wtop - $linespc} {
1212                 set newtop [expr {$wtop - $linespc}]
1213             }
1214         }
1215     } elseif {$ybot > $wbot} {
1216         if {$ytop > $wbot} {
1217             set newtop [expr {$y - $wh / 2.0}]
1218         } else {
1219             set newtop [expr {$ybot - $wh}]
1220             if {$newtop < $wtop + $linespc} {
1221                 set newtop [expr {$wtop + $linespc}]
1222             }
1223         }
1224     }
1225     if {$newtop != $wtop} {
1226         if {$newtop < 0} {
1227             set newtop 0
1228         }
1229         allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1230     }
1231     set selectedline $l
1232
1233     set id $lineid($l)
1234     set currentid $id
1235     $sha1entry delete 0 end
1236     $sha1entry insert 0 $id
1237     $sha1entry selection from 0
1238     $sha1entry selection to end
1239
1240     $ctext conf -state normal
1241     $ctext delete 0.0 end
1242     set info $commitinfo($id)
1243     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
1244     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
1245     if {[info exists idtags($id)]} {
1246         $ctext insert end "Tags:"
1247         foreach tag $idtags($id) {
1248             $ctext insert end " $tag"
1249         }
1250         $ctext insert end "\n"
1251     }
1252     $ctext insert end "\n"
1253     $ctext insert end [lindex $info 5]
1254     $ctext insert end "\n"
1255     $ctext tag delete Comments
1256     $ctext tag remove found 1.0 end
1257     $ctext conf -state disabled
1258     set commentend [$ctext index "end - 1c"]
1259
1260     $cflist delete 0 end
1261     if {$nparents($id) == 1} {
1262         if {![info exists treediffs($id)]} {
1263             if {![info exists treepending]} {
1264                 gettreediffs $id
1265             }
1266         } else {
1267             addtocflist $id
1268         }
1269     }
1270     catch {unset seenfile}
1271 }
1272
1273 proc selnextline {dir} {
1274     global selectedline
1275     if {![info exists selectedline]} return
1276     set l [expr $selectedline + $dir]
1277     unmarkmatches
1278     selectline $l
1279 }
1280
1281 proc addtocflist {id} {
1282     global currentid treediffs cflist treepending
1283     if {$id != $currentid} {
1284         gettreediffs $currentid
1285         return
1286     }
1287     $cflist insert end "All files"
1288     foreach f $treediffs($currentid) {
1289         $cflist insert end $f
1290     }
1291     getblobdiffs $id
1292 }
1293
1294 proc gettreediffs {id} {
1295     global treediffs parents treepending
1296     set treepending $id
1297     set treediffs($id) {}
1298     set p [lindex $parents($id) 0]
1299     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1300     fconfigure $gdtf -blocking 0
1301     fileevent $gdtf readable "gettreediffline $gdtf $id"
1302 }
1303
1304 proc gettreediffline {gdtf id} {
1305     global treediffs treepending
1306     set n [gets $gdtf line]
1307     if {$n < 0} {
1308         if {![eof $gdtf]} return
1309         close $gdtf
1310         unset treepending
1311         addtocflist $id
1312         return
1313     }
1314     set file [lindex $line 5]
1315     lappend treediffs($id) $file
1316 }
1317
1318 proc getblobdiffs {id} {
1319     global parents diffopts blobdifffd env curdifftag curtagstart
1320     global diffindex difffilestart
1321     set p [lindex $parents($id) 0]
1322     set env(GIT_DIFF_OPTS) $diffopts
1323     if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1324         puts "error getting diffs: $err"
1325         return
1326     }
1327     fconfigure $bdf -blocking 0
1328     set blobdifffd($id) $bdf
1329     set curdifftag Comments
1330     set curtagstart 0.0
1331     set diffindex 0
1332     catch {unset difffilestart}
1333     fileevent $bdf readable "getblobdiffline $bdf $id"
1334 }
1335
1336 proc getblobdiffline {bdf id} {
1337     global currentid blobdifffd ctext curdifftag curtagstart seenfile
1338     global diffnexthead diffnextnote diffindex difffilestart
1339     set n [gets $bdf line]
1340     if {$n < 0} {
1341         if {[eof $bdf]} {
1342             close $bdf
1343             if {$id == $currentid && $bdf == $blobdifffd($id)} {
1344                 $ctext tag add $curdifftag $curtagstart end
1345                 set seenfile($curdifftag) 1
1346             }
1347         }
1348         return
1349     }
1350     if {$id != $currentid || $bdf != $blobdifffd($id)} {
1351         return
1352     }
1353     $ctext conf -state normal
1354     if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1355         # start of a new file
1356         $ctext insert end "\n"
1357         $ctext tag add $curdifftag $curtagstart end
1358         set seenfile($curdifftag) 1
1359         set curtagstart [$ctext index "end - 1c"]
1360         set header $fname
1361         if {[info exists diffnexthead]} {
1362             set fname $diffnexthead
1363             set header "$diffnexthead ($diffnextnote)"
1364             unset diffnexthead
1365         }
1366         set difffilestart($diffindex) [$ctext index "end - 1c"]
1367         incr diffindex
1368         set curdifftag "f:$fname"
1369         $ctext tag delete $curdifftag
1370         set l [expr {(78 - [string length $header]) / 2}]
1371         set pad [string range "----------------------------------------" 1 $l]
1372         $ctext insert end "$pad $header $pad\n" filesep
1373     } elseif {[string range $line 0 2] == "+++"} {
1374         # no need to do anything with this
1375     } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1376         set diffnexthead $fn
1377         set diffnextnote "created, mode $m"
1378     } elseif {[string range $line 0 8] == "Deleted: "} {
1379         set diffnexthead [string range $line 9 end]
1380         set diffnextnote "deleted"
1381     } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1382         # save the filename in case the next thing is "new file mode ..."
1383         set diffnexthead $fn
1384         set diffnextnote "modified"
1385     } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1386         set diffnextnote "new file, mode $m"
1387     } elseif {[string range $line 0 11] == "deleted file"} {
1388         set diffnextnote "deleted"
1389     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1390                    $line match f1l f1c f2l f2c rest]} {
1391         $ctext insert end "\t" hunksep
1392         $ctext insert end "    $f1l    " d0 "    $f2l    " d1
1393         $ctext insert end "    $rest \n" hunksep
1394     } else {
1395         set x [string range $line 0 0]
1396         if {$x == "-" || $x == "+"} {
1397             set tag [expr {$x == "+"}]
1398             set line [string range $line 1 end]
1399             $ctext insert end "$line\n" d$tag
1400         } elseif {$x == " "} {
1401             set line [string range $line 1 end]
1402             $ctext insert end "$line\n"
1403         } elseif {$x == "\\"} {
1404             # e.g. "\ No newline at end of file"
1405             $ctext insert end "$line\n" filesep
1406         } else {
1407             # Something else we don't recognize
1408             if {$curdifftag != "Comments"} {
1409                 $ctext insert end "\n"
1410                 $ctext tag add $curdifftag $curtagstart end
1411                 set seenfile($curdifftag) 1
1412                 set curtagstart [$ctext index "end - 1c"]
1413                 set curdifftag Comments
1414             }
1415             $ctext insert end "$line\n" filesep
1416         }
1417     }
1418     $ctext conf -state disabled
1419 }
1420
1421 proc nextfile {} {
1422     global difffilestart ctext
1423     set here [$ctext index @0,0]
1424     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1425         if {[$ctext compare $difffilestart($i) > $here]} {
1426             $ctext yview $difffilestart($i)
1427             break
1428         }
1429     }
1430 }
1431
1432 proc listboxsel {} {
1433     global ctext cflist currentid treediffs seenfile
1434     if {![info exists currentid]} return
1435     set sel [$cflist curselection]
1436     if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1437         # show everything
1438         $ctext tag conf Comments -elide 0
1439         foreach f $treediffs($currentid) {
1440             if [info exists seenfile(f:$f)] {
1441                 $ctext tag conf "f:$f" -elide 0
1442             }
1443         }
1444     } else {
1445         # just show selected files
1446         $ctext tag conf Comments -elide 1
1447         set i 1
1448         foreach f $treediffs($currentid) {
1449             set elide [expr {[lsearch -exact $sel $i] < 0}]
1450             if [info exists seenfile(f:$f)] {
1451                 $ctext tag conf "f:$f" -elide $elide
1452             }
1453             incr i
1454         }
1455     }
1456 }
1457
1458 proc setcoords {} {
1459     global linespc charspc canvx0 canvy0 mainfont
1460     set linespc [font metrics $mainfont -linespace]
1461     set charspc [font measure $mainfont "m"]
1462     set canvy0 [expr 3 + 0.5 * $linespc]
1463     set canvx0 [expr 3 + 0.5 * $linespc]
1464 }
1465
1466 proc redisplay {} {
1467     global selectedline stopped redisplaying phase
1468     if {$stopped > 1} return
1469     if {$phase == "getcommits"} return
1470     set redisplaying 1
1471     if {$phase == "drawgraph" || $phase == "incrdraw"} {
1472         set stopped 1
1473     } else {
1474         drawgraph
1475     }
1476 }
1477
1478 proc incrfont {inc} {
1479     global mainfont namefont textfont selectedline ctext canv phase
1480     global stopped entries
1481     unmarkmatches
1482     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1483     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1484     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1485     setcoords
1486     $ctext conf -font $textfont
1487     $ctext tag conf filesep -font [concat $textfont bold]
1488     foreach e $entries {
1489         $e conf -font $mainfont
1490     }
1491     if {$phase == "getcommits"} {
1492         $canv itemconf textitems -font $mainfont
1493     }
1494     redisplay
1495 }
1496
1497 proc sha1change {n1 n2 op} {
1498     global sha1string currentid sha1but
1499     if {$sha1string == {}
1500         || ([info exists currentid] && $sha1string == $currentid)} {
1501         set state disabled
1502     } else {
1503         set state normal
1504     }
1505     if {[$sha1but cget -state] == $state} return
1506     if {$state == "normal"} {
1507         $sha1but conf -state normal -relief raised -text "Goto: "
1508     } else {
1509         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1510     }
1511 }
1512
1513 proc gotocommit {} {
1514     global sha1string currentid idline tagids
1515     if {$sha1string == {}
1516         || ([info exists currentid] && $sha1string == $currentid)} return
1517     if {[info exists tagids($sha1string)]} {
1518         set id $tagids($sha1string)
1519     } else {
1520         set id [string tolower $sha1string]
1521     }
1522     if {[info exists idline($id)]} {
1523         selectline $idline($id)
1524         return
1525     }
1526     if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1527         set type "SHA1 id"
1528     } else {
1529         set type "Tag"
1530     }
1531     error_popup "$type $sha1string is not known"
1532 }
1533
1534 proc linemenu {x y id} {
1535     global linectxmenu linemenuid
1536     set linemenuid $id
1537     $linectxmenu post $x $y
1538 }
1539
1540 proc lineselect {} {
1541     global linemenuid idline
1542     if {[info exists linemenuid] && [info exists idline($linemenuid)]} {
1543         selectline $idline($linemenuid)
1544     }
1545 }
1546
1547 proc lineenter {x y id} {
1548     global hoverx hovery hoverid hovertimer
1549     global commitinfo canv
1550
1551     if {![info exists commitinfo($id)]} return
1552     set hoverx $x
1553     set hovery $y
1554     set hoverid $id
1555     if {[info exists hovertimer]} {
1556         after cancel $hovertimer
1557     }
1558     set hovertimer [after 500 linehover]
1559     $canv delete hover
1560 }
1561
1562 proc linemotion {x y id} {
1563     global hoverx hovery hoverid hovertimer
1564
1565     if {[info exists hoverid] && $id == $hoverid} {
1566         set hoverx $x
1567         set hovery $y
1568         if {[info exists hovertimer]} {
1569             after cancel $hovertimer
1570         }
1571         set hovertimer [after 500 linehover]
1572     }
1573 }
1574
1575 proc lineleave {id} {
1576     global hoverid hovertimer canv
1577
1578     if {[info exists hoverid] && $id == $hoverid} {
1579         $canv delete hover
1580         if {[info exists hovertimer]} {
1581             after cancel $hovertimer
1582             unset hovertimer
1583         }
1584         unset hoverid
1585     }
1586 }
1587
1588 proc linehover {} {
1589     global hoverx hovery hoverid hovertimer
1590     global canv linespc lthickness
1591     global commitinfo mainfont
1592
1593     set text [lindex $commitinfo($hoverid) 0]
1594     set ymax [lindex [$canv cget -scrollregion] 3]
1595     if {$ymax == {}} return
1596     set yfrac [lindex [$canv yview] 0]
1597     set x [expr {$hoverx + 2 * $linespc}]
1598     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
1599     set x0 [expr {$x - 2 * $lthickness}]
1600     set y0 [expr {$y - 2 * $lthickness}]
1601     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
1602     set y1 [expr {$y + $linespc + 2 * $lthickness}]
1603     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
1604                -fill \#ffff80 -outline black -width 1 -tags hover]
1605     $canv raise $t
1606     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
1607     $canv raise $t
1608 }
1609
1610 proc doquit {} {
1611     global stopped
1612     set stopped 100
1613     destroy .
1614 }
1615
1616 # defaults...
1617 set datemode 0
1618 set boldnames 0
1619 set diffopts "-U 5 -p"
1620
1621 set mainfont {Helvetica 9}
1622 set textfont {Courier 9}
1623
1624 set colors {green red blue magenta darkgrey brown orange}
1625
1626 catch {source ~/.gitk}
1627
1628 set namefont $mainfont
1629 if {$boldnames} {
1630     lappend namefont bold
1631 }
1632
1633 set revtreeargs {}
1634 foreach arg $argv {
1635     switch -regexp -- $arg {
1636         "^$" { }
1637         "^-b" { set boldnames 1 }
1638         "^-d" { set datemode 1 }
1639         default {
1640             lappend revtreeargs $arg
1641         }
1642     }
1643 }
1644
1645 set stopped 0
1646 set redisplaying 0
1647 set stuffsaved 0
1648 setcoords
1649 makewindow
1650 readrefs
1651 getcommits $revtreeargs