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