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