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