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