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