]> Pileus Git - ~andy/git/blob - gitk
[PATCH] gitk: properly deal with tag names containing / (slash)
[~andy/git] / gitk
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
4
5 # Copyright (C) 2005-2006 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 proc gitdir {} {
11     global env
12     if {[info exists env(GIT_DIR)]} {
13         return $env(GIT_DIR)
14     } else {
15         return [exec git rev-parse --git-dir]
16     }
17 }
18
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
24 proc run args {
25     global isonrunq runq
26
27     set script $args
28     if {[info exists isonrunq($script)]} return
29     if {$runq eq {}} {
30         after idle dorunq
31     }
32     lappend runq [list {} $script]
33     set isonrunq($script) 1
34 }
35
36 proc filerun {fd script} {
37     fileevent $fd readable [list filereadable $fd $script]
38 }
39
40 proc filereadable {fd script} {
41     global runq
42
43     fileevent $fd readable {}
44     if {$runq eq {}} {
45         after idle dorunq
46     }
47     lappend runq [list $fd $script]
48 }
49
50 proc dorunq {} {
51     global isonrunq runq
52
53     set tstart [clock clicks -milliseconds]
54     set t0 $tstart
55     while {$runq ne {}} {
56         set fd [lindex $runq 0 0]
57         set script [lindex $runq 0 1]
58         set repeat [eval $script]
59         set t1 [clock clicks -milliseconds]
60         set t [expr {$t1 - $t0}]
61         set runq [lrange $runq 1 end]
62         if {$repeat ne {} && $repeat} {
63             if {$fd eq {} || $repeat == 2} {
64                 # script returns 1 if it wants to be readded
65                 # file readers return 2 if they could do more straight away
66                 lappend runq [list $fd $script]
67             } else {
68                 fileevent $fd readable [list filereadable $fd $script]
69             }
70         } elseif {$fd eq {}} {
71             unset isonrunq($script)
72         }
73         set t0 $t1
74         if {$t1 - $tstart >= 80} break
75     }
76     if {$runq ne {}} {
77         after idle dorunq
78     }
79 }
80
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list {view} {
83     global startmsecs
84     global commfd leftover tclencoding datemode
85     global viewargs viewfiles commitidx viewcomplete vnextroot
86     global showlocalchanges commitinterest mainheadid
87     global progressdirn progresscoords proglastnc curview
88
89     set startmsecs [clock clicks -milliseconds]
90     set commitidx($view) 0
91     set viewcomplete($view) 0
92     set vnextroot($view) 0
93     set order "--topo-order"
94     if {$datemode} {
95         set order "--date-order"
96     }
97     if {[catch {
98         set fd [open [concat | git log --no-color -z --pretty=raw $order --parents \
99                          --boundary $viewargs($view) "--" $viewfiles($view)] r]
100     } err]} {
101         error_popup "[mc "Error executing git rev-list:"] $err"
102         exit 1
103     }
104     set commfd($view) $fd
105     set leftover($view) {}
106     if {$showlocalchanges} {
107         lappend commitinterest($mainheadid) {dodiffindex}
108     }
109     fconfigure $fd -blocking 0 -translation lf -eofchar {}
110     if {$tclencoding != {}} {
111         fconfigure $fd -encoding $tclencoding
112     }
113     filerun $fd [list getcommitlines $fd $view]
114     nowbusy $view [mc "Reading"]
115     if {$view == $curview} {
116         set progressdirn 1
117         set progresscoords {0 0}
118         set proglastnc 0
119     }
120 }
121
122 proc stop_rev_list {} {
123     global commfd curview
124
125     if {![info exists commfd($curview)]} return
126     set fd $commfd($curview)
127     catch {
128         set pid [pid $fd]
129         exec kill $pid
130     }
131     catch {close $fd}
132     unset commfd($curview)
133 }
134
135 proc getcommits {} {
136     global phase canv curview
137
138     set phase getcommits
139     initlayout
140     start_rev_list $curview
141     show_status [mc "Reading commits..."]
142 }
143
144 # This makes a string representation of a positive integer which
145 # sorts as a string in numerical order
146 proc strrep {n} {
147     if {$n < 16} {
148         return [format "%x" $n]
149     } elseif {$n < 256} {
150         return [format "x%.2x" $n]
151     } elseif {$n < 65536} {
152         return [format "y%.4x" $n]
153     }
154     return [format "z%.8x" $n]
155 }
156
157 proc getcommitlines {fd view}  {
158     global commitlisted commitinterest
159     global leftover commfd
160     global displayorder commitidx viewcomplete commitrow commitdata
161     global parentlist children curview hlview
162     global vparentlist vdisporder vcmitlisted
163     global ordertok vnextroot idpending
164
165     set stuff [read $fd 500000]
166     # git log doesn't terminate the last commit with a null...
167     if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
168         set stuff "\0"
169     }
170     if {$stuff == {}} {
171         if {![eof $fd]} {
172             return 1
173         }
174         # Check if we have seen any ids listed as parents that haven't
175         # appeared in the list
176         foreach vid [array names idpending "$view,*"] {
177             # should only get here if git log is buggy
178             set id [lindex [split $vid ","] 1]
179             set commitrow($vid) $commitidx($view)
180             incr commitidx($view)
181             if {$view == $curview} {
182                 lappend parentlist {}
183                 lappend displayorder $id
184                 lappend commitlisted 0
185             } else {
186                 lappend vparentlist($view) {}
187                 lappend vdisporder($view) $id
188                 lappend vcmitlisted($view) 0
189             }
190         }
191         set viewcomplete($view) 1
192         global viewname progresscoords
193         unset commfd($view)
194         notbusy $view
195         set progresscoords {0 0}
196         adjustprogress
197         # set it blocking so we wait for the process to terminate
198         fconfigure $fd -blocking 1
199         if {[catch {close $fd} err]} {
200             set fv {}
201             if {$view != $curview} {
202                 set fv " for the \"$viewname($view)\" view"
203             }
204             if {[string range $err 0 4] == "usage"} {
205                 set err "Gitk: error reading commits$fv:\
206                         bad arguments to git rev-list."
207                 if {$viewname($view) eq "Command line"} {
208                     append err \
209                         "  (Note: arguments to gitk are passed to git rev-list\
210                          to allow selection of commits to be displayed.)"
211                 }
212             } else {
213                 set err "Error reading commits$fv: $err"
214             }
215             error_popup $err
216         }
217         if {$view == $curview} {
218             run chewcommits $view
219         }
220         return 0
221     }
222     set start 0
223     set gotsome 0
224     while 1 {
225         set i [string first "\0" $stuff $start]
226         if {$i < 0} {
227             append leftover($view) [string range $stuff $start end]
228             break
229         }
230         if {$start == 0} {
231             set cmit $leftover($view)
232             append cmit [string range $stuff 0 [expr {$i - 1}]]
233             set leftover($view) {}
234         } else {
235             set cmit [string range $stuff $start [expr {$i - 1}]]
236         }
237         set start [expr {$i + 1}]
238         set j [string first "\n" $cmit]
239         set ok 0
240         set listed 1
241         if {$j >= 0 && [string match "commit *" $cmit]} {
242             set ids [string range $cmit 7 [expr {$j - 1}]]
243             if {[string match {[-<>]*} $ids]} {
244                 switch -- [string index $ids 0] {
245                     "-" {set listed 0}
246                     "<" {set listed 2}
247                     ">" {set listed 3}
248                 }
249                 set ids [string range $ids 1 end]
250             }
251             set ok 1
252             foreach id $ids {
253                 if {[string length $id] != 40} {
254                     set ok 0
255                     break
256                 }
257             }
258         }
259         if {!$ok} {
260             set shortcmit $cmit
261             if {[string length $shortcmit] > 80} {
262                 set shortcmit "[string range $shortcmit 0 80]..."
263             }
264             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
265             exit 1
266         }
267         set id [lindex $ids 0]
268         if {![info exists ordertok($view,$id)]} {
269             set otok "o[strrep $vnextroot($view)]"
270             incr vnextroot($view)
271             set ordertok($view,$id) $otok
272         } else {
273             set otok $ordertok($view,$id)
274             unset idpending($view,$id)
275         }
276         if {$listed} {
277             set olds [lrange $ids 1 end]
278             if {[llength $olds] == 1} {
279                 set p [lindex $olds 0]
280                 lappend children($view,$p) $id
281                 if {![info exists ordertok($view,$p)]} {
282                     set ordertok($view,$p) $ordertok($view,$id)
283                     set idpending($view,$p) 1
284                 }
285             } else {
286                 set i 0
287                 foreach p $olds {
288                     if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
289                         lappend children($view,$p) $id
290                     }
291                     if {![info exists ordertok($view,$p)]} {
292                         set ordertok($view,$p) "$otok[strrep $i]]"
293                         set idpending($view,$p) 1
294                     }
295                     incr i
296                 }
297             }
298         } else {
299             set olds {}
300         }
301         if {![info exists children($view,$id)]} {
302             set children($view,$id) {}
303         }
304         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
305         set commitrow($view,$id) $commitidx($view)
306         incr commitidx($view)
307         if {$view == $curview} {
308             lappend parentlist $olds
309             lappend displayorder $id
310             lappend commitlisted $listed
311         } else {
312             lappend vparentlist($view) $olds
313             lappend vdisporder($view) $id
314             lappend vcmitlisted($view) $listed
315         }
316         if {[info exists commitinterest($id)]} {
317             foreach script $commitinterest($id) {
318                 eval [string map [list "%I" $id] $script]
319             }
320             unset commitinterest($id)
321         }
322         set gotsome 1
323     }
324     if {$gotsome} {
325         run chewcommits $view
326         if {$view == $curview} {
327             # update progress bar
328             global progressdirn progresscoords proglastnc
329             set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
330             set proglastnc $commitidx($view)
331             set l [lindex $progresscoords 0]
332             set r [lindex $progresscoords 1]
333             if {$progressdirn} {
334                 set r [expr {$r + $inc}]
335                 if {$r >= 1.0} {
336                     set r 1.0
337                     set progressdirn 0
338                 }
339                 if {$r > 0.2} {
340                     set l [expr {$r - 0.2}]
341                 }
342             } else {
343                 set l [expr {$l - $inc}]
344                 if {$l <= 0.0} {
345                     set l 0.0
346                     set progressdirn 1
347                 }
348                 set r [expr {$l + 0.2}]
349             }
350             set progresscoords [list $l $r]
351             adjustprogress
352         }
353     }
354     return 2
355 }
356
357 proc chewcommits {view} {
358     global curview hlview viewcomplete
359     global selectedline pending_select
360
361     if {$view == $curview} {
362         layoutmore
363         if {$viewcomplete($view)} {
364             global displayorder commitidx phase
365             global numcommits startmsecs
366
367             if {[info exists pending_select]} {
368                 set row [first_real_row]
369                 selectline $row 1
370             }
371             if {$commitidx($curview) > 0} {
372                 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
373                 #puts "overall $ms ms for $numcommits commits"
374             } else {
375                 show_status [mc "No commits selected"]
376             }
377             notbusy layout
378             set phase {}
379         }
380     }
381     if {[info exists hlview] && $view == $hlview} {
382         vhighlightmore
383     }
384     return 0
385 }
386
387 proc readcommit {id} {
388     if {[catch {set contents [exec git cat-file commit $id]}]} return
389     parsecommit $id $contents 0
390 }
391
392 proc updatecommits {} {
393     global viewdata curview phase displayorder ordertok idpending
394     global children commitrow selectedline thickerline showneartags
395
396     if {$phase ne {}} {
397         stop_rev_list
398         set phase {}
399     }
400     set n $curview
401     foreach id $displayorder {
402         catch {unset children($n,$id)}
403         catch {unset commitrow($n,$id)}
404         catch {unset ordertok($n,$id)}
405     }
406     foreach vid [array names idpending "$n,*"] {
407         unset idpending($vid)
408     }
409     set curview -1
410     catch {unset selectedline}
411     catch {unset thickerline}
412     catch {unset viewdata($n)}
413     readrefs
414     changedrefs
415     if {$showneartags} {
416         getallcommits
417     }
418     showview $n
419 }
420
421 proc parsecommit {id contents listed} {
422     global commitinfo cdate
423
424     set inhdr 1
425     set comment {}
426     set headline {}
427     set auname {}
428     set audate {}
429     set comname {}
430     set comdate {}
431     set hdrend [string first "\n\n" $contents]
432     if {$hdrend < 0} {
433         # should never happen...
434         set hdrend [string length $contents]
435     }
436     set header [string range $contents 0 [expr {$hdrend - 1}]]
437     set comment [string range $contents [expr {$hdrend + 2}] end]
438     foreach line [split $header "\n"] {
439         set tag [lindex $line 0]
440         if {$tag == "author"} {
441             set audate [lindex $line end-1]
442             set auname [lrange $line 1 end-2]
443         } elseif {$tag == "committer"} {
444             set comdate [lindex $line end-1]
445             set comname [lrange $line 1 end-2]
446         }
447     }
448     set headline {}
449     # take the first non-blank line of the comment as the headline
450     set headline [string trimleft $comment]
451     set i [string first "\n" $headline]
452     if {$i >= 0} {
453         set headline [string range $headline 0 $i]
454     }
455     set headline [string trimright $headline]
456     set i [string first "\r" $headline]
457     if {$i >= 0} {
458         set headline [string trimright [string range $headline 0 $i]]
459     }
460     if {!$listed} {
461         # git rev-list indents the comment by 4 spaces;
462         # if we got this via git cat-file, add the indentation
463         set newcomment {}
464         foreach line [split $comment "\n"] {
465             append newcomment "    "
466             append newcomment $line
467             append newcomment "\n"
468         }
469         set comment $newcomment
470     }
471     if {$comdate != {}} {
472         set cdate($id) $comdate
473     }
474     set commitinfo($id) [list $headline $auname $audate \
475                              $comname $comdate $comment]
476 }
477
478 proc getcommit {id} {
479     global commitdata commitinfo
480
481     if {[info exists commitdata($id)]} {
482         parsecommit $id $commitdata($id) 1
483     } else {
484         readcommit $id
485         if {![info exists commitinfo($id)]} {
486             set commitinfo($id) [list [mc "No commit information available"]]
487         }
488     }
489     return 1
490 }
491
492 proc readrefs {} {
493     global tagids idtags headids idheads tagobjid
494     global otherrefids idotherrefs mainhead mainheadid
495
496     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
497         catch {unset $v}
498     }
499     set refd [open [list | git show-ref -d] r]
500     while {[gets $refd line] >= 0} {
501         if {[string index $line 40] ne " "} continue
502         set id [string range $line 0 39]
503         set ref [string range $line 41 end]
504         if {![string match "refs/*" $ref]} continue
505         set name [string range $ref 5 end]
506         if {[string match "remotes/*" $name]} {
507             if {![string match "*/HEAD" $name]} {
508                 set headids($name) $id
509                 lappend idheads($id) $name
510             }
511         } elseif {[string match "heads/*" $name]} {
512             set name [string range $name 6 end]
513             set headids($name) $id
514             lappend idheads($id) $name
515         } elseif {[string match "tags/*" $name]} {
516             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
517             # which is what we want since the former is the commit ID
518             set name [string range $name 5 end]
519             if {[string match "*^{}" $name]} {
520                 set name [string range $name 0 end-3]
521             } else {
522                 set tagobjid($name) $id
523             }
524             set tagids($name) $id
525             lappend idtags($id) $name
526         } else {
527             set otherrefids($name) $id
528             lappend idotherrefs($id) $name
529         }
530     }
531     catch {close $refd}
532     set mainhead {}
533     set mainheadid {}
534     catch {
535         set thehead [exec git symbolic-ref HEAD]
536         if {[string match "refs/heads/*" $thehead]} {
537             set mainhead [string range $thehead 11 end]
538             if {[info exists headids($mainhead)]} {
539                 set mainheadid $headids($mainhead)
540             }
541         }
542     }
543 }
544
545 # skip over fake commits
546 proc first_real_row {} {
547     global nullid nullid2 displayorder numcommits
548
549     for {set row 0} {$row < $numcommits} {incr row} {
550         set id [lindex $displayorder $row]
551         if {$id ne $nullid && $id ne $nullid2} {
552             break
553         }
554     }
555     return $row
556 }
557
558 # update things for a head moved to a child of its previous location
559 proc movehead {id name} {
560     global headids idheads
561
562     removehead $headids($name) $name
563     set headids($name) $id
564     lappend idheads($id) $name
565 }
566
567 # update things when a head has been removed
568 proc removehead {id name} {
569     global headids idheads
570
571     if {$idheads($id) eq $name} {
572         unset idheads($id)
573     } else {
574         set i [lsearch -exact $idheads($id) $name]
575         if {$i >= 0} {
576             set idheads($id) [lreplace $idheads($id) $i $i]
577         }
578     }
579     unset headids($name)
580 }
581
582 proc show_error {w top msg} {
583     message $w.m -text $msg -justify center -aspect 400
584     pack $w.m -side top -fill x -padx 20 -pady 20
585     button $w.ok -text [mc OK] -command "destroy $top"
586     pack $w.ok -side bottom -fill x
587     bind $top <Visibility> "grab $top; focus $top"
588     bind $top <Key-Return> "destroy $top"
589     tkwait window $top
590 }
591
592 proc error_popup msg {
593     set w .error
594     toplevel $w
595     wm transient $w .
596     show_error $w $w $msg
597 }
598
599 proc confirm_popup msg {
600     global confirm_ok
601     set confirm_ok 0
602     set w .confirm
603     toplevel $w
604     wm transient $w .
605     message $w.m -text $msg -justify center -aspect 400
606     pack $w.m -side top -fill x -padx 20 -pady 20
607     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
608     pack $w.ok -side left -fill x
609     button $w.cancel -text [mc Cancel] -command "destroy $w"
610     pack $w.cancel -side right -fill x
611     bind $w <Visibility> "grab $w; focus $w"
612     tkwait window $w
613     return $confirm_ok
614 }
615
616 proc setoptions {} {
617     option add *Panedwindow.showHandle 1 startupFile
618     option add *Panedwindow.sashRelief raised startupFile
619     option add *Button.font uifont startupFile
620     option add *Checkbutton.font uifont startupFile
621     option add *Radiobutton.font uifont startupFile
622     option add *Menu.font uifont startupFile
623     option add *Menubutton.font uifont startupFile
624     option add *Label.font uifont startupFile
625     option add *Message.font uifont startupFile
626     option add *Entry.font uifont startupFile
627 }
628
629 proc makewindow {} {
630     global canv canv2 canv3 linespc charspc ctext cflist
631     global tabstop
632     global findtype findtypemenu findloc findstring fstring geometry
633     global entries sha1entry sha1string sha1but
634     global diffcontextstring diffcontext
635     global ignorespace
636     global maincursor textcursor curtextcursor
637     global rowctxmenu fakerowmenu mergemax wrapcomment
638     global highlight_files gdttype
639     global searchstring sstring
640     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
641     global headctxmenu progresscanv progressitem progresscoords statusw
642     global fprogitem fprogcoord lastprogupdate progupdatepending
643     global rprogitem rprogcoord
644     global have_tk85
645
646     menu .bar
647     .bar add cascade -label [mc "File"] -menu .bar.file
648     menu .bar.file
649     .bar.file add command -label [mc "Update"] -command updatecommits
650     .bar.file add command -label [mc "Reread references"] -command rereadrefs
651     .bar.file add command -label [mc "List references"] -command showrefs
652     .bar.file add command -label [mc "Quit"] -command doquit
653     menu .bar.edit
654     .bar add cascade -label [mc "Edit"] -menu .bar.edit
655     .bar.edit add command -label [mc "Preferences"] -command doprefs
656
657     menu .bar.view
658     .bar add cascade -label [mc "View"] -menu .bar.view
659     .bar.view add command -label [mc "New view..."] -command {newview 0}
660     .bar.view add command -label [mc "Edit view..."] -command editview \
661         -state disabled
662     .bar.view add command -label [mc "Delete view"] -command delview -state disabled
663     .bar.view add separator
664     .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
665         -variable selectedview -value 0
666
667     menu .bar.help
668     .bar add cascade -label [mc "Help"] -menu .bar.help
669     .bar.help add command -label [mc "About gitk"] -command about
670     .bar.help add command -label [mc "Key bindings"] -command keys
671     .bar.help configure
672     . configure -menu .bar
673
674     # the gui has upper and lower half, parts of a paned window.
675     panedwindow .ctop -orient vertical
676
677     # possibly use assumed geometry
678     if {![info exists geometry(pwsash0)]} {
679         set geometry(topheight) [expr {15 * $linespc}]
680         set geometry(topwidth) [expr {80 * $charspc}]
681         set geometry(botheight) [expr {15 * $linespc}]
682         set geometry(botwidth) [expr {50 * $charspc}]
683         set geometry(pwsash0) "[expr {40 * $charspc}] 2"
684         set geometry(pwsash1) "[expr {60 * $charspc}] 2"
685     }
686
687     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
688     frame .tf -height $geometry(topheight) -width $geometry(topwidth)
689     frame .tf.histframe
690     panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
691
692     # create three canvases
693     set cscroll .tf.histframe.csb
694     set canv .tf.histframe.pwclist.canv
695     canvas $canv \
696         -selectbackground $selectbgcolor \
697         -background $bgcolor -bd 0 \
698         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
699     .tf.histframe.pwclist add $canv
700     set canv2 .tf.histframe.pwclist.canv2
701     canvas $canv2 \
702         -selectbackground $selectbgcolor \
703         -background $bgcolor -bd 0 -yscrollincr $linespc
704     .tf.histframe.pwclist add $canv2
705     set canv3 .tf.histframe.pwclist.canv3
706     canvas $canv3 \
707         -selectbackground $selectbgcolor \
708         -background $bgcolor -bd 0 -yscrollincr $linespc
709     .tf.histframe.pwclist add $canv3
710     eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
711     eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
712
713     # a scroll bar to rule them
714     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
715     pack $cscroll -side right -fill y
716     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
717     lappend bglist $canv $canv2 $canv3
718     pack .tf.histframe.pwclist -fill both -expand 1 -side left
719
720     # we have two button bars at bottom of top frame. Bar 1
721     frame .tf.bar
722     frame .tf.lbar -height 15
723
724     set sha1entry .tf.bar.sha1
725     set entries $sha1entry
726     set sha1but .tf.bar.sha1label
727     button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
728         -command gotocommit -width 8
729     $sha1but conf -disabledforeground [$sha1but cget -foreground]
730     pack .tf.bar.sha1label -side left
731     entry $sha1entry -width 40 -font textfont -textvariable sha1string
732     trace add variable sha1string write sha1change
733     pack $sha1entry -side left -pady 2
734
735     image create bitmap bm-left -data {
736         #define left_width 16
737         #define left_height 16
738         static unsigned char left_bits[] = {
739         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
740         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
741         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
742     }
743     image create bitmap bm-right -data {
744         #define right_width 16
745         #define right_height 16
746         static unsigned char right_bits[] = {
747         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
748         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
749         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
750     }
751     button .tf.bar.leftbut -image bm-left -command goback \
752         -state disabled -width 26
753     pack .tf.bar.leftbut -side left -fill y
754     button .tf.bar.rightbut -image bm-right -command goforw \
755         -state disabled -width 26
756     pack .tf.bar.rightbut -side left -fill y
757
758     # Status label and progress bar
759     set statusw .tf.bar.status
760     label $statusw -width 15 -relief sunken
761     pack $statusw -side left -padx 5
762     set h [expr {[font metrics uifont -linespace] + 2}]
763     set progresscanv .tf.bar.progress
764     canvas $progresscanv -relief sunken -height $h -borderwidth 2
765     set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
766     set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
767     set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
768     pack $progresscanv -side right -expand 1 -fill x
769     set progresscoords {0 0}
770     set fprogcoord 0
771     set rprogcoord 0
772     bind $progresscanv <Configure> adjustprogress
773     set lastprogupdate [clock clicks -milliseconds]
774     set progupdatepending 0
775
776     # build up the bottom bar of upper window
777     label .tf.lbar.flabel -text "[mc "Find"] "
778     button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
779     button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
780     label .tf.lbar.flab2 -text " [mc "commit"] "
781     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
782         -side left -fill y
783     set gdttype [mc "containing:"]
784     set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
785                 [mc "containing:"] \
786                 [mc "touching paths:"] \
787                 [mc "adding/removing string:"]]
788     trace add variable gdttype write gdttype_change
789     pack .tf.lbar.gdttype -side left -fill y
790
791     set findstring {}
792     set fstring .tf.lbar.findstring
793     lappend entries $fstring
794     entry $fstring -width 30 -font textfont -textvariable findstring
795     trace add variable findstring write find_change
796     set findtype [mc "Exact"]
797     set findtypemenu [tk_optionMenu .tf.lbar.findtype \
798                       findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
799     trace add variable findtype write findcom_change
800     set findloc [mc "All fields"]
801     tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
802         [mc "Comments"] [mc "Author"] [mc "Committer"]
803     trace add variable findloc write find_change
804     pack .tf.lbar.findloc -side right
805     pack .tf.lbar.findtype -side right
806     pack $fstring -side left -expand 1 -fill x
807
808     # Finish putting the upper half of the viewer together
809     pack .tf.lbar -in .tf -side bottom -fill x
810     pack .tf.bar -in .tf -side bottom -fill x
811     pack .tf.histframe -fill both -side top -expand 1
812     .ctop add .tf
813     .ctop paneconfigure .tf -height $geometry(topheight)
814     .ctop paneconfigure .tf -width $geometry(topwidth)
815
816     # now build up the bottom
817     panedwindow .pwbottom -orient horizontal
818
819     # lower left, a text box over search bar, scroll bar to the right
820     # if we know window height, then that will set the lower text height, otherwise
821     # we set lower text height which will drive window height
822     if {[info exists geometry(main)]} {
823         frame .bleft -width $geometry(botwidth)
824     } else {
825         frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
826     }
827     frame .bleft.top
828     frame .bleft.mid
829
830     button .bleft.top.search -text [mc "Search"] -command dosearch
831     pack .bleft.top.search -side left -padx 5
832     set sstring .bleft.top.sstring
833     entry $sstring -width 20 -font textfont -textvariable searchstring
834     lappend entries $sstring
835     trace add variable searchstring write incrsearch
836     pack $sstring -side left -expand 1 -fill x
837     radiobutton .bleft.mid.diff -text [mc "Diff"] \
838         -command changediffdisp -variable diffelide -value {0 0}
839     radiobutton .bleft.mid.old -text [mc "Old version"] \
840         -command changediffdisp -variable diffelide -value {0 1}
841     radiobutton .bleft.mid.new -text [mc "New version"] \
842         -command changediffdisp -variable diffelide -value {1 0}
843     label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
844     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
845     spinbox .bleft.mid.diffcontext -width 5 -font textfont \
846         -from 1 -increment 1 -to 10000000 \
847         -validate all -validatecommand "diffcontextvalidate %P" \
848         -textvariable diffcontextstring
849     .bleft.mid.diffcontext set $diffcontext
850     trace add variable diffcontextstring write diffcontextchange
851     lappend entries .bleft.mid.diffcontext
852     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
853     checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
854         -command changeignorespace -variable ignorespace
855     pack .bleft.mid.ignspace -side left -padx 5
856     set ctext .bleft.ctext
857     text $ctext -background $bgcolor -foreground $fgcolor \
858         -state disabled -font textfont \
859         -yscrollcommand scrolltext -wrap none
860     if {$have_tk85} {
861         $ctext conf -tabstyle wordprocessor
862     }
863     scrollbar .bleft.sb -command "$ctext yview"
864     pack .bleft.top -side top -fill x
865     pack .bleft.mid -side top -fill x
866     pack .bleft.sb -side right -fill y
867     pack $ctext -side left -fill both -expand 1
868     lappend bglist $ctext
869     lappend fglist $ctext
870
871     $ctext tag conf comment -wrap $wrapcomment
872     $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
873     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
874     $ctext tag conf d0 -fore [lindex $diffcolors 0]
875     $ctext tag conf d1 -fore [lindex $diffcolors 1]
876     $ctext tag conf m0 -fore red
877     $ctext tag conf m1 -fore blue
878     $ctext tag conf m2 -fore green
879     $ctext tag conf m3 -fore purple
880     $ctext tag conf m4 -fore brown
881     $ctext tag conf m5 -fore "#009090"
882     $ctext tag conf m6 -fore magenta
883     $ctext tag conf m7 -fore "#808000"
884     $ctext tag conf m8 -fore "#009000"
885     $ctext tag conf m9 -fore "#ff0080"
886     $ctext tag conf m10 -fore cyan
887     $ctext tag conf m11 -fore "#b07070"
888     $ctext tag conf m12 -fore "#70b0f0"
889     $ctext tag conf m13 -fore "#70f0b0"
890     $ctext tag conf m14 -fore "#f0b070"
891     $ctext tag conf m15 -fore "#ff70b0"
892     $ctext tag conf mmax -fore darkgrey
893     set mergemax 16
894     $ctext tag conf mresult -font textfontbold
895     $ctext tag conf msep -font textfontbold
896     $ctext tag conf found -back yellow
897
898     .pwbottom add .bleft
899     .pwbottom paneconfigure .bleft -width $geometry(botwidth)
900
901     # lower right
902     frame .bright
903     frame .bright.mode
904     radiobutton .bright.mode.patch -text [mc "Patch"] \
905         -command reselectline -variable cmitmode -value "patch"
906     radiobutton .bright.mode.tree -text [mc "Tree"] \
907         -command reselectline -variable cmitmode -value "tree"
908     grid .bright.mode.patch .bright.mode.tree -sticky ew
909     pack .bright.mode -side top -fill x
910     set cflist .bright.cfiles
911     set indent [font measure mainfont "nn"]
912     text $cflist \
913         -selectbackground $selectbgcolor \
914         -background $bgcolor -foreground $fgcolor \
915         -font mainfont \
916         -tabs [list $indent [expr {2 * $indent}]] \
917         -yscrollcommand ".bright.sb set" \
918         -cursor [. cget -cursor] \
919         -spacing1 1 -spacing3 1
920     lappend bglist $cflist
921     lappend fglist $cflist
922     scrollbar .bright.sb -command "$cflist yview"
923     pack .bright.sb -side right -fill y
924     pack $cflist -side left -fill both -expand 1
925     $cflist tag configure highlight \
926         -background [$cflist cget -selectbackground]
927     $cflist tag configure bold -font mainfontbold
928
929     .pwbottom add .bright
930     .ctop add .pwbottom
931
932     # restore window position if known
933     if {[info exists geometry(main)]} {
934         wm geometry . "$geometry(main)"
935     }
936
937     if {[tk windowingsystem] eq {aqua}} {
938         set M1B M1
939     } else {
940         set M1B Control
941     }
942
943     bind .pwbottom <Configure> {resizecdetpanes %W %w}
944     pack .ctop -fill both -expand 1
945     bindall <1> {selcanvline %W %x %y}
946     #bindall <B1-Motion> {selcanvline %W %x %y}
947     if {[tk windowingsystem] == "win32"} {
948         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
949         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
950     } else {
951         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
952         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
953         if {[tk windowingsystem] eq "aqua"} {
954             bindall <MouseWheel> {
955                 set delta [expr {- (%D)}]
956                 allcanvs yview scroll $delta units
957             }
958         }
959     }
960     bindall <2> "canvscan mark %W %x %y"
961     bindall <B2-Motion> "canvscan dragto %W %x %y"
962     bindkey <Home> selfirstline
963     bindkey <End> sellastline
964     bind . <Key-Up> "selnextline -1"
965     bind . <Key-Down> "selnextline 1"
966     bind . <Shift-Key-Up> "dofind -1 0"
967     bind . <Shift-Key-Down> "dofind 1 0"
968     bindkey <Key-Right> "goforw"
969     bindkey <Key-Left> "goback"
970     bind . <Key-Prior> "selnextpage -1"
971     bind . <Key-Next> "selnextpage 1"
972     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
973     bind . <$M1B-End> "allcanvs yview moveto 1.0"
974     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
975     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
976     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
977     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
978     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
979     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
980     bindkey <Key-space> "$ctext yview scroll 1 pages"
981     bindkey p "selnextline -1"
982     bindkey n "selnextline 1"
983     bindkey z "goback"
984     bindkey x "goforw"
985     bindkey i "selnextline -1"
986     bindkey k "selnextline 1"
987     bindkey j "goback"
988     bindkey l "goforw"
989     bindkey b "$ctext yview scroll -1 pages"
990     bindkey d "$ctext yview scroll 18 units"
991     bindkey u "$ctext yview scroll -18 units"
992     bindkey / {dofind 1 1}
993     bindkey <Key-Return> {dofind 1 1}
994     bindkey ? {dofind -1 1}
995     bindkey f nextfile
996     bindkey <F5> updatecommits
997     bind . <$M1B-q> doquit
998     bind . <$M1B-f> {dofind 1 1}
999     bind . <$M1B-g> {dofind 1 0}
1000     bind . <$M1B-r> dosearchback
1001     bind . <$M1B-s> dosearch
1002     bind . <$M1B-equal> {incrfont 1}
1003     bind . <$M1B-plus> {incrfont 1}
1004     bind . <$M1B-KP_Add> {incrfont 1}
1005     bind . <$M1B-minus> {incrfont -1}
1006     bind . <$M1B-KP_Subtract> {incrfont -1}
1007     wm protocol . WM_DELETE_WINDOW doquit
1008     bind . <Button-1> "click %W"
1009     bind $fstring <Key-Return> {dofind 1 1}
1010     bind $sha1entry <Key-Return> gotocommit
1011     bind $sha1entry <<PasteSelection>> clearsha1
1012     bind $cflist <1> {sel_flist %W %x %y; break}
1013     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1014     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1015     bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1016
1017     set maincursor [. cget -cursor]
1018     set textcursor [$ctext cget -cursor]
1019     set curtextcursor $textcursor
1020
1021     set rowctxmenu .rowctxmenu
1022     menu $rowctxmenu -tearoff 0
1023     $rowctxmenu add command -label [mc "Diff this -> selected"] \
1024         -command {diffvssel 0}
1025     $rowctxmenu add command -label [mc "Diff selected -> this"] \
1026         -command {diffvssel 1}
1027     $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1028     $rowctxmenu add command -label [mc "Create tag"] -command mktag
1029     $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1030     $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1031     $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1032         -command cherrypick
1033     $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1034         -command resethead
1035
1036     set fakerowmenu .fakerowmenu
1037     menu $fakerowmenu -tearoff 0
1038     $fakerowmenu add command -label [mc "Diff this -> selected"] \
1039         -command {diffvssel 0}
1040     $fakerowmenu add command -label [mc "Diff selected -> this"] \
1041         -command {diffvssel 1}
1042     $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1043 #    $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1044 #    $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1045 #    $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1046
1047     set headctxmenu .headctxmenu
1048     menu $headctxmenu -tearoff 0
1049     $headctxmenu add command -label [mc "Check out this branch"] \
1050         -command cobranch
1051     $headctxmenu add command -label [mc "Remove this branch"] \
1052         -command rmbranch
1053
1054     global flist_menu
1055     set flist_menu .flistctxmenu
1056     menu $flist_menu -tearoff 0
1057     $flist_menu add command -label [mc "Highlight this too"] \
1058         -command {flist_hl 0}
1059     $flist_menu add command -label [mc "Highlight this only"] \
1060         -command {flist_hl 1}
1061 }
1062
1063 # Windows sends all mouse wheel events to the current focused window, not
1064 # the one where the mouse hovers, so bind those events here and redirect
1065 # to the correct window
1066 proc windows_mousewheel_redirector {W X Y D} {
1067     global canv canv2 canv3
1068     set w [winfo containing -displayof $W $X $Y]
1069     if {$w ne ""} {
1070         set u [expr {$D < 0 ? 5 : -5}]
1071         if {$w == $canv || $w == $canv2 || $w == $canv3} {
1072             allcanvs yview scroll $u units
1073         } else {
1074             catch {
1075                 $w yview scroll $u units
1076             }
1077         }
1078     }
1079 }
1080
1081 # mouse-2 makes all windows scan vertically, but only the one
1082 # the cursor is in scans horizontally
1083 proc canvscan {op w x y} {
1084     global canv canv2 canv3
1085     foreach c [list $canv $canv2 $canv3] {
1086         if {$c == $w} {
1087             $c scan $op $x $y
1088         } else {
1089             $c scan $op 0 $y
1090         }
1091     }
1092 }
1093
1094 proc scrollcanv {cscroll f0 f1} {
1095     $cscroll set $f0 $f1
1096     drawfrac $f0 $f1
1097     flushhighlights
1098 }
1099
1100 # when we make a key binding for the toplevel, make sure
1101 # it doesn't get triggered when that key is pressed in the
1102 # find string entry widget.
1103 proc bindkey {ev script} {
1104     global entries
1105     bind . $ev $script
1106     set escript [bind Entry $ev]
1107     if {$escript == {}} {
1108         set escript [bind Entry <Key>]
1109     }
1110     foreach e $entries {
1111         bind $e $ev "$escript; break"
1112     }
1113 }
1114
1115 # set the focus back to the toplevel for any click outside
1116 # the entry widgets
1117 proc click {w} {
1118     global ctext entries
1119     foreach e [concat $entries $ctext] {
1120         if {$w == $e} return
1121     }
1122     focus .
1123 }
1124
1125 # Adjust the progress bar for a change in requested extent or canvas size
1126 proc adjustprogress {} {
1127     global progresscanv progressitem progresscoords
1128     global fprogitem fprogcoord lastprogupdate progupdatepending
1129     global rprogitem rprogcoord
1130
1131     set w [expr {[winfo width $progresscanv] - 4}]
1132     set x0 [expr {$w * [lindex $progresscoords 0]}]
1133     set x1 [expr {$w * [lindex $progresscoords 1]}]
1134     set h [winfo height $progresscanv]
1135     $progresscanv coords $progressitem $x0 0 $x1 $h
1136     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1137     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1138     set now [clock clicks -milliseconds]
1139     if {$now >= $lastprogupdate + 100} {
1140         set progupdatepending 0
1141         update
1142     } elseif {!$progupdatepending} {
1143         set progupdatepending 1
1144         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1145     }
1146 }
1147
1148 proc doprogupdate {} {
1149     global lastprogupdate progupdatepending
1150
1151     if {$progupdatepending} {
1152         set progupdatepending 0
1153         set lastprogupdate [clock clicks -milliseconds]
1154         update
1155     }
1156 }
1157
1158 proc savestuff {w} {
1159     global canv canv2 canv3 mainfont textfont uifont tabstop
1160     global stuffsaved findmergefiles maxgraphpct
1161     global maxwidth showneartags showlocalchanges
1162     global viewname viewfiles viewargs viewperm nextviewnum
1163     global cmitmode wrapcomment datetimeformat limitdiffs
1164     global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1165
1166     if {$stuffsaved} return
1167     if {![winfo viewable .]} return
1168     catch {
1169         set f [open "~/.gitk-new" w]
1170         puts $f [list set mainfont $mainfont]
1171         puts $f [list set textfont $textfont]
1172         puts $f [list set uifont $uifont]
1173         puts $f [list set tabstop $tabstop]
1174         puts $f [list set findmergefiles $findmergefiles]
1175         puts $f [list set maxgraphpct $maxgraphpct]
1176         puts $f [list set maxwidth $maxwidth]
1177         puts $f [list set cmitmode $cmitmode]
1178         puts $f [list set wrapcomment $wrapcomment]
1179         puts $f [list set showneartags $showneartags]
1180         puts $f [list set showlocalchanges $showlocalchanges]
1181         puts $f [list set datetimeformat $datetimeformat]
1182         puts $f [list set limitdiffs $limitdiffs]
1183         puts $f [list set bgcolor $bgcolor]
1184         puts $f [list set fgcolor $fgcolor]
1185         puts $f [list set colors $colors]
1186         puts $f [list set diffcolors $diffcolors]
1187         puts $f [list set diffcontext $diffcontext]
1188         puts $f [list set selectbgcolor $selectbgcolor]
1189
1190         puts $f "set geometry(main) [wm geometry .]"
1191         puts $f "set geometry(topwidth) [winfo width .tf]"
1192         puts $f "set geometry(topheight) [winfo height .tf]"
1193         puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1194         puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1195         puts $f "set geometry(botwidth) [winfo width .bleft]"
1196         puts $f "set geometry(botheight) [winfo height .bleft]"
1197
1198         puts -nonewline $f "set permviews {"
1199         for {set v 0} {$v < $nextviewnum} {incr v} {
1200             if {$viewperm($v)} {
1201                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1202             }
1203         }
1204         puts $f "}"
1205         close $f
1206         file rename -force "~/.gitk-new" "~/.gitk"
1207     }
1208     set stuffsaved 1
1209 }
1210
1211 proc resizeclistpanes {win w} {
1212     global oldwidth
1213     if {[info exists oldwidth($win)]} {
1214         set s0 [$win sash coord 0]
1215         set s1 [$win sash coord 1]
1216         if {$w < 60} {
1217             set sash0 [expr {int($w/2 - 2)}]
1218             set sash1 [expr {int($w*5/6 - 2)}]
1219         } else {
1220             set factor [expr {1.0 * $w / $oldwidth($win)}]
1221             set sash0 [expr {int($factor * [lindex $s0 0])}]
1222             set sash1 [expr {int($factor * [lindex $s1 0])}]
1223             if {$sash0 < 30} {
1224                 set sash0 30
1225             }
1226             if {$sash1 < $sash0 + 20} {
1227                 set sash1 [expr {$sash0 + 20}]
1228             }
1229             if {$sash1 > $w - 10} {
1230                 set sash1 [expr {$w - 10}]
1231                 if {$sash0 > $sash1 - 20} {
1232                     set sash0 [expr {$sash1 - 20}]
1233                 }
1234             }
1235         }
1236         $win sash place 0 $sash0 [lindex $s0 1]
1237         $win sash place 1 $sash1 [lindex $s1 1]
1238     }
1239     set oldwidth($win) $w
1240 }
1241
1242 proc resizecdetpanes {win w} {
1243     global oldwidth
1244     if {[info exists oldwidth($win)]} {
1245         set s0 [$win sash coord 0]
1246         if {$w < 60} {
1247             set sash0 [expr {int($w*3/4 - 2)}]
1248         } else {
1249             set factor [expr {1.0 * $w / $oldwidth($win)}]
1250             set sash0 [expr {int($factor * [lindex $s0 0])}]
1251             if {$sash0 < 45} {
1252                 set sash0 45
1253             }
1254             if {$sash0 > $w - 15} {
1255                 set sash0 [expr {$w - 15}]
1256             }
1257         }
1258         $win sash place 0 $sash0 [lindex $s0 1]
1259     }
1260     set oldwidth($win) $w
1261 }
1262
1263 proc allcanvs args {
1264     global canv canv2 canv3
1265     eval $canv $args
1266     eval $canv2 $args
1267     eval $canv3 $args
1268 }
1269
1270 proc bindall {event action} {
1271     global canv canv2 canv3
1272     bind $canv $event $action
1273     bind $canv2 $event $action
1274     bind $canv3 $event $action
1275 }
1276
1277 proc about {} {
1278     global uifont
1279     set w .about
1280     if {[winfo exists $w]} {
1281         raise $w
1282         return
1283     }
1284     toplevel $w
1285     wm title $w [mc "About gitk"]
1286     message $w.m -text [mc "
1287 Gitk - a commit viewer for git
1288
1289 Copyright Â© 2005-2006 Paul Mackerras
1290
1291 Use and redistribute under the terms of the GNU General Public License"] \
1292             -justify center -aspect 400 -border 2 -bg white -relief groove
1293     pack $w.m -side top -fill x -padx 2 -pady 2
1294     button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1295     pack $w.ok -side bottom
1296     bind $w <Visibility> "focus $w.ok"
1297     bind $w <Key-Escape> "destroy $w"
1298     bind $w <Key-Return> "destroy $w"
1299 }
1300
1301 proc keys {} {
1302     set w .keys
1303     if {[winfo exists $w]} {
1304         raise $w
1305         return
1306     }
1307     if {[tk windowingsystem] eq {aqua}} {
1308         set M1T Cmd
1309     } else {
1310         set M1T Ctrl
1311     }
1312     toplevel $w
1313     wm title $w [mc "Gitk key bindings"]
1314     message $w.m -text "
1315 [mc "Gitk key bindings:"]
1316
1317 [mc "<%s-Q>             Quit" $M1T]
1318 [mc "<Home>             Move to first commit"]
1319 [mc "<End>              Move to last commit"]
1320 [mc "<Up>, p, i Move up one commit"]
1321 [mc "<Down>, n, k       Move down one commit"]
1322 [mc "<Left>, z, j       Go back in history list"]
1323 [mc "<Right>, x, l      Go forward in history list"]
1324 [mc "<PageUp>   Move up one page in commit list"]
1325 [mc "<PageDown> Move down one page in commit list"]
1326 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
1327 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
1328 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
1329 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
1330 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
1331 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
1332 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
1333 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
1334 [mc "<Delete>, b        Scroll diff view up one page"]
1335 [mc "<Backspace>        Scroll diff view up one page"]
1336 [mc "<Space>            Scroll diff view down one page"]
1337 [mc "u          Scroll diff view up 18 lines"]
1338 [mc "d          Scroll diff view down 18 lines"]
1339 [mc "<%s-F>             Find" $M1T]
1340 [mc "<%s-G>             Move to next find hit" $M1T]
1341 [mc "<Return>   Move to next find hit"]
1342 [mc "/          Move to next find hit, or redo find"]
1343 [mc "?          Move to previous find hit"]
1344 [mc "f          Scroll diff view to next file"]
1345 [mc "<%s-S>             Search for next hit in diff view" $M1T]
1346 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
1347 [mc "<%s-KP+>   Increase font size" $M1T]
1348 [mc "<%s-plus>  Increase font size" $M1T]
1349 [mc "<%s-KP->   Decrease font size" $M1T]
1350 [mc "<%s-minus> Decrease font size" $M1T]
1351 [mc "<F5>               Update"]
1352 " \
1353             -justify left -bg white -border 2 -relief groove
1354     pack $w.m -side top -fill both -padx 2 -pady 2
1355     button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1356     pack $w.ok -side bottom
1357     bind $w <Visibility> "focus $w.ok"
1358     bind $w <Key-Escape> "destroy $w"
1359     bind $w <Key-Return> "destroy $w"
1360 }
1361
1362 # Procedures for manipulating the file list window at the
1363 # bottom right of the overall window.
1364
1365 proc treeview {w l openlevs} {
1366     global treecontents treediropen treeheight treeparent treeindex
1367
1368     set ix 0
1369     set treeindex() 0
1370     set lev 0
1371     set prefix {}
1372     set prefixend -1
1373     set prefendstack {}
1374     set htstack {}
1375     set ht 0
1376     set treecontents() {}
1377     $w conf -state normal
1378     foreach f $l {
1379         while {[string range $f 0 $prefixend] ne $prefix} {
1380             if {$lev <= $openlevs} {
1381                 $w mark set e:$treeindex($prefix) "end -1c"
1382                 $w mark gravity e:$treeindex($prefix) left
1383             }
1384             set treeheight($prefix) $ht
1385             incr ht [lindex $htstack end]
1386             set htstack [lreplace $htstack end end]
1387             set prefixend [lindex $prefendstack end]
1388             set prefendstack [lreplace $prefendstack end end]
1389             set prefix [string range $prefix 0 $prefixend]
1390             incr lev -1
1391         }
1392         set tail [string range $f [expr {$prefixend+1}] end]
1393         while {[set slash [string first "/" $tail]] >= 0} {
1394             lappend htstack $ht
1395             set ht 0
1396             lappend prefendstack $prefixend
1397             incr prefixend [expr {$slash + 1}]
1398             set d [string range $tail 0 $slash]
1399             lappend treecontents($prefix) $d
1400             set oldprefix $prefix
1401             append prefix $d
1402             set treecontents($prefix) {}
1403             set treeindex($prefix) [incr ix]
1404             set treeparent($prefix) $oldprefix
1405             set tail [string range $tail [expr {$slash+1}] end]
1406             if {$lev <= $openlevs} {
1407                 set ht 1
1408                 set treediropen($prefix) [expr {$lev < $openlevs}]
1409                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1410                 $w mark set d:$ix "end -1c"
1411                 $w mark gravity d:$ix left
1412                 set str "\n"
1413                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1414                 $w insert end $str
1415                 $w image create end -align center -image $bm -padx 1 \
1416                     -name a:$ix
1417                 $w insert end $d [highlight_tag $prefix]
1418                 $w mark set s:$ix "end -1c"
1419                 $w mark gravity s:$ix left
1420             }
1421             incr lev
1422         }
1423         if {$tail ne {}} {
1424             if {$lev <= $openlevs} {
1425                 incr ht
1426                 set str "\n"
1427                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1428                 $w insert end $str
1429                 $w insert end $tail [highlight_tag $f]
1430             }
1431             lappend treecontents($prefix) $tail
1432         }
1433     }
1434     while {$htstack ne {}} {
1435         set treeheight($prefix) $ht
1436         incr ht [lindex $htstack end]
1437         set htstack [lreplace $htstack end end]
1438         set prefixend [lindex $prefendstack end]
1439         set prefendstack [lreplace $prefendstack end end]
1440         set prefix [string range $prefix 0 $prefixend]
1441     }
1442     $w conf -state disabled
1443 }
1444
1445 proc linetoelt {l} {
1446     global treeheight treecontents
1447
1448     set y 2
1449     set prefix {}
1450     while {1} {
1451         foreach e $treecontents($prefix) {
1452             if {$y == $l} {
1453                 return "$prefix$e"
1454             }
1455             set n 1
1456             if {[string index $e end] eq "/"} {
1457                 set n $treeheight($prefix$e)
1458                 if {$y + $n > $l} {
1459                     append prefix $e
1460                     incr y
1461                     break
1462                 }
1463             }
1464             incr y $n
1465         }
1466     }
1467 }
1468
1469 proc highlight_tree {y prefix} {
1470     global treeheight treecontents cflist
1471
1472     foreach e $treecontents($prefix) {
1473         set path $prefix$e
1474         if {[highlight_tag $path] ne {}} {
1475             $cflist tag add bold $y.0 "$y.0 lineend"
1476         }
1477         incr y
1478         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1479             set y [highlight_tree $y $path]
1480         }
1481     }
1482     return $y
1483 }
1484
1485 proc treeclosedir {w dir} {
1486     global treediropen treeheight treeparent treeindex
1487
1488     set ix $treeindex($dir)
1489     $w conf -state normal
1490     $w delete s:$ix e:$ix
1491     set treediropen($dir) 0
1492     $w image configure a:$ix -image tri-rt
1493     $w conf -state disabled
1494     set n [expr {1 - $treeheight($dir)}]
1495     while {$dir ne {}} {
1496         incr treeheight($dir) $n
1497         set dir $treeparent($dir)
1498     }
1499 }
1500
1501 proc treeopendir {w dir} {
1502     global treediropen treeheight treeparent treecontents treeindex
1503
1504     set ix $treeindex($dir)
1505     $w conf -state normal
1506     $w image configure a:$ix -image tri-dn
1507     $w mark set e:$ix s:$ix
1508     $w mark gravity e:$ix right
1509     set lev 0
1510     set str "\n"
1511     set n [llength $treecontents($dir)]
1512     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1513         incr lev
1514         append str "\t"
1515         incr treeheight($x) $n
1516     }
1517     foreach e $treecontents($dir) {
1518         set de $dir$e
1519         if {[string index $e end] eq "/"} {
1520             set iy $treeindex($de)
1521             $w mark set d:$iy e:$ix
1522             $w mark gravity d:$iy left
1523             $w insert e:$ix $str
1524             set treediropen($de) 0
1525             $w image create e:$ix -align center -image tri-rt -padx 1 \
1526                 -name a:$iy
1527             $w insert e:$ix $e [highlight_tag $de]
1528             $w mark set s:$iy e:$ix
1529             $w mark gravity s:$iy left
1530             set treeheight($de) 1
1531         } else {
1532             $w insert e:$ix $str
1533             $w insert e:$ix $e [highlight_tag $de]
1534         }
1535     }
1536     $w mark gravity e:$ix left
1537     $w conf -state disabled
1538     set treediropen($dir) 1
1539     set top [lindex [split [$w index @0,0] .] 0]
1540     set ht [$w cget -height]
1541     set l [lindex [split [$w index s:$ix] .] 0]
1542     if {$l < $top} {
1543         $w yview $l.0
1544     } elseif {$l + $n + 1 > $top + $ht} {
1545         set top [expr {$l + $n + 2 - $ht}]
1546         if {$l < $top} {
1547             set top $l
1548         }
1549         $w yview $top.0
1550     }
1551 }
1552
1553 proc treeclick {w x y} {
1554     global treediropen cmitmode ctext cflist cflist_top
1555
1556     if {$cmitmode ne "tree"} return
1557     if {![info exists cflist_top]} return
1558     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1559     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1560     $cflist tag add highlight $l.0 "$l.0 lineend"
1561     set cflist_top $l
1562     if {$l == 1} {
1563         $ctext yview 1.0
1564         return
1565     }
1566     set e [linetoelt $l]
1567     if {[string index $e end] ne "/"} {
1568         showfile $e
1569     } elseif {$treediropen($e)} {
1570         treeclosedir $w $e
1571     } else {
1572         treeopendir $w $e
1573     }
1574 }
1575
1576 proc setfilelist {id} {
1577     global treefilelist cflist
1578
1579     treeview $cflist $treefilelist($id) 0
1580 }
1581
1582 image create bitmap tri-rt -background black -foreground blue -data {
1583     #define tri-rt_width 13
1584     #define tri-rt_height 13
1585     static unsigned char tri-rt_bits[] = {
1586        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1587        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1588        0x00, 0x00};
1589 } -maskdata {
1590     #define tri-rt-mask_width 13
1591     #define tri-rt-mask_height 13
1592     static unsigned char tri-rt-mask_bits[] = {
1593        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1594        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1595        0x08, 0x00};
1596 }
1597 image create bitmap tri-dn -background black -foreground blue -data {
1598     #define tri-dn_width 13
1599     #define tri-dn_height 13
1600     static unsigned char tri-dn_bits[] = {
1601        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1602        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1603        0x00, 0x00};
1604 } -maskdata {
1605     #define tri-dn-mask_width 13
1606     #define tri-dn-mask_height 13
1607     static unsigned char tri-dn-mask_bits[] = {
1608        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1609        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1610        0x00, 0x00};
1611 }
1612
1613 image create bitmap reficon-T -background black -foreground yellow -data {
1614     #define tagicon_width 13
1615     #define tagicon_height 9
1616     static unsigned char tagicon_bits[] = {
1617        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1618        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1619 } -maskdata {
1620     #define tagicon-mask_width 13
1621     #define tagicon-mask_height 9
1622     static unsigned char tagicon-mask_bits[] = {
1623        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1624        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1625 }
1626 set rectdata {
1627     #define headicon_width 13
1628     #define headicon_height 9
1629     static unsigned char headicon_bits[] = {
1630        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1631        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1632 }
1633 set rectmask {
1634     #define headicon-mask_width 13
1635     #define headicon-mask_height 9
1636     static unsigned char headicon-mask_bits[] = {
1637        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1638        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1639 }
1640 image create bitmap reficon-H -background black -foreground green \
1641     -data $rectdata -maskdata $rectmask
1642 image create bitmap reficon-o -background black -foreground "#ddddff" \
1643     -data $rectdata -maskdata $rectmask
1644
1645 proc init_flist {first} {
1646     global cflist cflist_top selectedline difffilestart
1647
1648     $cflist conf -state normal
1649     $cflist delete 0.0 end
1650     if {$first ne {}} {
1651         $cflist insert end $first
1652         set cflist_top 1
1653         $cflist tag add highlight 1.0 "1.0 lineend"
1654     } else {
1655         catch {unset cflist_top}
1656     }
1657     $cflist conf -state disabled
1658     set difffilestart {}
1659 }
1660
1661 proc highlight_tag {f} {
1662     global highlight_paths
1663
1664     foreach p $highlight_paths {
1665         if {[string match $p $f]} {
1666             return "bold"
1667         }
1668     }
1669     return {}
1670 }
1671
1672 proc highlight_filelist {} {
1673     global cmitmode cflist
1674
1675     $cflist conf -state normal
1676     if {$cmitmode ne "tree"} {
1677         set end [lindex [split [$cflist index end] .] 0]
1678         for {set l 2} {$l < $end} {incr l} {
1679             set line [$cflist get $l.0 "$l.0 lineend"]
1680             if {[highlight_tag $line] ne {}} {
1681                 $cflist tag add bold $l.0 "$l.0 lineend"
1682             }
1683         }
1684     } else {
1685         highlight_tree 2 {}
1686     }
1687     $cflist conf -state disabled
1688 }
1689
1690 proc unhighlight_filelist {} {
1691     global cflist
1692
1693     $cflist conf -state normal
1694     $cflist tag remove bold 1.0 end
1695     $cflist conf -state disabled
1696 }
1697
1698 proc add_flist {fl} {
1699     global cflist
1700
1701     $cflist conf -state normal
1702     foreach f $fl {
1703         $cflist insert end "\n"
1704         $cflist insert end $f [highlight_tag $f]
1705     }
1706     $cflist conf -state disabled
1707 }
1708
1709 proc sel_flist {w x y} {
1710     global ctext difffilestart cflist cflist_top cmitmode
1711
1712     if {$cmitmode eq "tree"} return
1713     if {![info exists cflist_top]} return
1714     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1715     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1716     $cflist tag add highlight $l.0 "$l.0 lineend"
1717     set cflist_top $l
1718     if {$l == 1} {
1719         $ctext yview 1.0
1720     } else {
1721         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1722     }
1723 }
1724
1725 proc pop_flist_menu {w X Y x y} {
1726     global ctext cflist cmitmode flist_menu flist_menu_file
1727     global treediffs diffids
1728
1729     stopfinding
1730     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1731     if {$l <= 1} return
1732     if {$cmitmode eq "tree"} {
1733         set e [linetoelt $l]
1734         if {[string index $e end] eq "/"} return
1735     } else {
1736         set e [lindex $treediffs($diffids) [expr {$l-2}]]
1737     }
1738     set flist_menu_file $e
1739     tk_popup $flist_menu $X $Y
1740 }
1741
1742 proc flist_hl {only} {
1743     global flist_menu_file findstring gdttype
1744
1745     set x [shellquote $flist_menu_file]
1746     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1747         set findstring $x
1748     } else {
1749         append findstring " " $x
1750     }
1751     set gdttype [mc "touching paths:"]
1752 }
1753
1754 # Functions for adding and removing shell-type quoting
1755
1756 proc shellquote {str} {
1757     if {![string match "*\['\"\\ \t]*" $str]} {
1758         return $str
1759     }
1760     if {![string match "*\['\"\\]*" $str]} {
1761         return "\"$str\""
1762     }
1763     if {![string match "*'*" $str]} {
1764         return "'$str'"
1765     }
1766     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1767 }
1768
1769 proc shellarglist {l} {
1770     set str {}
1771     foreach a $l {
1772         if {$str ne {}} {
1773             append str " "
1774         }
1775         append str [shellquote $a]
1776     }
1777     return $str
1778 }
1779
1780 proc shelldequote {str} {
1781     set ret {}
1782     set used -1
1783     while {1} {
1784         incr used
1785         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1786             append ret [string range $str $used end]
1787             set used [string length $str]
1788             break
1789         }
1790         set first [lindex $first 0]
1791         set ch [string index $str $first]
1792         if {$first > $used} {
1793             append ret [string range $str $used [expr {$first - 1}]]
1794             set used $first
1795         }
1796         if {$ch eq " " || $ch eq "\t"} break
1797         incr used
1798         if {$ch eq "'"} {
1799             set first [string first "'" $str $used]
1800             if {$first < 0} {
1801                 error "unmatched single-quote"
1802             }
1803             append ret [string range $str $used [expr {$first - 1}]]
1804             set used $first
1805             continue
1806         }
1807         if {$ch eq "\\"} {
1808             if {$used >= [string length $str]} {
1809                 error "trailing backslash"
1810             }
1811             append ret [string index $str $used]
1812             continue
1813         }
1814         # here ch == "\""
1815         while {1} {
1816             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1817                 error "unmatched double-quote"
1818             }
1819             set first [lindex $first 0]
1820             set ch [string index $str $first]
1821             if {$first > $used} {
1822                 append ret [string range $str $used [expr {$first - 1}]]
1823                 set used $first
1824             }
1825             if {$ch eq "\""} break
1826             incr used
1827             append ret [string index $str $used]
1828             incr used
1829         }
1830     }
1831     return [list $used $ret]
1832 }
1833
1834 proc shellsplit {str} {
1835     set l {}
1836     while {1} {
1837         set str [string trimleft $str]
1838         if {$str eq {}} break
1839         set dq [shelldequote $str]
1840         set n [lindex $dq 0]
1841         set word [lindex $dq 1]
1842         set str [string range $str $n end]
1843         lappend l $word
1844     }
1845     return $l
1846 }
1847
1848 # Code to implement multiple views
1849
1850 proc newview {ishighlight} {
1851     global nextviewnum newviewname newviewperm newishighlight
1852     global newviewargs revtreeargs
1853
1854     set newishighlight $ishighlight
1855     set top .gitkview
1856     if {[winfo exists $top]} {
1857         raise $top
1858         return
1859     }
1860     set newviewname($nextviewnum) "View $nextviewnum"
1861     set newviewperm($nextviewnum) 0
1862     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1863     vieweditor $top $nextviewnum [mc "Gitk view definition"]
1864 }
1865
1866 proc editview {} {
1867     global curview
1868     global viewname viewperm newviewname newviewperm
1869     global viewargs newviewargs
1870
1871     set top .gitkvedit-$curview
1872     if {[winfo exists $top]} {
1873         raise $top
1874         return
1875     }
1876     set newviewname($curview) $viewname($curview)
1877     set newviewperm($curview) $viewperm($curview)
1878     set newviewargs($curview) [shellarglist $viewargs($curview)]
1879     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1880 }
1881
1882 proc vieweditor {top n title} {
1883     global newviewname newviewperm viewfiles bgcolor
1884
1885     toplevel $top
1886     wm title $top $title
1887     label $top.nl -text [mc "Name"]
1888     entry $top.name -width 20 -textvariable newviewname($n)
1889     grid $top.nl $top.name -sticky w -pady 5
1890     checkbutton $top.perm -text [mc "Remember this view"] \
1891         -variable newviewperm($n)
1892     grid $top.perm - -pady 5 -sticky w
1893     message $top.al -aspect 1000 \
1894         -text [mc "Commits to include (arguments to git rev-list):"]
1895     grid $top.al - -sticky w -pady 5
1896     entry $top.args -width 50 -textvariable newviewargs($n) \
1897         -background $bgcolor
1898     grid $top.args - -sticky ew -padx 5
1899     message $top.l -aspect 1000 \
1900         -text [mc "Enter files and directories to include, one per line:"]
1901     grid $top.l - -sticky w
1902     text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1903     if {[info exists viewfiles($n)]} {
1904         foreach f $viewfiles($n) {
1905             $top.t insert end $f
1906             $top.t insert end "\n"
1907         }
1908         $top.t delete {end - 1c} end
1909         $top.t mark set insert 0.0
1910     }
1911     grid $top.t - -sticky ew -padx 5
1912     frame $top.buts
1913     button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1914     button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1915     grid $top.buts.ok $top.buts.can
1916     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1917     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1918     grid $top.buts - -pady 10 -sticky ew
1919     focus $top.t
1920 }
1921
1922 proc doviewmenu {m first cmd op argv} {
1923     set nmenu [$m index end]
1924     for {set i $first} {$i <= $nmenu} {incr i} {
1925         if {[$m entrycget $i -command] eq $cmd} {
1926             eval $m $op $i $argv
1927             break
1928         }
1929     }
1930 }
1931
1932 proc allviewmenus {n op args} {
1933     # global viewhlmenu
1934
1935     doviewmenu .bar.view 5 [list showview $n] $op $args
1936     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1937 }
1938
1939 proc newviewok {top n} {
1940     global nextviewnum newviewperm newviewname newishighlight
1941     global viewname viewfiles viewperm selectedview curview
1942     global viewargs newviewargs viewhlmenu
1943
1944     if {[catch {
1945         set newargs [shellsplit $newviewargs($n)]
1946     } err]} {
1947         error_popup "[mc "Error in commit selection arguments:"] $err"
1948         wm raise $top
1949         focus $top
1950         return
1951     }
1952     set files {}
1953     foreach f [split [$top.t get 0.0 end] "\n"] {
1954         set ft [string trim $f]
1955         if {$ft ne {}} {
1956             lappend files $ft
1957         }
1958     }
1959     if {![info exists viewfiles($n)]} {
1960         # creating a new view
1961         incr nextviewnum
1962         set viewname($n) $newviewname($n)
1963         set viewperm($n) $newviewperm($n)
1964         set viewfiles($n) $files
1965         set viewargs($n) $newargs
1966         addviewmenu $n
1967         if {!$newishighlight} {
1968             run showview $n
1969         } else {
1970             run addvhighlight $n
1971         }
1972     } else {
1973         # editing an existing view
1974         set viewperm($n) $newviewperm($n)
1975         if {$newviewname($n) ne $viewname($n)} {
1976             set viewname($n) $newviewname($n)
1977             doviewmenu .bar.view 5 [list showview $n] \
1978                 entryconf [list -label $viewname($n)]
1979             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1980                 # entryconf [list -label $viewname($n) -value $viewname($n)]
1981         }
1982         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1983             set viewfiles($n) $files
1984             set viewargs($n) $newargs
1985             if {$curview == $n} {
1986                 run updatecommits
1987             }
1988         }
1989     }
1990     catch {destroy $top}
1991 }
1992
1993 proc delview {} {
1994     global curview viewdata viewperm hlview selectedhlview
1995
1996     if {$curview == 0} return
1997     if {[info exists hlview] && $hlview == $curview} {
1998         set selectedhlview [mc "None"]
1999         unset hlview
2000     }
2001     allviewmenus $curview delete
2002     set viewdata($curview) {}
2003     set viewperm($curview) 0
2004     showview 0
2005 }
2006
2007 proc addviewmenu {n} {
2008     global viewname viewhlmenu
2009
2010     .bar.view add radiobutton -label $viewname($n) \
2011         -command [list showview $n] -variable selectedview -value $n
2012     #$viewhlmenu add radiobutton -label $viewname($n) \
2013     #   -command [list addvhighlight $n] -variable selectedhlview
2014 }
2015
2016 proc flatten {var} {
2017     global $var
2018
2019     set ret {}
2020     foreach i [array names $var] {
2021         lappend ret $i [set $var\($i\)]
2022     }
2023     return $ret
2024 }
2025
2026 proc unflatten {var l} {
2027     global $var
2028
2029     catch {unset $var}
2030     foreach {i v} $l {
2031         set $var\($i\) $v
2032     }
2033 }
2034
2035 proc showview {n} {
2036     global curview viewdata viewfiles
2037     global displayorder parentlist rowidlist rowisopt rowfinal
2038     global colormap rowtextx commitrow nextcolor canvxmax
2039     global numcommits commitlisted
2040     global selectedline currentid canv canvy0
2041     global treediffs
2042     global pending_select phase
2043     global commitidx
2044     global commfd
2045     global selectedview selectfirst
2046     global vparentlist vdisporder vcmitlisted
2047     global hlview selectedhlview commitinterest
2048
2049     if {$n == $curview} return
2050     set selid {}
2051     if {[info exists selectedline]} {
2052         set selid $currentid
2053         set y [yc $selectedline]
2054         set ymax [lindex [$canv cget -scrollregion] 3]
2055         set span [$canv yview]
2056         set ytop [expr {[lindex $span 0] * $ymax}]
2057         set ybot [expr {[lindex $span 1] * $ymax}]
2058         if {$ytop < $y && $y < $ybot} {
2059             set yscreen [expr {$y - $ytop}]
2060         } else {
2061             set yscreen [expr {($ybot - $ytop) / 2}]
2062         }
2063     } elseif {[info exists pending_select]} {
2064         set selid $pending_select
2065         unset pending_select
2066     }
2067     unselectline
2068     normalline
2069     if {$curview >= 0} {
2070         set vparentlist($curview) $parentlist
2071         set vdisporder($curview) $displayorder
2072         set vcmitlisted($curview) $commitlisted
2073         if {$phase ne {} ||
2074             ![info exists viewdata($curview)] ||
2075             [lindex $viewdata($curview) 0] ne {}} {
2076             set viewdata($curview) \
2077                 [list $phase $rowidlist $rowisopt $rowfinal]
2078         }
2079     }
2080     catch {unset treediffs}
2081     clear_display
2082     if {[info exists hlview] && $hlview == $n} {
2083         unset hlview
2084         set selectedhlview [mc "None"]
2085     }
2086     catch {unset commitinterest}
2087
2088     set curview $n
2089     set selectedview $n
2090     .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2091     .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2092
2093     run refill_reflist
2094     if {![info exists viewdata($n)]} {
2095         if {$selid ne {}} {
2096             set pending_select $selid
2097         }
2098         getcommits
2099         return
2100     }
2101
2102     set v $viewdata($n)
2103     set phase [lindex $v 0]
2104     set displayorder $vdisporder($n)
2105     set parentlist $vparentlist($n)
2106     set commitlisted $vcmitlisted($n)
2107     set rowidlist [lindex $v 1]
2108     set rowisopt [lindex $v 2]
2109     set rowfinal [lindex $v 3]
2110     set numcommits $commitidx($n)
2111
2112     catch {unset colormap}
2113     catch {unset rowtextx}
2114     set nextcolor 0
2115     set canvxmax [$canv cget -width]
2116     set curview $n
2117     set row 0
2118     setcanvscroll
2119     set yf 0
2120     set row {}
2121     set selectfirst 0
2122     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2123         set row $commitrow($n,$selid)
2124         # try to get the selected row in the same position on the screen
2125         set ymax [lindex [$canv cget -scrollregion] 3]
2126         set ytop [expr {[yc $row] - $yscreen}]
2127         if {$ytop < 0} {
2128             set ytop 0
2129         }
2130         set yf [expr {$ytop * 1.0 / $ymax}]
2131     }
2132     allcanvs yview moveto $yf
2133     drawvisible
2134     if {$row ne {}} {
2135         selectline $row 0
2136     } elseif {$selid ne {}} {
2137         set pending_select $selid
2138     } else {
2139         set row [first_real_row]
2140         if {$row < $numcommits} {
2141             selectline $row 0
2142         } else {
2143             set selectfirst 1
2144         }
2145     }
2146     if {$phase ne {}} {
2147         if {$phase eq "getcommits"} {
2148             show_status [mc "Reading commits..."]
2149         }
2150         run chewcommits $n
2151     } elseif {$numcommits == 0} {
2152         show_status [mc "No commits selected"]
2153     }
2154 }
2155
2156 # Stuff relating to the highlighting facility
2157
2158 proc ishighlighted {row} {
2159     global vhighlights fhighlights nhighlights rhighlights
2160
2161     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2162         return $nhighlights($row)
2163     }
2164     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2165         return $vhighlights($row)
2166     }
2167     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2168         return $fhighlights($row)
2169     }
2170     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2171         return $rhighlights($row)
2172     }
2173     return 0
2174 }
2175
2176 proc bolden {row font} {
2177     global canv linehtag selectedline boldrows
2178
2179     lappend boldrows $row
2180     $canv itemconf $linehtag($row) -font $font
2181     if {[info exists selectedline] && $row == $selectedline} {
2182         $canv delete secsel
2183         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2184                    -outline {{}} -tags secsel \
2185                    -fill [$canv cget -selectbackground]]
2186         $canv lower $t
2187     }
2188 }
2189
2190 proc bolden_name {row font} {
2191     global canv2 linentag selectedline boldnamerows
2192
2193     lappend boldnamerows $row
2194     $canv2 itemconf $linentag($row) -font $font
2195     if {[info exists selectedline] && $row == $selectedline} {
2196         $canv2 delete secsel
2197         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2198                    -outline {{}} -tags secsel \
2199                    -fill [$canv2 cget -selectbackground]]
2200         $canv2 lower $t
2201     }
2202 }
2203
2204 proc unbolden {} {
2205     global boldrows
2206
2207     set stillbold {}
2208     foreach row $boldrows {
2209         if {![ishighlighted $row]} {
2210             bolden $row mainfont
2211         } else {
2212             lappend stillbold $row
2213         }
2214     }
2215     set boldrows $stillbold
2216 }
2217
2218 proc addvhighlight {n} {
2219     global hlview curview viewdata vhl_done vhighlights commitidx
2220
2221     if {[info exists hlview]} {
2222         delvhighlight
2223     }
2224     set hlview $n
2225     if {$n != $curview && ![info exists viewdata($n)]} {
2226         set viewdata($n) [list getcommits {{}} 0 0 0]
2227         set vparentlist($n) {}
2228         set vdisporder($n) {}
2229         set vcmitlisted($n) {}
2230         start_rev_list $n
2231     }
2232     set vhl_done $commitidx($hlview)
2233     if {$vhl_done > 0} {
2234         drawvisible
2235     }
2236 }
2237
2238 proc delvhighlight {} {
2239     global hlview vhighlights
2240
2241     if {![info exists hlview]} return
2242     unset hlview
2243     catch {unset vhighlights}
2244     unbolden
2245 }
2246
2247 proc vhighlightmore {} {
2248     global hlview vhl_done commitidx vhighlights
2249     global displayorder vdisporder curview
2250
2251     set max $commitidx($hlview)
2252     if {$hlview == $curview} {
2253         set disp $displayorder
2254     } else {
2255         set disp $vdisporder($hlview)
2256     }
2257     set vr [visiblerows]
2258     set r0 [lindex $vr 0]
2259     set r1 [lindex $vr 1]
2260     for {set i $vhl_done} {$i < $max} {incr i} {
2261         set id [lindex $disp $i]
2262         if {[info exists commitrow($curview,$id)]} {
2263             set row $commitrow($curview,$id)
2264             if {$r0 <= $row && $row <= $r1} {
2265                 if {![highlighted $row]} {
2266                     bolden $row mainfontbold
2267                 }
2268                 set vhighlights($row) 1
2269             }
2270         }
2271     }
2272     set vhl_done $max
2273 }
2274
2275 proc askvhighlight {row id} {
2276     global hlview vhighlights commitrow iddrawn
2277
2278     if {[info exists commitrow($hlview,$id)]} {
2279         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2280             bolden $row mainfontbold
2281         }
2282         set vhighlights($row) 1
2283     } else {
2284         set vhighlights($row) 0
2285     }
2286 }
2287
2288 proc hfiles_change {} {
2289     global highlight_files filehighlight fhighlights fh_serial
2290     global highlight_paths gdttype
2291
2292     if {[info exists filehighlight]} {
2293         # delete previous highlights
2294         catch {close $filehighlight}
2295         unset filehighlight
2296         catch {unset fhighlights}
2297         unbolden
2298         unhighlight_filelist
2299     }
2300     set highlight_paths {}
2301     after cancel do_file_hl $fh_serial
2302     incr fh_serial
2303     if {$highlight_files ne {}} {
2304         after 300 do_file_hl $fh_serial
2305     }
2306 }
2307
2308 proc gdttype_change {name ix op} {
2309     global gdttype highlight_files findstring findpattern
2310
2311     stopfinding
2312     if {$findstring ne {}} {
2313         if {$gdttype eq [mc "containing:"]} {
2314             if {$highlight_files ne {}} {
2315                 set highlight_files {}
2316                 hfiles_change
2317             }
2318             findcom_change
2319         } else {
2320             if {$findpattern ne {}} {
2321                 set findpattern {}
2322                 findcom_change
2323             }
2324             set highlight_files $findstring
2325             hfiles_change
2326         }
2327         drawvisible
2328     }
2329     # enable/disable findtype/findloc menus too
2330 }
2331
2332 proc find_change {name ix op} {
2333     global gdttype findstring highlight_files
2334
2335     stopfinding
2336     if {$gdttype eq [mc "containing:"]} {
2337         findcom_change
2338     } else {
2339         if {$highlight_files ne $findstring} {
2340             set highlight_files $findstring
2341             hfiles_change
2342         }
2343     }
2344     drawvisible
2345 }
2346
2347 proc findcom_change args {
2348     global nhighlights boldnamerows
2349     global findpattern findtype findstring gdttype
2350
2351     stopfinding
2352     # delete previous highlights, if any
2353     foreach row $boldnamerows {
2354         bolden_name $row mainfont
2355     }
2356     set boldnamerows {}
2357     catch {unset nhighlights}
2358     unbolden
2359     unmarkmatches
2360     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2361         set findpattern {}
2362     } elseif {$findtype eq [mc "Regexp"]} {
2363         set findpattern $findstring
2364     } else {
2365         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2366                    $findstring]
2367         set findpattern "*$e*"
2368     }
2369 }
2370
2371 proc makepatterns {l} {
2372     set ret {}
2373     foreach e $l {
2374         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2375         if {[string index $ee end] eq "/"} {
2376             lappend ret "$ee*"
2377         } else {
2378             lappend ret $ee
2379             lappend ret "$ee/*"
2380         }
2381     }
2382     return $ret
2383 }
2384
2385 proc do_file_hl {serial} {
2386     global highlight_files filehighlight highlight_paths gdttype fhl_list
2387
2388     if {$gdttype eq [mc "touching paths:"]} {
2389         if {[catch {set paths [shellsplit $highlight_files]}]} return
2390         set highlight_paths [makepatterns $paths]
2391         highlight_filelist
2392         set gdtargs [concat -- $paths]
2393     } elseif {$gdttype eq [mc "adding/removing string:"]} {
2394         set gdtargs [list "-S$highlight_files"]
2395     } else {
2396         # must be "containing:", i.e. we're searching commit info
2397         return
2398     }
2399     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2400     set filehighlight [open $cmd r+]
2401     fconfigure $filehighlight -blocking 0
2402     filerun $filehighlight readfhighlight
2403     set fhl_list {}
2404     drawvisible
2405     flushhighlights
2406 }
2407
2408 proc flushhighlights {} {
2409     global filehighlight fhl_list
2410
2411     if {[info exists filehighlight]} {
2412         lappend fhl_list {}
2413         puts $filehighlight ""
2414         flush $filehighlight
2415     }
2416 }
2417
2418 proc askfilehighlight {row id} {
2419     global filehighlight fhighlights fhl_list
2420
2421     lappend fhl_list $id
2422     set fhighlights($row) -1
2423     puts $filehighlight $id
2424 }
2425
2426 proc readfhighlight {} {
2427     global filehighlight fhighlights commitrow curview iddrawn
2428     global fhl_list find_dirn
2429
2430     if {![info exists filehighlight]} {
2431         return 0
2432     }
2433     set nr 0
2434     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2435         set line [string trim $line]
2436         set i [lsearch -exact $fhl_list $line]
2437         if {$i < 0} continue
2438         for {set j 0} {$j < $i} {incr j} {
2439             set id [lindex $fhl_list $j]
2440             if {[info exists commitrow($curview,$id)]} {
2441                 set fhighlights($commitrow($curview,$id)) 0
2442             }
2443         }
2444         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2445         if {$line eq {}} continue
2446         if {![info exists commitrow($curview,$line)]} continue
2447         set row $commitrow($curview,$line)
2448         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2449             bolden $row mainfontbold
2450         }
2451         set fhighlights($row) 1
2452     }
2453     if {[eof $filehighlight]} {
2454         # strange...
2455         puts "oops, git diff-tree died"
2456         catch {close $filehighlight}
2457         unset filehighlight
2458         return 0
2459     }
2460     if {[info exists find_dirn]} {
2461         run findmore
2462     }
2463     return 1
2464 }
2465
2466 proc doesmatch {f} {
2467     global findtype findpattern
2468
2469     if {$findtype eq [mc "Regexp"]} {
2470         return [regexp $findpattern $f]
2471     } elseif {$findtype eq [mc "IgnCase"]} {
2472         return [string match -nocase $findpattern $f]
2473     } else {
2474         return [string match $findpattern $f]
2475     }
2476 }
2477
2478 proc askfindhighlight {row id} {
2479     global nhighlights commitinfo iddrawn
2480     global findloc
2481     global markingmatches
2482
2483     if {![info exists commitinfo($id)]} {
2484         getcommit $id
2485     }
2486     set info $commitinfo($id)
2487     set isbold 0
2488     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2489     foreach f $info ty $fldtypes {
2490         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2491             [doesmatch $f]} {
2492             if {$ty eq [mc "Author"]} {
2493                 set isbold 2
2494                 break
2495             }
2496             set isbold 1
2497         }
2498     }
2499     if {$isbold && [info exists iddrawn($id)]} {
2500         if {![ishighlighted $row]} {
2501             bolden $row mainfontbold
2502             if {$isbold > 1} {
2503                 bolden_name $row mainfontbold
2504             }
2505         }
2506         if {$markingmatches} {
2507             markrowmatches $row $id
2508         }
2509     }
2510     set nhighlights($row) $isbold
2511 }
2512
2513 proc markrowmatches {row id} {
2514     global canv canv2 linehtag linentag commitinfo findloc
2515
2516     set headline [lindex $commitinfo($id) 0]
2517     set author [lindex $commitinfo($id) 1]
2518     $canv delete match$row
2519     $canv2 delete match$row
2520     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2521         set m [findmatches $headline]
2522         if {$m ne {}} {
2523             markmatches $canv $row $headline $linehtag($row) $m \
2524                 [$canv itemcget $linehtag($row) -font] $row
2525         }
2526     }
2527     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2528         set m [findmatches $author]
2529         if {$m ne {}} {
2530             markmatches $canv2 $row $author $linentag($row) $m \
2531                 [$canv2 itemcget $linentag($row) -font] $row
2532         }
2533     }
2534 }
2535
2536 proc vrel_change {name ix op} {
2537     global highlight_related
2538
2539     rhighlight_none
2540     if {$highlight_related ne [mc "None"]} {
2541         run drawvisible
2542     }
2543 }
2544
2545 # prepare for testing whether commits are descendents or ancestors of a
2546 proc rhighlight_sel {a} {
2547     global descendent desc_todo ancestor anc_todo
2548     global highlight_related rhighlights
2549
2550     catch {unset descendent}
2551     set desc_todo [list $a]
2552     catch {unset ancestor}
2553     set anc_todo [list $a]
2554     if {$highlight_related ne [mc "None"]} {
2555         rhighlight_none
2556         run drawvisible
2557     }
2558 }
2559
2560 proc rhighlight_none {} {
2561     global rhighlights
2562
2563     catch {unset rhighlights}
2564     unbolden
2565 }
2566
2567 proc is_descendent {a} {
2568     global curview children commitrow descendent desc_todo
2569
2570     set v $curview
2571     set la $commitrow($v,$a)
2572     set todo $desc_todo
2573     set leftover {}
2574     set done 0
2575     for {set i 0} {$i < [llength $todo]} {incr i} {
2576         set do [lindex $todo $i]
2577         if {$commitrow($v,$do) < $la} {
2578             lappend leftover $do
2579             continue
2580         }
2581         foreach nk $children($v,$do) {
2582             if {![info exists descendent($nk)]} {
2583                 set descendent($nk) 1
2584                 lappend todo $nk
2585                 if {$nk eq $a} {
2586                     set done 1
2587                 }
2588             }
2589         }
2590         if {$done} {
2591             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2592             return
2593         }
2594     }
2595     set descendent($a) 0
2596     set desc_todo $leftover
2597 }
2598
2599 proc is_ancestor {a} {
2600     global curview parentlist commitrow ancestor anc_todo
2601
2602     set v $curview
2603     set la $commitrow($v,$a)
2604     set todo $anc_todo
2605     set leftover {}
2606     set done 0
2607     for {set i 0} {$i < [llength $todo]} {incr i} {
2608         set do [lindex $todo $i]
2609         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2610             lappend leftover $do
2611             continue
2612         }
2613         foreach np [lindex $parentlist $commitrow($v,$do)] {
2614             if {![info exists ancestor($np)]} {
2615                 set ancestor($np) 1
2616                 lappend todo $np
2617                 if {$np eq $a} {
2618                     set done 1
2619                 }
2620             }
2621         }
2622         if {$done} {
2623             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2624             return
2625         }
2626     }
2627     set ancestor($a) 0
2628     set anc_todo $leftover
2629 }
2630
2631 proc askrelhighlight {row id} {
2632     global descendent highlight_related iddrawn rhighlights
2633     global selectedline ancestor
2634
2635     if {![info exists selectedline]} return
2636     set isbold 0
2637     if {$highlight_related eq [mc "Descendant"] ||
2638         $highlight_related eq [mc "Not descendant"]} {
2639         if {![info exists descendent($id)]} {
2640             is_descendent $id
2641         }
2642         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2643             set isbold 1
2644         }
2645     } elseif {$highlight_related eq [mc "Ancestor"] ||
2646               $highlight_related eq [mc "Not ancestor"]} {
2647         if {![info exists ancestor($id)]} {
2648             is_ancestor $id
2649         }
2650         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2651             set isbold 1
2652         }
2653     }
2654     if {[info exists iddrawn($id)]} {
2655         if {$isbold && ![ishighlighted $row]} {
2656             bolden $row mainfontbold
2657         }
2658     }
2659     set rhighlights($row) $isbold
2660 }
2661
2662 # Graph layout functions
2663
2664 proc shortids {ids} {
2665     set res {}
2666     foreach id $ids {
2667         if {[llength $id] > 1} {
2668             lappend res [shortids $id]
2669         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2670             lappend res [string range $id 0 7]
2671         } else {
2672             lappend res $id
2673         }
2674     }
2675     return $res
2676 }
2677
2678 proc ntimes {n o} {
2679     set ret {}
2680     set o [list $o]
2681     for {set mask 1} {$mask <= $n} {incr mask $mask} {
2682         if {($n & $mask) != 0} {
2683             set ret [concat $ret $o]
2684         }
2685         set o [concat $o $o]
2686     }
2687     return $ret
2688 }
2689
2690 # Work out where id should go in idlist so that order-token
2691 # values increase from left to right
2692 proc idcol {idlist id {i 0}} {
2693     global ordertok curview
2694
2695     set t $ordertok($curview,$id)
2696     if {$i >= [llength $idlist] ||
2697         $t < $ordertok($curview,[lindex $idlist $i])} {
2698         if {$i > [llength $idlist]} {
2699             set i [llength $idlist]
2700         }
2701         while {[incr i -1] >= 0 &&
2702                $t < $ordertok($curview,[lindex $idlist $i])} {}
2703         incr i
2704     } else {
2705         if {$t > $ordertok($curview,[lindex $idlist $i])} {
2706             while {[incr i] < [llength $idlist] &&
2707                    $t >= $ordertok($curview,[lindex $idlist $i])} {}
2708         }
2709     }
2710     return $i
2711 }
2712
2713 proc initlayout {} {
2714     global rowidlist rowisopt rowfinal displayorder commitlisted
2715     global numcommits canvxmax canv
2716     global nextcolor
2717     global parentlist
2718     global colormap rowtextx
2719     global selectfirst
2720
2721     set numcommits 0
2722     set displayorder {}
2723     set commitlisted {}
2724     set parentlist {}
2725     set nextcolor 0
2726     set rowidlist {}
2727     set rowisopt {}
2728     set rowfinal {}
2729     set canvxmax [$canv cget -width]
2730     catch {unset colormap}
2731     catch {unset rowtextx}
2732     set selectfirst 1
2733 }
2734
2735 proc setcanvscroll {} {
2736     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2737
2738     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2739     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2740     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2741     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2742 }
2743
2744 proc visiblerows {} {
2745     global canv numcommits linespc
2746
2747     set ymax [lindex [$canv cget -scrollregion] 3]
2748     if {$ymax eq {} || $ymax == 0} return
2749     set f [$canv yview]
2750     set y0 [expr {int([lindex $f 0] * $ymax)}]
2751     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2752     if {$r0 < 0} {
2753         set r0 0
2754     }
2755     set y1 [expr {int([lindex $f 1] * $ymax)}]
2756     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2757     if {$r1 >= $numcommits} {
2758         set r1 [expr {$numcommits - 1}]
2759     }
2760     return [list $r0 $r1]
2761 }
2762
2763 proc layoutmore {} {
2764     global commitidx viewcomplete numcommits
2765     global uparrowlen downarrowlen mingaplen curview
2766
2767     set show $commitidx($curview)
2768     if {$show > $numcommits || $viewcomplete($curview)} {
2769         showstuff $show $viewcomplete($curview)
2770     }
2771 }
2772
2773 proc showstuff {canshow last} {
2774     global numcommits commitrow pending_select selectedline curview
2775     global mainheadid displayorder selectfirst
2776     global lastscrollset commitinterest
2777
2778     if {$numcommits == 0} {
2779         global phase
2780         set phase "incrdraw"
2781         allcanvs delete all
2782     }
2783     set r0 $numcommits
2784     set prev $numcommits
2785     set numcommits $canshow
2786     set t [clock clicks -milliseconds]
2787     if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2788         set lastscrollset $t
2789         setcanvscroll
2790     }
2791     set rows [visiblerows]
2792     set r1 [lindex $rows 1]
2793     if {$r1 >= $canshow} {
2794         set r1 [expr {$canshow - 1}]
2795     }
2796     if {$r0 <= $r1} {
2797         drawcommits $r0 $r1
2798     }
2799     if {[info exists pending_select] &&
2800         [info exists commitrow($curview,$pending_select)] &&
2801         $commitrow($curview,$pending_select) < $numcommits} {
2802         selectline $commitrow($curview,$pending_select) 1
2803     }
2804     if {$selectfirst} {
2805         if {[info exists selectedline] || [info exists pending_select]} {
2806             set selectfirst 0
2807         } else {
2808             set l [first_real_row]
2809             selectline $l 1
2810             set selectfirst 0
2811         }
2812     }
2813 }
2814
2815 proc doshowlocalchanges {} {
2816     global curview mainheadid phase commitrow
2817
2818     if {[info exists commitrow($curview,$mainheadid)] &&
2819         ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2820         dodiffindex
2821     } elseif {$phase ne {}} {
2822         lappend commitinterest($mainheadid) {}
2823     }
2824 }
2825
2826 proc dohidelocalchanges {} {
2827     global localfrow localirow lserial
2828
2829     if {$localfrow >= 0} {
2830         removerow $localfrow
2831         set localfrow -1
2832         if {$localirow > 0} {
2833             incr localirow -1
2834         }
2835     }
2836     if {$localirow >= 0} {
2837         removerow $localirow
2838         set localirow -1
2839     }
2840     incr lserial
2841 }
2842
2843 # spawn off a process to do git diff-index --cached HEAD
2844 proc dodiffindex {} {
2845     global localirow localfrow lserial showlocalchanges
2846
2847     if {!$showlocalchanges} return
2848     incr lserial
2849     set localfrow -1
2850     set localirow -1
2851     set fd [open "|git diff-index --cached HEAD" r]
2852     fconfigure $fd -blocking 0
2853     filerun $fd [list readdiffindex $fd $lserial]
2854 }
2855
2856 proc readdiffindex {fd serial} {
2857     global localirow commitrow mainheadid nullid2 curview
2858     global commitinfo commitdata lserial
2859
2860     set isdiff 1
2861     if {[gets $fd line] < 0} {
2862         if {![eof $fd]} {
2863             return 1
2864         }
2865         set isdiff 0
2866     }
2867     # we only need to see one line and we don't really care what it says...
2868     close $fd
2869
2870     # now see if there are any local changes not checked in to the index
2871     if {$serial == $lserial} {
2872         set fd [open "|git diff-files" r]
2873         fconfigure $fd -blocking 0
2874         filerun $fd [list readdifffiles $fd $serial]
2875     }
2876
2877     if {$isdiff && $serial == $lserial && $localirow == -1} {
2878         # add the line for the changes in the index to the graph
2879         set localirow $commitrow($curview,$mainheadid)
2880         set hl [mc "Local changes checked in to index but not committed"]
2881         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2882         set commitdata($nullid2) "\n    $hl\n"
2883         insertrow $localirow $nullid2
2884     }
2885     return 0
2886 }
2887
2888 proc readdifffiles {fd serial} {
2889     global localirow localfrow commitrow mainheadid nullid curview
2890     global commitinfo commitdata lserial
2891
2892     set isdiff 1
2893     if {[gets $fd line] < 0} {
2894         if {![eof $fd]} {
2895             return 1
2896         }
2897         set isdiff 0
2898     }
2899     # we only need to see one line and we don't really care what it says...
2900     close $fd
2901
2902     if {$isdiff && $serial == $lserial && $localfrow == -1} {
2903         # add the line for the local diff to the graph
2904         if {$localirow >= 0} {
2905             set localfrow $localirow
2906             incr localirow
2907         } else {
2908             set localfrow $commitrow($curview,$mainheadid)
2909         }
2910         set hl [mc "Local uncommitted changes, not checked in to index"]
2911         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2912         set commitdata($nullid) "\n    $hl\n"
2913         insertrow $localfrow $nullid
2914     }
2915     return 0
2916 }
2917
2918 proc nextuse {id row} {
2919     global commitrow curview children
2920
2921     if {[info exists children($curview,$id)]} {
2922         foreach kid $children($curview,$id) {
2923             if {![info exists commitrow($curview,$kid)]} {
2924                 return -1
2925             }
2926             if {$commitrow($curview,$kid) > $row} {
2927                 return $commitrow($curview,$kid)
2928             }
2929         }
2930     }
2931     if {[info exists commitrow($curview,$id)]} {
2932         return $commitrow($curview,$id)
2933     }
2934     return -1
2935 }
2936
2937 proc prevuse {id row} {
2938     global commitrow curview children
2939
2940     set ret -1
2941     if {[info exists children($curview,$id)]} {
2942         foreach kid $children($curview,$id) {
2943             if {![info exists commitrow($curview,$kid)]} break
2944             if {$commitrow($curview,$kid) < $row} {
2945                 set ret $commitrow($curview,$kid)
2946             }
2947         }
2948     }
2949     return $ret
2950 }
2951
2952 proc make_idlist {row} {
2953     global displayorder parentlist uparrowlen downarrowlen mingaplen
2954     global commitidx curview ordertok children commitrow
2955
2956     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2957     if {$r < 0} {
2958         set r 0
2959     }
2960     set ra [expr {$row - $downarrowlen}]
2961     if {$ra < 0} {
2962         set ra 0
2963     }
2964     set rb [expr {$row + $uparrowlen}]
2965     if {$rb > $commitidx($curview)} {
2966         set rb $commitidx($curview)
2967     }
2968     set ids {}
2969     for {} {$r < $ra} {incr r} {
2970         set nextid [lindex $displayorder [expr {$r + 1}]]
2971         foreach p [lindex $parentlist $r] {
2972             if {$p eq $nextid} continue
2973             set rn [nextuse $p $r]
2974             if {$rn >= $row &&
2975                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2976                 lappend ids [list $ordertok($curview,$p) $p]
2977             }
2978         }
2979     }
2980     for {} {$r < $row} {incr r} {
2981         set nextid [lindex $displayorder [expr {$r + 1}]]
2982         foreach p [lindex $parentlist $r] {
2983             if {$p eq $nextid} continue
2984             set rn [nextuse $p $r]
2985             if {$rn < 0 || $rn >= $row} {
2986                 lappend ids [list $ordertok($curview,$p) $p]
2987             }
2988         }
2989     }
2990     set id [lindex $displayorder $row]
2991     lappend ids [list $ordertok($curview,$id) $id]
2992     while {$r < $rb} {
2993         foreach p [lindex $parentlist $r] {
2994             set firstkid [lindex $children($curview,$p) 0]
2995             if {$commitrow($curview,$firstkid) < $row} {
2996                 lappend ids [list $ordertok($curview,$p) $p]
2997             }
2998         }
2999         incr r
3000         set id [lindex $displayorder $r]
3001         if {$id ne {}} {
3002             set firstkid [lindex $children($curview,$id) 0]
3003             if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3004                 lappend ids [list $ordertok($curview,$id) $id]
3005             }
3006         }
3007     }
3008     set idlist {}
3009     foreach idx [lsort -unique $ids] {
3010         lappend idlist [lindex $idx 1]
3011     }
3012     return $idlist
3013 }
3014
3015 proc rowsequal {a b} {
3016     while {[set i [lsearch -exact $a {}]] >= 0} {
3017         set a [lreplace $a $i $i]
3018     }
3019     while {[set i [lsearch -exact $b {}]] >= 0} {
3020         set b [lreplace $b $i $i]
3021     }
3022     return [expr {$a eq $b}]
3023 }
3024
3025 proc makeupline {id row rend col} {
3026     global rowidlist uparrowlen downarrowlen mingaplen
3027
3028     for {set r $rend} {1} {set r $rstart} {
3029         set rstart [prevuse $id $r]
3030         if {$rstart < 0} return
3031         if {$rstart < $row} break
3032     }
3033     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3034         set rstart [expr {$rend - $uparrowlen - 1}]
3035     }
3036     for {set r $rstart} {[incr r] <= $row} {} {
3037         set idlist [lindex $rowidlist $r]
3038         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3039             set col [idcol $idlist $id $col]
3040             lset rowidlist $r [linsert $idlist $col $id]
3041             changedrow $r
3042         }
3043     }
3044 }
3045
3046 proc layoutrows {row endrow} {
3047     global rowidlist rowisopt rowfinal displayorder
3048     global uparrowlen downarrowlen maxwidth mingaplen
3049     global children parentlist
3050     global commitidx viewcomplete curview commitrow
3051
3052     set idlist {}
3053     if {$row > 0} {
3054         set rm1 [expr {$row - 1}]
3055         foreach id [lindex $rowidlist $rm1] {
3056             if {$id ne {}} {
3057                 lappend idlist $id
3058             }
3059         }
3060         set final [lindex $rowfinal $rm1]
3061     }
3062     for {} {$row < $endrow} {incr row} {
3063         set rm1 [expr {$row - 1}]
3064         if {$rm1 < 0 || $idlist eq {}} {
3065             set idlist [make_idlist $row]
3066             set final 1
3067         } else {
3068             set id [lindex $displayorder $rm1]
3069             set col [lsearch -exact $idlist $id]
3070             set idlist [lreplace $idlist $col $col]
3071             foreach p [lindex $parentlist $rm1] {
3072                 if {[lsearch -exact $idlist $p] < 0} {
3073                     set col [idcol $idlist $p $col]
3074                     set idlist [linsert $idlist $col $p]
3075                     # if not the first child, we have to insert a line going up
3076                     if {$id ne [lindex $children($curview,$p) 0]} {
3077                         makeupline $p $rm1 $row $col
3078                     }
3079                 }
3080             }
3081             set id [lindex $displayorder $row]
3082             if {$row > $downarrowlen} {
3083                 set termrow [expr {$row - $downarrowlen - 1}]
3084                 foreach p [lindex $parentlist $termrow] {
3085                     set i [lsearch -exact $idlist $p]
3086                     if {$i < 0} continue
3087                     set nr [nextuse $p $termrow]
3088                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3089                         set idlist [lreplace $idlist $i $i]
3090                     }
3091                 }
3092             }
3093             set col [lsearch -exact $idlist $id]
3094             if {$col < 0} {
3095                 set col [idcol $idlist $id]
3096                 set idlist [linsert $idlist $col $id]
3097                 if {$children($curview,$id) ne {}} {
3098                     makeupline $id $rm1 $row $col
3099                 }
3100             }
3101             set r [expr {$row + $uparrowlen - 1}]
3102             if {$r < $commitidx($curview)} {
3103                 set x $col
3104                 foreach p [lindex $parentlist $r] {
3105                     if {[lsearch -exact $idlist $p] >= 0} continue
3106                     set fk [lindex $children($curview,$p) 0]
3107                     if {$commitrow($curview,$fk) < $row} {
3108                         set x [idcol $idlist $p $x]
3109                         set idlist [linsert $idlist $x $p]
3110                     }
3111                 }
3112                 if {[incr r] < $commitidx($curview)} {
3113                     set p [lindex $displayorder $r]
3114                     if {[lsearch -exact $idlist $p] < 0} {
3115                         set fk [lindex $children($curview,$p) 0]
3116                         if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3117                             set x [idcol $idlist $p $x]
3118                             set idlist [linsert $idlist $x $p]
3119                         }
3120                     }
3121                 }
3122             }
3123         }
3124         if {$final && !$viewcomplete($curview) &&
3125             $row + $uparrowlen + $mingaplen + $downarrowlen
3126                 >= $commitidx($curview)} {
3127             set final 0
3128         }
3129         set l [llength $rowidlist]
3130         if {$row == $l} {
3131             lappend rowidlist $idlist
3132             lappend rowisopt 0
3133             lappend rowfinal $final
3134         } elseif {$row < $l} {
3135             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3136                 lset rowidlist $row $idlist
3137                 changedrow $row
3138             }
3139             lset rowfinal $row $final
3140         } else {
3141             set pad [ntimes [expr {$row - $l}] {}]
3142             set rowidlist [concat $rowidlist $pad]
3143             lappend rowidlist $idlist
3144             set rowfinal [concat $rowfinal $pad]
3145             lappend rowfinal $final
3146             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3147         }
3148     }
3149     return $row
3150 }
3151
3152 proc changedrow {row} {
3153     global displayorder iddrawn rowisopt need_redisplay
3154
3155     set l [llength $rowisopt]
3156     if {$row < $l} {
3157         lset rowisopt $row 0
3158         if {$row + 1 < $l} {
3159             lset rowisopt [expr {$row + 1}] 0
3160             if {$row + 2 < $l} {
3161                 lset rowisopt [expr {$row + 2}] 0
3162             }
3163         }
3164     }
3165     set id [lindex $displayorder $row]
3166     if {[info exists iddrawn($id)]} {
3167         set need_redisplay 1
3168     }
3169 }
3170
3171 proc insert_pad {row col npad} {
3172     global rowidlist
3173
3174     set pad [ntimes $npad {}]
3175     set idlist [lindex $rowidlist $row]
3176     set bef [lrange $idlist 0 [expr {$col - 1}]]
3177     set aft [lrange $idlist $col end]
3178     set i [lsearch -exact $aft {}]
3179     if {$i > 0} {
3180         set aft [lreplace $aft $i $i]
3181     }
3182     lset rowidlist $row [concat $bef $pad $aft]
3183     changedrow $row
3184 }
3185
3186 proc optimize_rows {row col endrow} {
3187     global rowidlist rowisopt displayorder curview children
3188
3189     if {$row < 1} {
3190         set row 1
3191     }
3192     for {} {$row < $endrow} {incr row; set col 0} {
3193         if {[lindex $rowisopt $row]} continue
3194         set haspad 0
3195         set y0 [expr {$row - 1}]
3196         set ym [expr {$row - 2}]
3197         set idlist [lindex $rowidlist $row]
3198         set previdlist [lindex $rowidlist $y0]
3199         if {$idlist eq {} || $previdlist eq {}} continue
3200         if {$ym >= 0} {
3201             set pprevidlist [lindex $rowidlist $ym]
3202             if {$pprevidlist eq {}} continue
3203         } else {
3204             set pprevidlist {}
3205         }
3206         set x0 -1
3207         set xm -1
3208         for {} {$col < [llength $idlist]} {incr col} {
3209             set id [lindex $idlist $col]
3210             if {[lindex $previdlist $col] eq $id} continue
3211             if {$id eq {}} {
3212                 set haspad 1
3213                 continue
3214             }
3215             set x0 [lsearch -exact $previdlist $id]
3216             if {$x0 < 0} continue
3217             set z [expr {$x0 - $col}]
3218             set isarrow 0
3219             set z0 {}
3220             if {$ym >= 0} {
3221                 set xm [lsearch -exact $pprevidlist $id]
3222                 if {$xm >= 0} {
3223                     set z0 [expr {$xm - $x0}]
3224                 }
3225             }
3226             if {$z0 eq {}} {
3227                 # if row y0 is the first child of $id then it's not an arrow
3228                 if {[lindex $children($curview,$id) 0] ne
3229                     [lindex $displayorder $y0]} {
3230                     set isarrow 1
3231                 }
3232             }
3233             if {!$isarrow && $id ne [lindex $displayorder $row] &&
3234                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3235                 set isarrow 1
3236             }
3237             # Looking at lines from this row to the previous row,
3238             # make them go straight up if they end in an arrow on
3239             # the previous row; otherwise make them go straight up
3240             # or at 45 degrees.
3241             if {$z < -1 || ($z < 0 && $isarrow)} {
3242                 # Line currently goes left too much;
3243                 # insert pads in the previous row, then optimize it
3244                 set npad [expr {-1 - $z + $isarrow}]
3245                 insert_pad $y0 $x0 $npad
3246                 if {$y0 > 0} {
3247                     optimize_rows $y0 $x0 $row
3248                 }
3249                 set previdlist [lindex $rowidlist $y0]
3250                 set x0 [lsearch -exact $previdlist $id]
3251                 set z [expr {$x0 - $col}]
3252                 if {$z0 ne {}} {
3253                     set pprevidlist [lindex $rowidlist $ym]
3254                     set xm [lsearch -exact $pprevidlist $id]
3255                     set z0 [expr {$xm - $x0}]
3256                 }
3257             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3258                 # Line currently goes right too much;
3259                 # insert pads in this line
3260                 set npad [expr {$z - 1 + $isarrow}]
3261                 insert_pad $row $col $npad
3262                 set idlist [lindex $rowidlist $row]
3263                 incr col $npad
3264                 set z [expr {$x0 - $col}]
3265                 set haspad 1
3266             }
3267             if {$z0 eq {} && !$isarrow && $ym >= 0} {
3268                 # this line links to its first child on row $row-2
3269                 set id [lindex $displayorder $ym]
3270                 set xc [lsearch -exact $pprevidlist $id]
3271                 if {$xc >= 0} {
3272                     set z0 [expr {$xc - $x0}]
3273                 }
3274             }
3275             # avoid lines jigging left then immediately right
3276             if {$z0 ne {} && $z < 0 && $z0 > 0} {
3277                 insert_pad $y0 $x0 1
3278                 incr x0
3279                 optimize_rows $y0 $x0 $row
3280                 set previdlist [lindex $rowidlist $y0]
3281             }
3282         }
3283         if {!$haspad} {
3284             # Find the first column that doesn't have a line going right
3285             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3286                 set id [lindex $idlist $col]
3287                 if {$id eq {}} break
3288                 set x0 [lsearch -exact $previdlist $id]
3289                 if {$x0 < 0} {
3290                     # check if this is the link to the first child
3291                     set kid [lindex $displayorder $y0]
3292                     if {[lindex $children($curview,$id) 0] eq $kid} {
3293                         # it is, work out offset to child
3294                         set x0 [lsearch -exact $previdlist $kid]
3295                     }
3296                 }
3297                 if {$x0 <= $col} break
3298             }
3299             # Insert a pad at that column as long as it has a line and
3300             # isn't the last column
3301             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3302                 set idlist [linsert $idlist $col {}]
3303                 lset rowidlist $row $idlist
3304                 changedrow $row
3305             }
3306         }
3307     }
3308 }
3309
3310 proc xc {row col} {
3311     global canvx0 linespc
3312     return [expr {$canvx0 + $col * $linespc}]
3313 }
3314
3315 proc yc {row} {
3316     global canvy0 linespc
3317     return [expr {$canvy0 + $row * $linespc}]
3318 }
3319
3320 proc linewidth {id} {
3321     global thickerline lthickness
3322
3323     set wid $lthickness
3324     if {[info exists thickerline] && $id eq $thickerline} {
3325         set wid [expr {2 * $lthickness}]
3326     }
3327     return $wid
3328 }
3329
3330 proc rowranges {id} {
3331     global commitrow curview children uparrowlen downarrowlen
3332     global rowidlist
3333
3334     set kids $children($curview,$id)
3335     if {$kids eq {}} {
3336         return {}
3337     }
3338     set ret {}
3339     lappend kids $id
3340     foreach child $kids {
3341         if {![info exists commitrow($curview,$child)]} break
3342         set row $commitrow($curview,$child)
3343         if {![info exists prev]} {
3344             lappend ret [expr {$row + 1}]
3345         } else {
3346             if {$row <= $prevrow} {
3347                 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3348             }
3349             # see if the line extends the whole way from prevrow to row
3350             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3351                 [lsearch -exact [lindex $rowidlist \
3352                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3353                 # it doesn't, see where it ends
3354                 set r [expr {$prevrow + $downarrowlen}]
3355                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3356                     while {[incr r -1] > $prevrow &&
3357                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3358                 } else {
3359                     while {[incr r] <= $row &&
3360                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3361                     incr r -1
3362                 }
3363                 lappend ret $r
3364                 # see where it starts up again
3365                 set r [expr {$row - $uparrowlen}]
3366                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3367                     while {[incr r] < $row &&
3368                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3369                 } else {
3370                     while {[incr r -1] >= $prevrow &&
3371                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3372                     incr r
3373                 }
3374                 lappend ret $r
3375             }
3376         }
3377         if {$child eq $id} {
3378             lappend ret $row
3379         }
3380         set prev $id
3381         set prevrow $row
3382     }
3383     return $ret
3384 }
3385
3386 proc drawlineseg {id row endrow arrowlow} {
3387     global rowidlist displayorder iddrawn linesegs
3388     global canv colormap linespc curview maxlinelen parentlist
3389
3390     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3391     set le [expr {$row + 1}]
3392     set arrowhigh 1
3393     while {1} {
3394         set c [lsearch -exact [lindex $rowidlist $le] $id]
3395         if {$c < 0} {
3396             incr le -1
3397             break
3398         }
3399         lappend cols $c
3400         set x [lindex $displayorder $le]
3401         if {$x eq $id} {
3402             set arrowhigh 0
3403             break
3404         }
3405         if {[info exists iddrawn($x)] || $le == $endrow} {
3406             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3407             if {$c >= 0} {
3408                 lappend cols $c
3409                 set arrowhigh 0
3410             }
3411             break
3412         }
3413         incr le
3414     }
3415     if {$le <= $row} {
3416         return $row
3417     }
3418
3419     set lines {}
3420     set i 0
3421     set joinhigh 0
3422     if {[info exists linesegs($id)]} {
3423         set lines $linesegs($id)
3424         foreach li $lines {
3425             set r0 [lindex $li 0]
3426             if {$r0 > $row} {
3427                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3428                     set joinhigh 1
3429                 }
3430                 break
3431             }
3432             incr i
3433         }
3434     }
3435     set joinlow 0
3436     if {$i > 0} {
3437         set li [lindex $lines [expr {$i-1}]]
3438         set r1 [lindex $li 1]
3439         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3440             set joinlow 1
3441         }
3442     }
3443
3444     set x [lindex $cols [expr {$le - $row}]]
3445     set xp [lindex $cols [expr {$le - 1 - $row}]]
3446     set dir [expr {$xp - $x}]
3447     if {$joinhigh} {
3448         set ith [lindex $lines $i 2]
3449         set coords [$canv coords $ith]
3450         set ah [$canv itemcget $ith -arrow]
3451         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3452         set x2 [lindex $cols [expr {$le + 1 - $row}]]
3453         if {$x2 ne {} && $x - $x2 == $dir} {
3454             set coords [lrange $coords 0 end-2]
3455         }
3456     } else {
3457         set coords [list [xc $le $x] [yc $le]]
3458     }
3459     if {$joinlow} {
3460         set itl [lindex $lines [expr {$i-1}] 2]
3461         set al [$canv itemcget $itl -arrow]
3462         set arrowlow [expr {$al eq "last" || $al eq "both"}]
3463     } elseif {$arrowlow} {
3464         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3465             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3466             set arrowlow 0
3467         }
3468     }
3469     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3470     for {set y $le} {[incr y -1] > $row} {} {
3471         set x $xp
3472         set xp [lindex $cols [expr {$y - 1 - $row}]]
3473         set ndir [expr {$xp - $x}]
3474         if {$dir != $ndir || $xp < 0} {
3475             lappend coords [xc $y $x] [yc $y]
3476         }
3477         set dir $ndir
3478     }
3479     if {!$joinlow} {
3480         if {$xp < 0} {
3481             # join parent line to first child
3482             set ch [lindex $displayorder $row]
3483             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3484             if {$xc < 0} {
3485                 puts "oops: drawlineseg: child $ch not on row $row"
3486             } elseif {$xc != $x} {
3487                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3488                     set d [expr {int(0.5 * $linespc)}]
3489                     set x1 [xc $row $x]
3490                     if {$xc < $x} {
3491                         set x2 [expr {$x1 - $d}]
3492                     } else {
3493                         set x2 [expr {$x1 + $d}]
3494                     }
3495                     set y2 [yc $row]
3496                     set y1 [expr {$y2 + $d}]
3497                     lappend coords $x1 $y1 $x2 $y2
3498                 } elseif {$xc < $x - 1} {
3499                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
3500                 } elseif {$xc > $x + 1} {
3501                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
3502                 }
3503                 set x $xc
3504             }
3505             lappend coords [xc $row $x] [yc $row]
3506         } else {
3507             set xn [xc $row $xp]
3508             set yn [yc $row]
3509             lappend coords $xn $yn
3510         }
3511         if {!$joinhigh} {
3512             assigncolor $id
3513             set t [$canv create line $coords -width [linewidth $id] \
3514                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
3515             $canv lower $t
3516             bindline $t $id
3517             set lines [linsert $lines $i [list $row $le $t]]
3518         } else {
3519             $canv coords $ith $coords
3520             if {$arrow ne $ah} {
3521                 $canv itemconf $ith -arrow $arrow
3522             }
3523             lset lines $i 0 $row
3524         }
3525     } else {
3526         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3527         set ndir [expr {$xo - $xp}]
3528         set clow [$canv coords $itl]
3529         if {$dir == $ndir} {
3530             set clow [lrange $clow 2 end]
3531         }
3532         set coords [concat $coords $clow]
3533         if {!$joinhigh} {
3534             lset lines [expr {$i-1}] 1 $le
3535         } else {
3536             # coalesce two pieces
3537             $canv delete $ith
3538             set b [lindex $lines [expr {$i-1}] 0]
3539             set e [lindex $lines $i 1]
3540             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3541         }
3542         $canv coords $itl $coords
3543         if {$arrow ne $al} {
3544             $canv itemconf $itl -arrow $arrow
3545         }
3546     }
3547
3548     set linesegs($id) $lines
3549     return $le
3550 }
3551
3552 proc drawparentlinks {id row} {
3553     global rowidlist canv colormap curview parentlist
3554     global idpos linespc
3555
3556     set rowids [lindex $rowidlist $row]
3557     set col [lsearch -exact $rowids $id]
3558     if {$col < 0} return
3559     set olds [lindex $parentlist $row]
3560     set row2 [expr {$row + 1}]
3561     set x [xc $row $col]
3562     set y [yc $row]
3563     set y2 [yc $row2]
3564     set d [expr {int(0.5 * $linespc)}]
3565     set ymid [expr {$y + $d}]
3566     set ids [lindex $rowidlist $row2]
3567     # rmx = right-most X coord used
3568     set rmx 0
3569     foreach p $olds {
3570         set i [lsearch -exact $ids $p]
3571         if {$i < 0} {
3572             puts "oops, parent $p of $id not in list"
3573             continue
3574         }
3575         set x2 [xc $row2 $i]
3576         if {$x2 > $rmx} {
3577             set rmx $x2
3578         }
3579         set j [lsearch -exact $rowids $p]
3580         if {$j < 0} {
3581             # drawlineseg will do this one for us
3582             continue
3583         }
3584         assigncolor $p
3585         # should handle duplicated parents here...
3586         set coords [list $x $y]
3587         if {$i != $col} {
3588             # if attaching to a vertical segment, draw a smaller
3589             # slant for visual distinctness
3590             if {$i == $j} {
3591                 if {$i < $col} {
3592                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3593                 } else {
3594                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3595                 }
3596             } elseif {$i < $col && $i < $j} {
3597                 # segment slants towards us already
3598                 lappend coords [xc $row $j] $y
3599             } else {
3600                 if {$i < $col - 1} {
3601                     lappend coords [expr {$x2 + $linespc}] $y
3602                 } elseif {$i > $col + 1} {
3603                     lappend coords [expr {$x2 - $linespc}] $y
3604                 }
3605                 lappend coords $x2 $y2
3606             }
3607         } else {
3608             lappend coords $x2 $y2
3609         }
3610         set t [$canv create line $coords -width [linewidth $p] \
3611                    -fill $colormap($p) -tags lines.$p]
3612         $canv lower $t
3613         bindline $t $p
3614     }
3615     if {$rmx > [lindex $idpos($id) 1]} {
3616         lset idpos($id) 1 $rmx
3617         redrawtags $id
3618     }
3619 }
3620
3621 proc drawlines {id} {
3622     global canv
3623
3624     $canv itemconf lines.$id -width [linewidth $id]
3625 }
3626
3627 proc drawcmittext {id row col} {
3628     global linespc canv canv2 canv3 canvy0 fgcolor curview
3629     global commitlisted commitinfo rowidlist parentlist
3630     global rowtextx idpos idtags idheads idotherrefs
3631     global linehtag linentag linedtag selectedline
3632     global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3633
3634     # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3635     set listed [lindex $commitlisted $row]
3636     if {$id eq $nullid} {
3637         set ofill red
3638     } elseif {$id eq $nullid2} {
3639         set ofill green
3640     } else {
3641         set ofill [expr {$listed != 0? "blue": "white"}]
3642     }
3643     set x [xc $row $col]
3644     set y [yc $row]
3645     set orad [expr {$linespc / 3}]
3646     if {$listed <= 1} {
3647         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3648                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3649                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3650     } elseif {$listed == 2} {
3651         # triangle pointing left for left-side commits
3652         set t [$canv create polygon \
3653                    [expr {$x - $orad}] $y \
3654                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3655                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3656                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3657     } else {
3658         # triangle pointing right for right-side commits
3659         set t [$canv create polygon \
3660                    [expr {$x + $orad - 1}] $y \
3661                    [expr {$x - $orad}] [expr {$y - $orad}] \
3662                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3663                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3664     }
3665     $canv raise $t
3666     $canv bind $t <1> {selcanvline {} %x %y}
3667     set rmx [llength [lindex $rowidlist $row]]
3668     set olds [lindex $parentlist $row]
3669     if {$olds ne {}} {
3670         set nextids [lindex $rowidlist [expr {$row + 1}]]
3671         foreach p $olds {
3672             set i [lsearch -exact $nextids $p]
3673             if {$i > $rmx} {
3674                 set rmx $i
3675             }
3676         }
3677     }
3678     set xt [xc $row $rmx]
3679     set rowtextx($row) $xt
3680     set idpos($id) [list $x $xt $y]
3681     if {[info exists idtags($id)] || [info exists idheads($id)]
3682         || [info exists idotherrefs($id)]} {
3683         set xt [drawtags $id $x $xt $y]
3684     }
3685     set headline [lindex $commitinfo($id) 0]
3686     set name [lindex $commitinfo($id) 1]
3687     set date [lindex $commitinfo($id) 2]
3688     set date [formatdate $date]
3689     set font mainfont
3690     set nfont mainfont
3691     set isbold [ishighlighted $row]
3692     if {$isbold > 0} {
3693         lappend boldrows $row
3694         set font mainfontbold
3695         if {$isbold > 1} {
3696             lappend boldnamerows $row
3697             set nfont mainfontbold
3698         }
3699     }
3700     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3701                             -text $headline -font $font -tags text]
3702     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3703     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3704                             -text $name -font $nfont -tags text]
3705     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3706                             -text $date -font mainfont -tags text]
3707     if {[info exists selectedline] && $selectedline == $row} {
3708         make_secsel $row
3709     }
3710     set xr [expr {$xt + [font measure $font $headline]}]
3711     if {$xr > $canvxmax} {
3712         set canvxmax $xr
3713         setcanvscroll
3714     }
3715 }
3716
3717 proc drawcmitrow {row} {
3718     global displayorder rowidlist nrows_drawn
3719     global iddrawn markingmatches
3720     global commitinfo parentlist numcommits
3721     global filehighlight fhighlights findpattern nhighlights
3722     global hlview vhighlights
3723     global highlight_related rhighlights
3724
3725     if {$row >= $numcommits} return
3726
3727     set id [lindex $displayorder $row]
3728     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3729         askvhighlight $row $id
3730     }
3731     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3732         askfilehighlight $row $id
3733     }
3734     if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3735         askfindhighlight $row $id
3736     }
3737     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3738         askrelhighlight $row $id
3739     }
3740     if {![info exists iddrawn($id)]} {
3741         set col [lsearch -exact [lindex $rowidlist $row] $id]
3742         if {$col < 0} {
3743             puts "oops, row $row id $id not in list"
3744             return
3745         }
3746         if {![info exists commitinfo($id)]} {
3747             getcommit $id
3748         }
3749         assigncolor $id
3750         drawcmittext $id $row $col
3751         set iddrawn($id) 1
3752         incr nrows_drawn
3753     }
3754     if {$markingmatches} {
3755         markrowmatches $row $id
3756     }
3757 }
3758
3759 proc drawcommits {row {endrow {}}} {
3760     global numcommits iddrawn displayorder curview need_redisplay
3761     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3762
3763     if {$row < 0} {
3764         set row 0
3765     }
3766     if {$endrow eq {}} {
3767         set endrow $row
3768     }
3769     if {$endrow >= $numcommits} {
3770         set endrow [expr {$numcommits - 1}]
3771     }
3772
3773     set rl1 [expr {$row - $downarrowlen - 3}]
3774     if {$rl1 < 0} {
3775         set rl1 0
3776     }
3777     set ro1 [expr {$row - 3}]
3778     if {$ro1 < 0} {
3779         set ro1 0
3780     }
3781     set r2 [expr {$endrow + $uparrowlen + 3}]
3782     if {$r2 > $numcommits} {
3783         set r2 $numcommits
3784     }
3785     for {set r $rl1} {$r < $r2} {incr r} {
3786         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3787             if {$rl1 < $r} {
3788                 layoutrows $rl1 $r
3789             }
3790             set rl1 [expr {$r + 1}]
3791         }
3792     }
3793     if {$rl1 < $r} {
3794         layoutrows $rl1 $r
3795     }
3796     optimize_rows $ro1 0 $r2
3797     if {$need_redisplay || $nrows_drawn > 2000} {
3798         clear_display
3799         drawvisible
3800     }
3801
3802     # make the lines join to already-drawn rows either side
3803     set r [expr {$row - 1}]
3804     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3805         set r $row
3806     }
3807     set er [expr {$endrow + 1}]
3808     if {$er >= $numcommits ||
3809         ![info exists iddrawn([lindex $displayorder $er])]} {
3810         set er $endrow
3811     }
3812     for {} {$r <= $er} {incr r} {
3813         set id [lindex $displayorder $r]
3814         set wasdrawn [info exists iddrawn($id)]
3815         drawcmitrow $r
3816         if {$r == $er} break
3817         set nextid [lindex $displayorder [expr {$r + 1}]]
3818         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3819         drawparentlinks $id $r
3820
3821         set rowids [lindex $rowidlist $r]
3822         foreach lid $rowids {
3823             if {$lid eq {}} continue
3824             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3825             if {$lid eq $id} {
3826                 # see if this is the first child of any of its parents
3827                 foreach p [lindex $parentlist $r] {
3828                     if {[lsearch -exact $rowids $p] < 0} {
3829                         # make this line extend up to the child
3830                         set lineend($p) [drawlineseg $p $r $er 0]
3831                     }
3832                 }
3833             } else {
3834                 set lineend($lid) [drawlineseg $lid $r $er 1]
3835             }
3836         }
3837     }
3838 }
3839
3840 proc drawfrac {f0 f1} {
3841     global canv linespc
3842
3843     set ymax [lindex [$canv cget -scrollregion] 3]
3844     if {$ymax eq {} || $ymax == 0} return
3845     set y0 [expr {int($f0 * $ymax)}]
3846     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3847     set y1 [expr {int($f1 * $ymax)}]
3848     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3849     drawcommits $row $endrow
3850 }
3851
3852 proc drawvisible {} {
3853     global canv
3854     eval drawfrac [$canv yview]
3855 }
3856
3857 proc clear_display {} {
3858     global iddrawn linesegs need_redisplay nrows_drawn
3859     global vhighlights fhighlights nhighlights rhighlights
3860
3861     allcanvs delete all
3862     catch {unset iddrawn}
3863     catch {unset linesegs}
3864     catch {unset vhighlights}
3865     catch {unset fhighlights}
3866     catch {unset nhighlights}
3867     catch {unset rhighlights}
3868     set need_redisplay 0
3869     set nrows_drawn 0
3870 }
3871
3872 proc findcrossings {id} {
3873     global rowidlist parentlist numcommits displayorder
3874
3875     set cross {}
3876     set ccross {}
3877     foreach {s e} [rowranges $id] {
3878         if {$e >= $numcommits} {
3879             set e [expr {$numcommits - 1}]
3880         }
3881         if {$e <= $s} continue
3882         for {set row $e} {[incr row -1] >= $s} {} {
3883             set x [lsearch -exact [lindex $rowidlist $row] $id]
3884             if {$x < 0} break
3885             set olds [lindex $parentlist $row]
3886             set kid [lindex $displayorder $row]
3887             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3888             if {$kidx < 0} continue
3889             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3890             foreach p $olds {
3891                 set px [lsearch -exact $nextrow $p]
3892                 if {$px < 0} continue
3893                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3894                     if {[lsearch -exact $ccross $p] >= 0} continue
3895                     if {$x == $px + ($kidx < $px? -1: 1)} {
3896                         lappend ccross $p
3897                     } elseif {[lsearch -exact $cross $p] < 0} {
3898                         lappend cross $p
3899                     }
3900                 }
3901             }
3902         }
3903     }
3904     return [concat $ccross {{}} $cross]
3905 }
3906
3907 proc assigncolor {id} {
3908     global colormap colors nextcolor
3909     global commitrow parentlist children children curview
3910
3911     if {[info exists colormap($id)]} return
3912     set ncolors [llength $colors]
3913     if {[info exists children($curview,$id)]} {
3914         set kids $children($curview,$id)
3915     } else {
3916         set kids {}
3917     }
3918     if {[llength $kids] == 1} {
3919         set child [lindex $kids 0]
3920         if {[info exists colormap($child)]
3921             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3922             set colormap($id) $colormap($child)
3923             return
3924         }
3925     }
3926     set badcolors {}
3927     set origbad {}
3928     foreach x [findcrossings $id] {
3929         if {$x eq {}} {
3930             # delimiter between corner crossings and other crossings
3931             if {[llength $badcolors] >= $ncolors - 1} break
3932             set origbad $badcolors
3933         }
3934         if {[info exists colormap($x)]
3935             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3936             lappend badcolors $colormap($x)
3937         }
3938     }
3939     if {[llength $badcolors] >= $ncolors} {
3940         set badcolors $origbad
3941     }
3942     set origbad $badcolors
3943     if {[llength $badcolors] < $ncolors - 1} {
3944         foreach child $kids {
3945             if {[info exists colormap($child)]
3946                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3947                 lappend badcolors $colormap($child)
3948             }
3949             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3950                 if {[info exists colormap($p)]
3951                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3952                     lappend badcolors $colormap($p)
3953                 }
3954             }
3955         }
3956         if {[llength $badcolors] >= $ncolors} {
3957             set badcolors $origbad
3958         }
3959     }
3960     for {set i 0} {$i <= $ncolors} {incr i} {
3961         set c [lindex $colors $nextcolor]
3962         if {[incr nextcolor] >= $ncolors} {
3963             set nextcolor 0
3964         }
3965         if {[lsearch -exact $badcolors $c]} break
3966     }
3967     set colormap($id) $c
3968 }
3969
3970 proc bindline {t id} {
3971     global canv
3972
3973     $canv bind $t <Enter> "lineenter %x %y $id"
3974     $canv bind $t <Motion> "linemotion %x %y $id"
3975     $canv bind $t <Leave> "lineleave $id"
3976     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3977 }
3978
3979 proc drawtags {id x xt y1} {
3980     global idtags idheads idotherrefs mainhead
3981     global linespc lthickness
3982     global canv commitrow rowtextx curview fgcolor bgcolor
3983
3984     set marks {}
3985     set ntags 0
3986     set nheads 0
3987     if {[info exists idtags($id)]} {
3988         set marks $idtags($id)
3989         set ntags [llength $marks]
3990     }
3991     if {[info exists idheads($id)]} {
3992         set marks [concat $marks $idheads($id)]
3993         set nheads [llength $idheads($id)]
3994     }
3995     if {[info exists idotherrefs($id)]} {
3996         set marks [concat $marks $idotherrefs($id)]
3997     }
3998     if {$marks eq {}} {
3999         return $xt
4000     }
4001
4002     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4003     set yt [expr {$y1 - 0.5 * $linespc}]
4004     set yb [expr {$yt + $linespc - 1}]
4005     set xvals {}
4006     set wvals {}
4007     set i -1
4008     foreach tag $marks {
4009         incr i
4010         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4011             set wid [font measure mainfontbold $tag]
4012         } else {
4013             set wid [font measure mainfont $tag]
4014         }
4015         lappend xvals $xt
4016         lappend wvals $wid
4017         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4018     }
4019     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4020                -width $lthickness -fill black -tags tag.$id]
4021     $canv lower $t
4022     foreach tag $marks x $xvals wid $wvals {
4023         set xl [expr {$x + $delta}]
4024         set xr [expr {$x + $delta + $wid + $lthickness}]
4025         set font mainfont
4026         if {[incr ntags -1] >= 0} {
4027             # draw a tag
4028             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4029                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4030                        -width 1 -outline black -fill yellow -tags tag.$id]
4031             $canv bind $t <1> [list showtag $tag 1]
4032             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4033         } else {
4034             # draw a head or other ref
4035             if {[incr nheads -1] >= 0} {
4036                 set col green
4037                 if {$tag eq $mainhead} {
4038                     set font mainfontbold
4039                 }
4040             } else {
4041                 set col "#ddddff"
4042             }
4043             set xl [expr {$xl - $delta/2}]
4044             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4045                 -width 1 -outline black -fill $col -tags tag.$id
4046             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4047                 set rwid [font measure mainfont $remoteprefix]
4048                 set xi [expr {$x + 1}]
4049                 set yti [expr {$yt + 1}]
4050                 set xri [expr {$x + $rwid}]
4051                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4052                         -width 0 -fill "#ffddaa" -tags tag.$id
4053             }
4054         }
4055         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4056                    -font $font -tags [list tag.$id text]]
4057         if {$ntags >= 0} {
4058             $canv bind $t <1> [list showtag $tag 1]
4059         } elseif {$nheads >= 0} {
4060             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4061         }
4062     }
4063     return $xt
4064 }
4065
4066 proc xcoord {i level ln} {
4067     global canvx0 xspc1 xspc2
4068
4069     set x [expr {$canvx0 + $i * $xspc1($ln)}]
4070     if {$i > 0 && $i == $level} {
4071         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4072     } elseif {$i > $level} {
4073         set x [expr {$x + $xspc2 - $xspc1($ln)}]
4074     }
4075     return $x
4076 }
4077
4078 proc show_status {msg} {
4079     global canv fgcolor
4080
4081     clear_display
4082     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4083         -tags text -fill $fgcolor
4084 }
4085
4086 # Insert a new commit as the child of the commit on row $row.
4087 # The new commit will be displayed on row $row and the commits
4088 # on that row and below will move down one row.
4089 proc insertrow {row newcmit} {
4090     global displayorder parentlist commitlisted children
4091     global commitrow curview rowidlist rowisopt rowfinal numcommits
4092     global numcommits
4093     global selectedline commitidx ordertok
4094
4095     if {$row >= $numcommits} {
4096         puts "oops, inserting new row $row but only have $numcommits rows"
4097         return
4098     }
4099     set p [lindex $displayorder $row]
4100     set displayorder [linsert $displayorder $row $newcmit]
4101     set parentlist [linsert $parentlist $row $p]
4102     set kids $children($curview,$p)
4103     lappend kids $newcmit
4104     set children($curview,$p) $kids
4105     set children($curview,$newcmit) {}
4106     set commitlisted [linsert $commitlisted $row 1]
4107     set l [llength $displayorder]
4108     for {set r $row} {$r < $l} {incr r} {
4109         set id [lindex $displayorder $r]
4110         set commitrow($curview,$id) $r
4111     }
4112     incr commitidx($curview)
4113     set ordertok($curview,$newcmit) $ordertok($curview,$p)
4114
4115     if {$row < [llength $rowidlist]} {
4116         set idlist [lindex $rowidlist $row]
4117         if {$idlist ne {}} {
4118             if {[llength $kids] == 1} {
4119                 set col [lsearch -exact $idlist $p]
4120                 lset idlist $col $newcmit
4121             } else {
4122                 set col [llength $idlist]
4123                 lappend idlist $newcmit
4124             }
4125         }
4126         set rowidlist [linsert $rowidlist $row $idlist]
4127         set rowisopt [linsert $rowisopt $row 0]
4128         set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4129     }
4130
4131     incr numcommits
4132
4133     if {[info exists selectedline] && $selectedline >= $row} {
4134         incr selectedline
4135     }
4136     redisplay
4137 }
4138
4139 # Remove a commit that was inserted with insertrow on row $row.
4140 proc removerow {row} {
4141     global displayorder parentlist commitlisted children
4142     global commitrow curview rowidlist rowisopt rowfinal numcommits
4143     global numcommits
4144     global linesegends selectedline commitidx
4145
4146     if {$row >= $numcommits} {
4147         puts "oops, removing row $row but only have $numcommits rows"
4148         return
4149     }
4150     set rp1 [expr {$row + 1}]
4151     set id [lindex $displayorder $row]
4152     set p [lindex $parentlist $row]
4153     set displayorder [lreplace $displayorder $row $row]
4154     set parentlist [lreplace $parentlist $row $row]
4155     set commitlisted [lreplace $commitlisted $row $row]
4156     set kids $children($curview,$p)
4157     set i [lsearch -exact $kids $id]
4158     if {$i >= 0} {
4159         set kids [lreplace $kids $i $i]
4160         set children($curview,$p) $kids
4161     }
4162     set l [llength $displayorder]
4163     for {set r $row} {$r < $l} {incr r} {
4164         set id [lindex $displayorder $r]
4165         set commitrow($curview,$id) $r
4166     }
4167     incr commitidx($curview) -1
4168
4169     if {$row < [llength $rowidlist]} {
4170         set rowidlist [lreplace $rowidlist $row $row]
4171         set rowisopt [lreplace $rowisopt $row $row]
4172         set rowfinal [lreplace $rowfinal $row $row]
4173     }
4174
4175     incr numcommits -1
4176
4177     if {[info exists selectedline] && $selectedline > $row} {
4178         incr selectedline -1
4179     }
4180     redisplay
4181 }
4182
4183 # Don't change the text pane cursor if it is currently the hand cursor,
4184 # showing that we are over a sha1 ID link.
4185 proc settextcursor {c} {
4186     global ctext curtextcursor
4187
4188     if {[$ctext cget -cursor] == $curtextcursor} {
4189         $ctext config -cursor $c
4190     }
4191     set curtextcursor $c
4192 }
4193
4194 proc nowbusy {what {name {}}} {
4195     global isbusy busyname statusw
4196
4197     if {[array names isbusy] eq {}} {
4198         . config -cursor watch
4199         settextcursor watch
4200     }
4201     set isbusy($what) 1
4202     set busyname($what) $name
4203     if {$name ne {}} {
4204         $statusw conf -text $name
4205     }
4206 }
4207
4208 proc notbusy {what} {
4209     global isbusy maincursor textcursor busyname statusw
4210
4211     catch {
4212         unset isbusy($what)
4213         if {$busyname($what) ne {} &&
4214             [$statusw cget -text] eq $busyname($what)} {
4215             $statusw conf -text {}
4216         }
4217     }
4218     if {[array names isbusy] eq {}} {
4219         . config -cursor $maincursor
4220         settextcursor $textcursor
4221     }
4222 }
4223
4224 proc findmatches {f} {
4225     global findtype findstring
4226     if {$findtype == [mc "Regexp"]} {
4227         set matches [regexp -indices -all -inline $findstring $f]
4228     } else {
4229         set fs $findstring
4230         if {$findtype == [mc "IgnCase"]} {
4231             set f [string tolower $f]
4232             set fs [string tolower $fs]
4233         }
4234         set matches {}
4235         set i 0
4236         set l [string length $fs]
4237         while {[set j [string first $fs $f $i]] >= 0} {
4238             lappend matches [list $j [expr {$j+$l-1}]]
4239             set i [expr {$j + $l}]
4240         }
4241     }
4242     return $matches
4243 }
4244
4245 proc dofind {{dirn 1} {wrap 1}} {
4246     global findstring findstartline findcurline selectedline numcommits
4247     global gdttype filehighlight fh_serial find_dirn findallowwrap
4248
4249     if {[info exists find_dirn]} {
4250         if {$find_dirn == $dirn} return
4251         stopfinding
4252     }
4253     focus .
4254     if {$findstring eq {} || $numcommits == 0} return
4255     if {![info exists selectedline]} {
4256         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4257     } else {
4258         set findstartline $selectedline
4259     }
4260     set findcurline $findstartline
4261     nowbusy finding [mc "Searching"]
4262     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4263         after cancel do_file_hl $fh_serial
4264         do_file_hl $fh_serial
4265     }
4266     set find_dirn $dirn
4267     set findallowwrap $wrap
4268     run findmore
4269 }
4270
4271 proc stopfinding {} {
4272     global find_dirn findcurline fprogcoord
4273
4274     if {[info exists find_dirn]} {
4275         unset find_dirn
4276         unset findcurline
4277         notbusy finding
4278         set fprogcoord 0
4279         adjustprogress
4280     }
4281 }
4282
4283 proc findmore {} {
4284     global commitdata commitinfo numcommits findpattern findloc
4285     global findstartline findcurline displayorder
4286     global find_dirn gdttype fhighlights fprogcoord
4287     global findallowwrap
4288
4289     if {![info exists find_dirn]} {
4290         return 0
4291     }
4292     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4293     set l $findcurline
4294     set moretodo 0
4295     if {$find_dirn > 0} {
4296         incr l
4297         if {$l >= $numcommits} {
4298             set l 0
4299         }
4300         if {$l <= $findstartline} {
4301             set lim [expr {$findstartline + 1}]
4302         } else {
4303             set lim $numcommits
4304             set moretodo $findallowwrap
4305         }
4306     } else {
4307         if {$l == 0} {
4308             set l $numcommits
4309         }
4310         incr l -1
4311         if {$l >= $findstartline} {
4312             set lim [expr {$findstartline - 1}]
4313         } else {
4314             set lim -1
4315             set moretodo $findallowwrap
4316         }
4317     }
4318     set n [expr {($lim - $l) * $find_dirn}]
4319     if {$n > 500} {
4320         set n 500
4321         set moretodo 1
4322     }
4323     set found 0
4324     set domore 1
4325     if {$gdttype eq [mc "containing:"]} {
4326         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4327             set id [lindex $displayorder $l]
4328             # shouldn't happen unless git log doesn't give all the commits...
4329             if {![info exists commitdata($id)]} continue
4330             if {![doesmatch $commitdata($id)]} continue
4331             if {![info exists commitinfo($id)]} {
4332                 getcommit $id
4333             }
4334             set info $commitinfo($id)
4335             foreach f $info ty $fldtypes {
4336                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4337                     [doesmatch $f]} {
4338                     set found 1
4339                     break
4340                 }
4341             }
4342             if {$found} break
4343         }
4344     } else {
4345         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4346             set id [lindex $displayorder $l]
4347             if {![info exists fhighlights($l)]} {
4348                 askfilehighlight $l $id
4349                 if {$domore} {
4350                     set domore 0
4351                     set findcurline [expr {$l - $find_dirn}]
4352                 }
4353             } elseif {$fhighlights($l)} {
4354                 set found $domore
4355                 break
4356             }
4357         }
4358     }
4359     if {$found || ($domore && !$moretodo)} {
4360         unset findcurline
4361         unset find_dirn
4362         notbusy finding
4363         set fprogcoord 0
4364         adjustprogress
4365         if {$found} {
4366             findselectline $l
4367         } else {
4368             bell
4369         }
4370         return 0
4371     }
4372     if {!$domore} {
4373         flushhighlights
4374     } else {
4375         set findcurline [expr {$l - $find_dirn}]
4376     }
4377     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4378     if {$n < 0} {
4379         incr n $numcommits
4380     }
4381     set fprogcoord [expr {$n * 1.0 / $numcommits}]
4382     adjustprogress
4383     return $domore
4384 }
4385
4386 proc findselectline {l} {
4387     global findloc commentend ctext findcurline markingmatches gdttype
4388
4389     set markingmatches 1
4390     set findcurline $l
4391     selectline $l 1
4392     if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4393         # highlight the matches in the comments
4394         set f [$ctext get 1.0 $commentend]
4395         set matches [findmatches $f]
4396         foreach match $matches {
4397             set start [lindex $match 0]
4398             set end [expr {[lindex $match 1] + 1}]
4399             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4400         }
4401     }
4402     drawvisible
4403 }
4404
4405 # mark the bits of a headline or author that match a find string
4406 proc markmatches {canv l str tag matches font row} {
4407     global selectedline
4408
4409     set bbox [$canv bbox $tag]
4410     set x0 [lindex $bbox 0]
4411     set y0 [lindex $bbox 1]
4412     set y1 [lindex $bbox 3]
4413     foreach match $matches {
4414         set start [lindex $match 0]
4415         set end [lindex $match 1]
4416         if {$start > $end} continue
4417         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4418         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4419         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4420                    [expr {$x0+$xlen+2}] $y1 \
4421                    -outline {} -tags [list match$l matches] -fill yellow]
4422         $canv lower $t
4423         if {[info exists selectedline] && $row == $selectedline} {
4424             $canv raise $t secsel
4425         }
4426     }
4427 }
4428
4429 proc unmarkmatches {} {
4430     global markingmatches
4431
4432     allcanvs delete matches
4433     set markingmatches 0
4434     stopfinding
4435 }
4436
4437 proc selcanvline {w x y} {
4438     global canv canvy0 ctext linespc
4439     global rowtextx
4440     set ymax [lindex [$canv cget -scrollregion] 3]
4441     if {$ymax == {}} return
4442     set yfrac [lindex [$canv yview] 0]
4443     set y [expr {$y + $yfrac * $ymax}]
4444     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4445     if {$l < 0} {
4446         set l 0
4447     }
4448     if {$w eq $canv} {
4449         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4450     }
4451     unmarkmatches
4452     selectline $l 1
4453 }
4454
4455 proc commit_descriptor {p} {
4456     global commitinfo
4457     if {![info exists commitinfo($p)]} {
4458         getcommit $p
4459     }
4460     set l "..."
4461     if {[llength $commitinfo($p)] > 1} {
4462         set l [lindex $commitinfo($p) 0]
4463     }
4464     return "$p ($l)\n"
4465 }
4466
4467 # append some text to the ctext widget, and make any SHA1 ID
4468 # that we know about be a clickable link.
4469 proc appendwithlinks {text tags} {
4470     global ctext commitrow linknum curview pendinglinks
4471
4472     set start [$ctext index "end - 1c"]
4473     $ctext insert end $text $tags
4474     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4475     foreach l $links {
4476         set s [lindex $l 0]
4477         set e [lindex $l 1]
4478         set linkid [string range $text $s $e]
4479         incr e
4480         $ctext tag delete link$linknum
4481         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4482         setlink $linkid link$linknum
4483         incr linknum
4484     }
4485 }
4486
4487 proc setlink {id lk} {
4488     global curview commitrow ctext pendinglinks commitinterest
4489
4490     if {[info exists commitrow($curview,$id)]} {
4491         $ctext tag conf $lk -foreground blue -underline 1
4492         $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4493         $ctext tag bind $lk <Enter> {linkcursor %W 1}
4494         $ctext tag bind $lk <Leave> {linkcursor %W -1}
4495     } else {
4496         lappend pendinglinks($id) $lk
4497         lappend commitinterest($id) {makelink %I}
4498     }
4499 }
4500
4501 proc makelink {id} {
4502     global pendinglinks
4503
4504     if {![info exists pendinglinks($id)]} return
4505     foreach lk $pendinglinks($id) {
4506         setlink $id $lk
4507     }
4508     unset pendinglinks($id)
4509 }
4510
4511 proc linkcursor {w inc} {
4512     global linkentercount curtextcursor
4513
4514     if {[incr linkentercount $inc] > 0} {
4515         $w configure -cursor hand2
4516     } else {
4517         $w configure -cursor $curtextcursor
4518         if {$linkentercount < 0} {
4519             set linkentercount 0
4520         }
4521     }
4522 }
4523
4524 proc viewnextline {dir} {
4525     global canv linespc
4526
4527     $canv delete hover
4528     set ymax [lindex [$canv cget -scrollregion] 3]
4529     set wnow [$canv yview]
4530     set wtop [expr {[lindex $wnow 0] * $ymax}]
4531     set newtop [expr {$wtop + $dir * $linespc}]
4532     if {$newtop < 0} {
4533         set newtop 0
4534     } elseif {$newtop > $ymax} {
4535         set newtop $ymax
4536     }
4537     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4538 }
4539
4540 # add a list of tag or branch names at position pos
4541 # returns the number of names inserted
4542 proc appendrefs {pos ids var} {
4543     global ctext commitrow linknum curview $var maxrefs
4544
4545     if {[catch {$ctext index $pos}]} {
4546         return 0
4547     }
4548     $ctext conf -state normal
4549     $ctext delete $pos "$pos lineend"
4550     set tags {}
4551     foreach id $ids {
4552         foreach tag [set $var\($id\)] {
4553             lappend tags [list $tag $id]
4554         }
4555     }
4556     if {[llength $tags] > $maxrefs} {
4557         $ctext insert $pos "many ([llength $tags])"
4558     } else {
4559         set tags [lsort -index 0 -decreasing $tags]
4560         set sep {}
4561         foreach ti $tags {
4562             set id [lindex $ti 1]
4563             set lk link$linknum
4564             incr linknum
4565             $ctext tag delete $lk
4566             $ctext insert $pos $sep
4567             $ctext insert $pos [lindex $ti 0] $lk
4568             setlink $id $lk
4569             set sep ", "
4570         }
4571     }
4572     $ctext conf -state disabled
4573     return [llength $tags]
4574 }
4575
4576 # called when we have finished computing the nearby tags
4577 proc dispneartags {delay} {
4578     global selectedline currentid showneartags tagphase
4579
4580     if {![info exists selectedline] || !$showneartags} return
4581     after cancel dispnexttag
4582     if {$delay} {
4583         after 200 dispnexttag
4584         set tagphase -1
4585     } else {
4586         after idle dispnexttag
4587         set tagphase 0
4588     }
4589 }
4590
4591 proc dispnexttag {} {
4592     global selectedline currentid showneartags tagphase ctext
4593
4594     if {![info exists selectedline] || !$showneartags} return
4595     switch -- $tagphase {
4596         0 {
4597             set dtags [desctags $currentid]
4598             if {$dtags ne {}} {
4599                 appendrefs precedes $dtags idtags
4600             }
4601         }
4602         1 {
4603             set atags [anctags $currentid]
4604             if {$atags ne {}} {
4605                 appendrefs follows $atags idtags
4606             }
4607         }
4608         2 {
4609             set dheads [descheads $currentid]
4610             if {$dheads ne {}} {
4611                 if {[appendrefs branch $dheads idheads] > 1
4612                     && [$ctext get "branch -3c"] eq "h"} {
4613                     # turn "Branch" into "Branches"
4614                     $ctext conf -state normal
4615                     $ctext insert "branch -2c" "es"
4616                     $ctext conf -state disabled
4617                 }
4618             }
4619         }
4620     }
4621     if {[incr tagphase] <= 2} {
4622         after idle dispnexttag
4623     }
4624 }
4625
4626 proc make_secsel {l} {
4627     global linehtag linentag linedtag canv canv2 canv3
4628
4629     if {![info exists linehtag($l)]} return
4630     $canv delete secsel
4631     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4632                -tags secsel -fill [$canv cget -selectbackground]]
4633     $canv lower $t
4634     $canv2 delete secsel
4635     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4636                -tags secsel -fill [$canv2 cget -selectbackground]]
4637     $canv2 lower $t
4638     $canv3 delete secsel
4639     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4640                -tags secsel -fill [$canv3 cget -selectbackground]]
4641     $canv3 lower $t
4642 }
4643
4644 proc selectline {l isnew} {
4645     global canv ctext commitinfo selectedline
4646     global displayorder
4647     global canvy0 linespc parentlist children curview
4648     global currentid sha1entry
4649     global commentend idtags linknum
4650     global mergemax numcommits pending_select
4651     global cmitmode showneartags allcommits
4652
4653     catch {unset pending_select}
4654     $canv delete hover
4655     normalline
4656     unsel_reflist
4657     stopfinding
4658     if {$l < 0 || $l >= $numcommits} return
4659     set y [expr {$canvy0 + $l * $linespc}]
4660     set ymax [lindex [$canv cget -scrollregion] 3]
4661     set ytop [expr {$y - $linespc - 1}]
4662     set ybot [expr {$y + $linespc + 1}]
4663     set wnow [$canv yview]
4664     set wtop [expr {[lindex $wnow 0] * $ymax}]
4665     set wbot [expr {[lindex $wnow 1] * $ymax}]
4666     set wh [expr {$wbot - $wtop}]
4667     set newtop $wtop
4668     if {$ytop < $wtop} {
4669         if {$ybot < $wtop} {
4670             set newtop [expr {$y - $wh / 2.0}]
4671         } else {
4672             set newtop $ytop
4673             if {$newtop > $wtop - $linespc} {
4674                 set newtop [expr {$wtop - $linespc}]
4675             }
4676         }
4677     } elseif {$ybot > $wbot} {
4678         if {$ytop > $wbot} {
4679             set newtop [expr {$y - $wh / 2.0}]
4680         } else {
4681             set newtop [expr {$ybot - $wh}]
4682             if {$newtop < $wtop + $linespc} {
4683                 set newtop [expr {$wtop + $linespc}]
4684             }
4685         }
4686     }
4687     if {$newtop != $wtop} {
4688         if {$newtop < 0} {
4689             set newtop 0
4690         }
4691         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4692         drawvisible
4693     }
4694
4695     make_secsel $l
4696
4697     if {$isnew} {
4698         addtohistory [list selectline $l 0]
4699     }
4700
4701     set selectedline $l
4702
4703     set id [lindex $displayorder $l]
4704     set currentid $id
4705     $sha1entry delete 0 end
4706     $sha1entry insert 0 $id
4707     $sha1entry selection from 0
4708     $sha1entry selection to end
4709     rhighlight_sel $id
4710
4711     $ctext conf -state normal
4712     clear_ctext
4713     set linknum 0
4714     set info $commitinfo($id)
4715     set date [formatdate [lindex $info 2]]
4716     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
4717     set date [formatdate [lindex $info 4]]
4718     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
4719     if {[info exists idtags($id)]} {
4720         $ctext insert end [mc "Tags:"]
4721         foreach tag $idtags($id) {
4722             $ctext insert end " $tag"
4723         }
4724         $ctext insert end "\n"
4725     }
4726
4727     set headers {}
4728     set olds [lindex $parentlist $l]
4729     if {[llength $olds] > 1} {
4730         set np 0
4731         foreach p $olds {
4732             if {$np >= $mergemax} {
4733                 set tag mmax
4734             } else {
4735                 set tag m$np
4736             }
4737             $ctext insert end "[mc "Parent"]: " $tag
4738             appendwithlinks [commit_descriptor $p] {}
4739             incr np
4740         }
4741     } else {
4742         foreach p $olds {
4743             append headers "[mc "Parent"]: [commit_descriptor $p]"
4744         }
4745     }
4746
4747     foreach c $children($curview,$id) {
4748         append headers "[mc "Child"]:  [commit_descriptor $c]"
4749     }
4750
4751     # make anything that looks like a SHA1 ID be a clickable link
4752     appendwithlinks $headers {}
4753     if {$showneartags} {
4754         if {![info exists allcommits]} {
4755             getallcommits
4756         }
4757         $ctext insert end "[mc "Branch"]: "
4758         $ctext mark set branch "end -1c"
4759         $ctext mark gravity branch left
4760         $ctext insert end "\n[mc "Follows"]: "
4761         $ctext mark set follows "end -1c"
4762         $ctext mark gravity follows left
4763         $ctext insert end "\n[mc "Precedes"]: "
4764         $ctext mark set precedes "end -1c"
4765         $ctext mark gravity precedes left
4766         $ctext insert end "\n"
4767         dispneartags 1
4768     }
4769     $ctext insert end "\n"
4770     set comment [lindex $info 5]
4771     if {[string first "\r" $comment] >= 0} {
4772         set comment [string map {"\r" "\n    "} $comment]
4773     }
4774     appendwithlinks $comment {comment}
4775
4776     $ctext tag remove found 1.0 end
4777     $ctext conf -state disabled
4778     set commentend [$ctext index "end - 1c"]
4779
4780     init_flist [mc "Comments"]
4781     if {$cmitmode eq "tree"} {
4782         gettree $id
4783     } elseif {[llength $olds] <= 1} {
4784         startdiff $id
4785     } else {
4786         mergediff $id $l
4787     }
4788 }
4789
4790 proc selfirstline {} {
4791     unmarkmatches
4792     selectline 0 1
4793 }
4794
4795 proc sellastline {} {
4796     global numcommits
4797     unmarkmatches
4798     set l [expr {$numcommits - 1}]
4799     selectline $l 1
4800 }
4801
4802 proc selnextline {dir} {
4803     global selectedline
4804     focus .
4805     if {![info exists selectedline]} return
4806     set l [expr {$selectedline + $dir}]
4807     unmarkmatches
4808     selectline $l 1
4809 }
4810
4811 proc selnextpage {dir} {
4812     global canv linespc selectedline numcommits
4813
4814     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4815     if {$lpp < 1} {
4816         set lpp 1
4817     }
4818     allcanvs yview scroll [expr {$dir * $lpp}] units
4819     drawvisible
4820     if {![info exists selectedline]} return
4821     set l [expr {$selectedline + $dir * $lpp}]
4822     if {$l < 0} {
4823         set l 0
4824     } elseif {$l >= $numcommits} {
4825         set l [expr $numcommits - 1]
4826     }
4827     unmarkmatches
4828     selectline $l 1
4829 }
4830
4831 proc unselectline {} {
4832     global selectedline currentid
4833
4834     catch {unset selectedline}
4835     catch {unset currentid}
4836     allcanvs delete secsel
4837     rhighlight_none
4838 }
4839
4840 proc reselectline {} {
4841     global selectedline
4842
4843     if {[info exists selectedline]} {
4844         selectline $selectedline 0
4845     }
4846 }
4847
4848 proc addtohistory {cmd} {
4849     global history historyindex curview
4850
4851     set elt [list $curview $cmd]
4852     if {$historyindex > 0
4853         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4854         return
4855     }
4856
4857     if {$historyindex < [llength $history]} {
4858         set history [lreplace $history $historyindex end $elt]
4859     } else {
4860         lappend history $elt
4861     }
4862     incr historyindex
4863     if {$historyindex > 1} {
4864         .tf.bar.leftbut conf -state normal
4865     } else {
4866         .tf.bar.leftbut conf -state disabled
4867     }
4868     .tf.bar.rightbut conf -state disabled
4869 }
4870
4871 proc godo {elt} {
4872     global curview
4873
4874     set view [lindex $elt 0]
4875     set cmd [lindex $elt 1]
4876     if {$curview != $view} {
4877         showview $view
4878     }
4879     eval $cmd
4880 }
4881
4882 proc goback {} {
4883     global history historyindex
4884     focus .
4885
4886     if {$historyindex > 1} {
4887         incr historyindex -1
4888         godo [lindex $history [expr {$historyindex - 1}]]
4889         .tf.bar.rightbut conf -state normal
4890     }
4891     if {$historyindex <= 1} {
4892         .tf.bar.leftbut conf -state disabled
4893     }
4894 }
4895
4896 proc goforw {} {
4897     global history historyindex
4898     focus .
4899
4900     if {$historyindex < [llength $history]} {
4901         set cmd [lindex $history $historyindex]
4902         incr historyindex
4903         godo $cmd
4904         .tf.bar.leftbut conf -state normal
4905     }
4906     if {$historyindex >= [llength $history]} {
4907         .tf.bar.rightbut conf -state disabled
4908     }
4909 }
4910
4911 proc gettree {id} {
4912     global treefilelist treeidlist diffids diffmergeid treepending
4913     global nullid nullid2
4914
4915     set diffids $id
4916     catch {unset diffmergeid}
4917     if {![info exists treefilelist($id)]} {
4918         if {![info exists treepending]} {
4919             if {$id eq $nullid} {
4920                 set cmd [list | git ls-files]
4921             } elseif {$id eq $nullid2} {
4922                 set cmd [list | git ls-files --stage -t]
4923             } else {
4924                 set cmd [list | git ls-tree -r $id]
4925             }
4926             if {[catch {set gtf [open $cmd r]}]} {
4927                 return
4928             }
4929             set treepending $id
4930             set treefilelist($id) {}
4931             set treeidlist($id) {}
4932             fconfigure $gtf -blocking 0
4933             filerun $gtf [list gettreeline $gtf $id]
4934         }
4935     } else {
4936         setfilelist $id
4937     }
4938 }
4939
4940 proc gettreeline {gtf id} {
4941     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4942
4943     set nl 0
4944     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4945         if {$diffids eq $nullid} {
4946             set fname $line
4947         } else {
4948             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4949             set i [string first "\t" $line]
4950             if {$i < 0} continue
4951             set sha1 [lindex $line 2]
4952             set fname [string range $line [expr {$i+1}] end]
4953             if {[string index $fname 0] eq "\""} {
4954                 set fname [lindex $fname 0]
4955             }
4956             lappend treeidlist($id) $sha1
4957         }
4958         lappend treefilelist($id) $fname
4959     }
4960     if {![eof $gtf]} {
4961         return [expr {$nl >= 1000? 2: 1}]
4962     }
4963     close $gtf
4964     unset treepending
4965     if {$cmitmode ne "tree"} {
4966         if {![info exists diffmergeid]} {
4967             gettreediffs $diffids
4968         }
4969     } elseif {$id ne $diffids} {
4970         gettree $diffids
4971     } else {
4972         setfilelist $id
4973     }
4974     return 0
4975 }
4976
4977 proc showfile {f} {
4978     global treefilelist treeidlist diffids nullid nullid2
4979     global ctext commentend
4980
4981     set i [lsearch -exact $treefilelist($diffids) $f]
4982     if {$i < 0} {
4983         puts "oops, $f not in list for id $diffids"
4984         return
4985     }
4986     if {$diffids eq $nullid} {
4987         if {[catch {set bf [open $f r]} err]} {
4988             puts "oops, can't read $f: $err"
4989             return
4990         }
4991     } else {
4992         set blob [lindex $treeidlist($diffids) $i]
4993         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4994             puts "oops, error reading blob $blob: $err"
4995             return
4996         }
4997     }
4998     fconfigure $bf -blocking 0
4999     filerun $bf [list getblobline $bf $diffids]
5000     $ctext config -state normal
5001     clear_ctext $commentend
5002     $ctext insert end "\n"
5003     $ctext insert end "$f\n" filesep
5004     $ctext config -state disabled
5005     $ctext yview $commentend
5006     settabs 0
5007 }
5008
5009 proc getblobline {bf id} {
5010     global diffids cmitmode ctext
5011
5012     if {$id ne $diffids || $cmitmode ne "tree"} {
5013         catch {close $bf}
5014         return 0
5015     }
5016     $ctext config -state normal
5017     set nl 0
5018     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5019         $ctext insert end "$line\n"
5020     }
5021     if {[eof $bf]} {
5022         # delete last newline
5023         $ctext delete "end - 2c" "end - 1c"
5024         close $bf
5025         return 0
5026     }
5027     $ctext config -state disabled
5028     return [expr {$nl >= 1000? 2: 1}]
5029 }
5030
5031 proc mergediff {id l} {
5032     global diffmergeid mdifffd
5033     global diffids
5034     global parentlist
5035     global limitdiffs viewfiles curview
5036
5037     set diffmergeid $id
5038     set diffids $id
5039     # this doesn't seem to actually affect anything...
5040     set cmd [concat | git diff-tree --no-commit-id --cc $id]
5041     if {$limitdiffs && $viewfiles($curview) ne {}} {
5042         set cmd [concat $cmd -- $viewfiles($curview)]
5043     }
5044     if {[catch {set mdf [open $cmd r]} err]} {
5045         error_popup "[mc "Error getting merge diffs:"] $err"
5046         return
5047     }
5048     fconfigure $mdf -blocking 0
5049     set mdifffd($id) $mdf
5050     set np [llength [lindex $parentlist $l]]
5051     settabs $np
5052     filerun $mdf [list getmergediffline $mdf $id $np]
5053 }
5054
5055 proc getmergediffline {mdf id np} {
5056     global diffmergeid ctext cflist mergemax
5057     global difffilestart mdifffd
5058
5059     $ctext conf -state normal
5060     set nr 0
5061     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5062         if {![info exists diffmergeid] || $id != $diffmergeid
5063             || $mdf != $mdifffd($id)} {
5064             close $mdf
5065             return 0
5066         }
5067         if {[regexp {^diff --cc (.*)} $line match fname]} {
5068             # start of a new file
5069             $ctext insert end "\n"
5070             set here [$ctext index "end - 1c"]
5071             lappend difffilestart $here
5072             add_flist [list $fname]
5073             set l [expr {(78 - [string length $fname]) / 2}]
5074             set pad [string range "----------------------------------------" 1 $l]
5075             $ctext insert end "$pad $fname $pad\n" filesep
5076         } elseif {[regexp {^@@} $line]} {
5077             $ctext insert end "$line\n" hunksep
5078         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5079             # do nothing
5080         } else {
5081             # parse the prefix - one ' ', '-' or '+' for each parent
5082             set spaces {}
5083             set minuses {}
5084             set pluses {}
5085             set isbad 0
5086             for {set j 0} {$j < $np} {incr j} {
5087                 set c [string range $line $j $j]
5088                 if {$c == " "} {
5089                     lappend spaces $j
5090                 } elseif {$c == "-"} {
5091                     lappend minuses $j
5092                 } elseif {$c == "+"} {
5093                     lappend pluses $j
5094                 } else {
5095                     set isbad 1
5096                     break
5097                 }
5098             }
5099             set tags {}
5100             set num {}
5101             if {!$isbad && $minuses ne {} && $pluses eq {}} {
5102                 # line doesn't appear in result, parents in $minuses have the line
5103                 set num [lindex $minuses 0]
5104             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5105                 # line appears in result, parents in $pluses don't have the line
5106                 lappend tags mresult
5107                 set num [lindex $spaces 0]
5108             }
5109             if {$num ne {}} {
5110                 if {$num >= $mergemax} {
5111                     set num "max"
5112                 }
5113                 lappend tags m$num
5114             }
5115             $ctext insert end "$line\n" $tags
5116         }
5117     }
5118     $ctext conf -state disabled
5119     if {[eof $mdf]} {
5120         close $mdf
5121         return 0
5122     }
5123     return [expr {$nr >= 1000? 2: 1}]
5124 }
5125
5126 proc startdiff {ids} {
5127     global treediffs diffids treepending diffmergeid nullid nullid2
5128
5129     settabs 1
5130     set diffids $ids
5131     catch {unset diffmergeid}
5132     if {![info exists treediffs($ids)] ||
5133         [lsearch -exact $ids $nullid] >= 0 ||
5134         [lsearch -exact $ids $nullid2] >= 0} {
5135         if {![info exists treepending]} {
5136             gettreediffs $ids
5137         }
5138     } else {
5139         addtocflist $ids
5140     }
5141 }
5142
5143 proc path_filter {filter name} {
5144     foreach p $filter {
5145         set l [string length $p]
5146         if {[string index $p end] eq "/"} {
5147             if {[string compare -length $l $p $name] == 0} {
5148                 return 1
5149             }
5150         } else {
5151             if {[string compare -length $l $p $name] == 0 &&
5152                 ([string length $name] == $l ||
5153                  [string index $name $l] eq "/")} {
5154                 return 1
5155             }
5156         }
5157     }
5158     return 0
5159 }
5160
5161 proc addtocflist {ids} {
5162     global treediffs
5163
5164     add_flist $treediffs($ids)
5165     getblobdiffs $ids
5166 }
5167
5168 proc diffcmd {ids flags} {
5169     global nullid nullid2
5170
5171     set i [lsearch -exact $ids $nullid]
5172     set j [lsearch -exact $ids $nullid2]
5173     if {$i >= 0} {
5174         if {[llength $ids] > 1 && $j < 0} {
5175             # comparing working directory with some specific revision
5176             set cmd [concat | git diff-index $flags]
5177             if {$i == 0} {
5178                 lappend cmd -R [lindex $ids 1]
5179             } else {
5180                 lappend cmd [lindex $ids 0]
5181             }
5182         } else {
5183             # comparing working directory with index
5184             set cmd [concat | git diff-files $flags]
5185             if {$j == 1} {
5186                 lappend cmd -R
5187             }
5188         }
5189     } elseif {$j >= 0} {
5190         set cmd [concat | git diff-index --cached $flags]
5191         if {[llength $ids] > 1} {
5192             # comparing index with specific revision
5193             if {$i == 0} {
5194                 lappend cmd -R [lindex $ids 1]
5195             } else {
5196                 lappend cmd [lindex $ids 0]
5197             }
5198         } else {
5199             # comparing index with HEAD
5200             lappend cmd HEAD
5201         }
5202     } else {
5203         set cmd [concat | git diff-tree -r $flags $ids]
5204     }
5205     return $cmd
5206 }
5207
5208 proc gettreediffs {ids} {
5209     global treediff treepending
5210
5211     set treepending $ids
5212     set treediff {}
5213     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5214     fconfigure $gdtf -blocking 0
5215     filerun $gdtf [list gettreediffline $gdtf $ids]
5216 }
5217
5218 proc gettreediffline {gdtf ids} {
5219     global treediff treediffs treepending diffids diffmergeid
5220     global cmitmode viewfiles curview limitdiffs
5221
5222     set nr 0
5223     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5224         set i [string first "\t" $line]
5225         if {$i >= 0} {
5226             set file [string range $line [expr {$i+1}] end]
5227             if {[string index $file 0] eq "\""} {
5228                 set file [lindex $file 0]
5229             }
5230             lappend treediff $file
5231         }
5232     }
5233     if {![eof $gdtf]} {
5234         return [expr {$nr >= 1000? 2: 1}]
5235     }
5236     close $gdtf
5237     if {$limitdiffs && $viewfiles($curview) ne {}} {
5238         set flist {}
5239         foreach f $treediff {
5240             if {[path_filter $viewfiles($curview) $f]} {
5241                 lappend flist $f
5242             }
5243         }
5244         set treediffs($ids) $flist
5245     } else {
5246         set treediffs($ids) $treediff
5247     }
5248     unset treepending
5249     if {$cmitmode eq "tree"} {
5250         gettree $diffids
5251     } elseif {$ids != $diffids} {
5252         if {![info exists diffmergeid]} {
5253             gettreediffs $diffids
5254         }
5255     } else {
5256         addtocflist $ids
5257     }
5258     return 0
5259 }
5260
5261 # empty string or positive integer
5262 proc diffcontextvalidate {v} {
5263     return [regexp {^(|[1-9][0-9]*)$} $v]
5264 }
5265
5266 proc diffcontextchange {n1 n2 op} {
5267     global diffcontextstring diffcontext
5268
5269     if {[string is integer -strict $diffcontextstring]} {
5270         if {$diffcontextstring > 0} {
5271             set diffcontext $diffcontextstring
5272             reselectline
5273         }
5274     }
5275 }
5276
5277 proc changeignorespace {} {
5278     reselectline
5279 }
5280
5281 proc getblobdiffs {ids} {
5282     global blobdifffd diffids env
5283     global diffinhdr treediffs
5284     global diffcontext
5285     global ignorespace
5286     global limitdiffs viewfiles curview
5287
5288     set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5289     if {$ignorespace} {
5290         append cmd " -w"
5291     }
5292     if {$limitdiffs && $viewfiles($curview) ne {}} {
5293         set cmd [concat $cmd -- $viewfiles($curview)]
5294     }
5295     if {[catch {set bdf [open $cmd r]} err]} {
5296         puts "error getting diffs: $err"
5297         return
5298     }
5299     set diffinhdr 0
5300     fconfigure $bdf -blocking 0
5301     set blobdifffd($ids) $bdf
5302     filerun $bdf [list getblobdiffline $bdf $diffids]
5303 }
5304
5305 proc setinlist {var i val} {
5306     global $var
5307
5308     while {[llength [set $var]] < $i} {
5309         lappend $var {}
5310     }
5311     if {[llength [set $var]] == $i} {
5312         lappend $var $val
5313     } else {
5314         lset $var $i $val
5315     }
5316 }
5317
5318 proc makediffhdr {fname ids} {
5319     global ctext curdiffstart treediffs
5320
5321     set i [lsearch -exact $treediffs($ids) $fname]
5322     if {$i >= 0} {
5323         setinlist difffilestart $i $curdiffstart
5324     }
5325     set l [expr {(78 - [string length $fname]) / 2}]
5326     set pad [string range "----------------------------------------" 1 $l]
5327     $ctext insert $curdiffstart "$pad $fname $pad" filesep
5328 }
5329
5330 proc getblobdiffline {bdf ids} {
5331     global diffids blobdifffd ctext curdiffstart
5332     global diffnexthead diffnextnote difffilestart
5333     global diffinhdr treediffs
5334
5335     set nr 0
5336     $ctext conf -state normal
5337     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5338         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5339             close $bdf
5340             return 0
5341         }
5342         if {![string compare -length 11 "diff --git " $line]} {
5343             # trim off "diff --git "
5344             set line [string range $line 11 end]
5345             set diffinhdr 1
5346             # start of a new file
5347             $ctext insert end "\n"
5348             set curdiffstart [$ctext index "end - 1c"]
5349             $ctext insert end "\n" filesep
5350             # If the name hasn't changed the length will be odd,
5351             # the middle char will be a space, and the two bits either
5352             # side will be a/name and b/name, or "a/name" and "b/name".
5353             # If the name has changed we'll get "rename from" and
5354             # "rename to" or "copy from" and "copy to" lines following this,
5355             # and we'll use them to get the filenames.
5356             # This complexity is necessary because spaces in the filename(s)
5357             # don't get escaped.
5358             set l [string length $line]
5359             set i [expr {$l / 2}]
5360             if {!(($l & 1) && [string index $line $i] eq " " &&
5361                   [string range $line 2 [expr {$i - 1}]] eq \
5362                       [string range $line [expr {$i + 3}] end])} {
5363                 continue
5364             }
5365             # unescape if quoted and chop off the a/ from the front
5366             if {[string index $line 0] eq "\""} {
5367                 set fname [string range [lindex $line 0] 2 end]
5368             } else {
5369                 set fname [string range $line 2 [expr {$i - 1}]]
5370             }
5371             makediffhdr $fname $ids
5372
5373         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5374                        $line match f1l f1c f2l f2c rest]} {
5375             $ctext insert end "$line\n" hunksep
5376             set diffinhdr 0
5377
5378         } elseif {$diffinhdr} {
5379             if {![string compare -length 12 "rename from " $line]} {
5380                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5381                 if {[string index $fname 0] eq "\""} {
5382                     set fname [lindex $fname 0]
5383                 }
5384                 set i [lsearch -exact $treediffs($ids) $fname]
5385                 if {$i >= 0} {
5386                     setinlist difffilestart $i $curdiffstart
5387                 }
5388             } elseif {![string compare -length 10 $line "rename to "] ||
5389                       ![string compare -length 8 $line "copy to "]} {
5390                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5391                 if {[string index $fname 0] eq "\""} {
5392                     set fname [lindex $fname 0]
5393                 }
5394                 makediffhdr $fname $ids
5395             } elseif {[string compare -length 3 $line "---"] == 0} {
5396                 # do nothing
5397                 continue
5398             } elseif {[string compare -length 3 $line "+++"] == 0} {
5399                 set diffinhdr 0
5400                 continue
5401             }
5402             $ctext insert end "$line\n" filesep
5403
5404         } else {
5405             set x [string range $line 0 0]
5406             if {$x == "-" || $x == "+"} {
5407                 set tag [expr {$x == "+"}]
5408                 $ctext insert end "$line\n" d$tag
5409             } elseif {$x == " "} {
5410                 $ctext insert end "$line\n"
5411             } else {
5412                 # "\ No newline at end of file",
5413                 # or something else we don't recognize
5414                 $ctext insert end "$line\n" hunksep
5415             }
5416         }
5417     }
5418     $ctext conf -state disabled
5419     if {[eof $bdf]} {
5420         close $bdf
5421         return 0
5422     }
5423     return [expr {$nr >= 1000? 2: 1}]
5424 }
5425
5426 proc changediffdisp {} {
5427     global ctext diffelide
5428
5429     $ctext tag conf d0 -elide [lindex $diffelide 0]
5430     $ctext tag conf d1 -elide [lindex $diffelide 1]
5431 }
5432
5433 proc prevfile {} {
5434     global difffilestart ctext
5435     set prev [lindex $difffilestart 0]
5436     set here [$ctext index @0,0]
5437     foreach loc $difffilestart {
5438         if {[$ctext compare $loc >= $here]} {
5439             $ctext yview $prev
5440             return
5441         }
5442         set prev $loc
5443     }
5444     $ctext yview $prev
5445 }
5446
5447 proc nextfile {} {
5448     global difffilestart ctext
5449     set here [$ctext index @0,0]
5450     foreach loc $difffilestart {
5451         if {[$ctext compare $loc > $here]} {
5452             $ctext yview $loc
5453             return
5454         }
5455     }
5456 }
5457
5458 proc clear_ctext {{first 1.0}} {
5459     global ctext smarktop smarkbot
5460     global pendinglinks
5461
5462     set l [lindex [split $first .] 0]
5463     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5464         set smarktop $l
5465     }
5466     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5467         set smarkbot $l
5468     }
5469     $ctext delete $first end
5470     if {$first eq "1.0"} {
5471         catch {unset pendinglinks}
5472     }
5473 }
5474
5475 proc settabs {{firstab {}}} {
5476     global firsttabstop tabstop ctext have_tk85
5477
5478     if {$firstab ne {} && $have_tk85} {
5479         set firsttabstop $firstab
5480     }
5481     set w [font measure textfont "0"]
5482     if {$firsttabstop != 0} {
5483         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5484                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5485     } elseif {$have_tk85 || $tabstop != 8} {
5486         $ctext conf -tabs [expr {$tabstop * $w}]
5487     } else {
5488         $ctext conf -tabs {}
5489     }
5490 }
5491
5492 proc incrsearch {name ix op} {
5493     global ctext searchstring searchdirn
5494
5495     $ctext tag remove found 1.0 end
5496     if {[catch {$ctext index anchor}]} {
5497         # no anchor set, use start of selection, or of visible area
5498         set sel [$ctext tag ranges sel]
5499         if {$sel ne {}} {
5500             $ctext mark set anchor [lindex $sel 0]
5501         } elseif {$searchdirn eq "-forwards"} {
5502             $ctext mark set anchor @0,0
5503         } else {
5504             $ctext mark set anchor @0,[winfo height $ctext]
5505         }
5506     }
5507     if {$searchstring ne {}} {
5508         set here [$ctext search $searchdirn -- $searchstring anchor]
5509         if {$here ne {}} {
5510             $ctext see $here
5511         }
5512         searchmarkvisible 1
5513     }
5514 }
5515
5516 proc dosearch {} {
5517     global sstring ctext searchstring searchdirn
5518
5519     focus $sstring
5520     $sstring icursor end
5521     set searchdirn -forwards
5522     if {$searchstring ne {}} {
5523         set sel [$ctext tag ranges sel]
5524         if {$sel ne {}} {
5525             set start "[lindex $sel 0] + 1c"
5526         } elseif {[catch {set start [$ctext index anchor]}]} {
5527             set start "@0,0"
5528         }
5529         set match [$ctext search -count mlen -- $searchstring $start]
5530         $ctext tag remove sel 1.0 end
5531         if {$match eq {}} {
5532             bell
5533             return
5534         }
5535         $ctext see $match
5536         set mend "$match + $mlen c"
5537         $ctext tag add sel $match $mend
5538         $ctext mark unset anchor
5539     }
5540 }
5541
5542 proc dosearchback {} {
5543     global sstring ctext searchstring searchdirn
5544
5545     focus $sstring
5546     $sstring icursor end
5547     set searchdirn -backwards
5548     if {$searchstring ne {}} {
5549         set sel [$ctext tag ranges sel]
5550         if {$sel ne {}} {
5551             set start [lindex $sel 0]
5552         } elseif {[catch {set start [$ctext index anchor]}]} {
5553             set start @0,[winfo height $ctext]
5554         }
5555         set match [$ctext search -backwards -count ml -- $searchstring $start]
5556         $ctext tag remove sel 1.0 end
5557         if {$match eq {}} {
5558             bell
5559             return
5560         }
5561         $ctext see $match
5562         set mend "$match + $ml c"
5563         $ctext tag add sel $match $mend
5564         $ctext mark unset anchor
5565     }
5566 }
5567
5568 proc searchmark {first last} {
5569     global ctext searchstring
5570
5571     set mend $first.0
5572     while {1} {
5573         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5574         if {$match eq {}} break
5575         set mend "$match + $mlen c"
5576         $ctext tag add found $match $mend
5577     }
5578 }
5579
5580 proc searchmarkvisible {doall} {
5581     global ctext smarktop smarkbot
5582
5583     set topline [lindex [split [$ctext index @0,0] .] 0]
5584     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5585     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5586         # no overlap with previous
5587         searchmark $topline $botline
5588         set smarktop $topline
5589         set smarkbot $botline
5590     } else {
5591         if {$topline < $smarktop} {
5592             searchmark $topline [expr {$smarktop-1}]
5593             set smarktop $topline
5594         }
5595         if {$botline > $smarkbot} {
5596             searchmark [expr {$smarkbot+1}] $botline
5597             set smarkbot $botline
5598         }
5599     }
5600 }
5601
5602 proc scrolltext {f0 f1} {
5603     global searchstring
5604
5605     .bleft.sb set $f0 $f1
5606     if {$searchstring ne {}} {
5607         searchmarkvisible 0
5608     }
5609 }
5610
5611 proc setcoords {} {
5612     global linespc charspc canvx0 canvy0
5613     global xspc1 xspc2 lthickness
5614
5615     set linespc [font metrics mainfont -linespace]
5616     set charspc [font measure mainfont "m"]
5617     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5618     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5619     set lthickness [expr {int($linespc / 9) + 1}]
5620     set xspc1(0) $linespc
5621     set xspc2 $linespc
5622 }
5623
5624 proc redisplay {} {
5625     global canv
5626     global selectedline
5627
5628     set ymax [lindex [$canv cget -scrollregion] 3]
5629     if {$ymax eq {} || $ymax == 0} return
5630     set span [$canv yview]
5631     clear_display
5632     setcanvscroll
5633     allcanvs yview moveto [lindex $span 0]
5634     drawvisible
5635     if {[info exists selectedline]} {
5636         selectline $selectedline 0
5637         allcanvs yview moveto [lindex $span 0]
5638     }
5639 }
5640
5641 proc parsefont {f n} {
5642     global fontattr
5643
5644     set fontattr($f,family) [lindex $n 0]
5645     set s [lindex $n 1]
5646     if {$s eq {} || $s == 0} {
5647         set s 10
5648     } elseif {$s < 0} {
5649         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5650     }
5651     set fontattr($f,size) $s
5652     set fontattr($f,weight) normal
5653     set fontattr($f,slant) roman
5654     foreach style [lrange $n 2 end] {
5655         switch -- $style {
5656             "normal" -
5657             "bold"   {set fontattr($f,weight) $style}
5658             "roman" -
5659             "italic" {set fontattr($f,slant) $style}
5660         }
5661     }
5662 }
5663
5664 proc fontflags {f {isbold 0}} {
5665     global fontattr
5666
5667     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5668                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5669                 -slant $fontattr($f,slant)]
5670 }
5671
5672 proc fontname {f} {
5673     global fontattr
5674
5675     set n [list $fontattr($f,family) $fontattr($f,size)]
5676     if {$fontattr($f,weight) eq "bold"} {
5677         lappend n "bold"
5678     }
5679     if {$fontattr($f,slant) eq "italic"} {
5680         lappend n "italic"
5681     }
5682     return $n
5683 }
5684
5685 proc incrfont {inc} {
5686     global mainfont textfont ctext canv phase cflist showrefstop
5687     global stopped entries fontattr
5688
5689     unmarkmatches
5690     set s $fontattr(mainfont,size)
5691     incr s $inc
5692     if {$s < 1} {
5693         set s 1
5694     }
5695     set fontattr(mainfont,size) $s
5696     font config mainfont -size $s
5697     font config mainfontbold -size $s
5698     set mainfont [fontname mainfont]
5699     set s $fontattr(textfont,size)
5700     incr s $inc
5701     if {$s < 1} {
5702         set s 1
5703     }
5704     set fontattr(textfont,size) $s
5705     font config textfont -size $s
5706     font config textfontbold -size $s
5707     set textfont [fontname textfont]
5708     setcoords
5709     settabs
5710     redisplay
5711 }
5712
5713 proc clearsha1 {} {
5714     global sha1entry sha1string
5715     if {[string length $sha1string] == 40} {
5716         $sha1entry delete 0 end
5717     }
5718 }
5719
5720 proc sha1change {n1 n2 op} {
5721     global sha1string currentid sha1but
5722     if {$sha1string == {}
5723         || ([info exists currentid] && $sha1string == $currentid)} {
5724         set state disabled
5725     } else {
5726         set state normal
5727     }
5728     if {[$sha1but cget -state] == $state} return
5729     if {$state == "normal"} {
5730         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5731     } else {
5732         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5733     }
5734 }
5735
5736 proc gotocommit {} {
5737     global sha1string currentid commitrow tagids headids
5738     global displayorder numcommits curview
5739
5740     if {$sha1string == {}
5741         || ([info exists currentid] && $sha1string == $currentid)} return
5742     if {[info exists tagids($sha1string)]} {
5743         set id $tagids($sha1string)
5744     } elseif {[info exists headids($sha1string)]} {
5745         set id $headids($sha1string)
5746     } else {
5747         set id [string tolower $sha1string]
5748         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5749             set matches {}
5750             foreach i $displayorder {
5751                 if {[string match $id* $i]} {
5752                     lappend matches $i
5753                 }
5754             }
5755             if {$matches ne {}} {
5756                 if {[llength $matches] > 1} {
5757                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5758                     return
5759                 }
5760                 set id [lindex $matches 0]
5761             }
5762         }
5763     }
5764     if {[info exists commitrow($curview,$id)]} {
5765         selectline $commitrow($curview,$id) 1
5766         return
5767     }
5768     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5769         set msg [mc "SHA1 id %s is not known" $sha1string]
5770     } else {
5771         set msg [mc "Tag/Head %s is not known" $sha1string]
5772     }
5773     error_popup $msg
5774 }
5775
5776 proc lineenter {x y id} {
5777     global hoverx hovery hoverid hovertimer
5778     global commitinfo canv
5779
5780     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5781     set hoverx $x
5782     set hovery $y
5783     set hoverid $id
5784     if {[info exists hovertimer]} {
5785         after cancel $hovertimer
5786     }
5787     set hovertimer [after 500 linehover]
5788     $canv delete hover
5789 }
5790
5791 proc linemotion {x y id} {
5792     global hoverx hovery hoverid hovertimer
5793
5794     if {[info exists hoverid] && $id == $hoverid} {
5795         set hoverx $x
5796         set hovery $y
5797         if {[info exists hovertimer]} {
5798             after cancel $hovertimer
5799         }
5800         set hovertimer [after 500 linehover]
5801     }
5802 }
5803
5804 proc lineleave {id} {
5805     global hoverid hovertimer canv
5806
5807     if {[info exists hoverid] && $id == $hoverid} {
5808         $canv delete hover
5809         if {[info exists hovertimer]} {
5810             after cancel $hovertimer
5811             unset hovertimer
5812         }
5813         unset hoverid
5814     }
5815 }
5816
5817 proc linehover {} {
5818     global hoverx hovery hoverid hovertimer
5819     global canv linespc lthickness
5820     global commitinfo
5821
5822     set text [lindex $commitinfo($hoverid) 0]
5823     set ymax [lindex [$canv cget -scrollregion] 3]
5824     if {$ymax == {}} return
5825     set yfrac [lindex [$canv yview] 0]
5826     set x [expr {$hoverx + 2 * $linespc}]
5827     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5828     set x0 [expr {$x - 2 * $lthickness}]
5829     set y0 [expr {$y - 2 * $lthickness}]
5830     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5831     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5832     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5833                -fill \#ffff80 -outline black -width 1 -tags hover]
5834     $canv raise $t
5835     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5836                -font mainfont]
5837     $canv raise $t
5838 }
5839
5840 proc clickisonarrow {id y} {
5841     global lthickness
5842
5843     set ranges [rowranges $id]
5844     set thresh [expr {2 * $lthickness + 6}]
5845     set n [expr {[llength $ranges] - 1}]
5846     for {set i 1} {$i < $n} {incr i} {
5847         set row [lindex $ranges $i]
5848         if {abs([yc $row] - $y) < $thresh} {
5849             return $i
5850         }
5851     }
5852     return {}
5853 }
5854
5855 proc arrowjump {id n y} {
5856     global canv
5857
5858     # 1 <-> 2, 3 <-> 4, etc...
5859     set n [expr {(($n - 1) ^ 1) + 1}]
5860     set row [lindex [rowranges $id] $n]
5861     set yt [yc $row]
5862     set ymax [lindex [$canv cget -scrollregion] 3]
5863     if {$ymax eq {} || $ymax <= 0} return
5864     set view [$canv yview]
5865     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5866     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5867     if {$yfrac < 0} {
5868         set yfrac 0
5869     }
5870     allcanvs yview moveto $yfrac
5871 }
5872
5873 proc lineclick {x y id isnew} {
5874     global ctext commitinfo children canv thickerline curview commitrow
5875
5876     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5877     unmarkmatches
5878     unselectline
5879     normalline
5880     $canv delete hover
5881     # draw this line thicker than normal
5882     set thickerline $id
5883     drawlines $id
5884     if {$isnew} {
5885         set ymax [lindex [$canv cget -scrollregion] 3]
5886         if {$ymax eq {}} return
5887         set yfrac [lindex [$canv yview] 0]
5888         set y [expr {$y + $yfrac * $ymax}]
5889     }
5890     set dirn [clickisonarrow $id $y]
5891     if {$dirn ne {}} {
5892         arrowjump $id $dirn $y
5893         return
5894     }
5895
5896     if {$isnew} {
5897         addtohistory [list lineclick $x $y $id 0]
5898     }
5899     # fill the details pane with info about this line
5900     $ctext conf -state normal
5901     clear_ctext
5902     settabs 0
5903     $ctext insert end "[mc "Parent"]:\t"
5904     $ctext insert end $id link0
5905     setlink $id link0
5906     set info $commitinfo($id)
5907     $ctext insert end "\n\t[lindex $info 0]\n"
5908     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5909     set date [formatdate [lindex $info 2]]
5910     $ctext insert end "\t[mc "Date"]:\t$date\n"
5911     set kids $children($curview,$id)
5912     if {$kids ne {}} {
5913         $ctext insert end "\n[mc "Children"]:"
5914         set i 0
5915         foreach child $kids {
5916             incr i
5917             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5918             set info $commitinfo($child)
5919             $ctext insert end "\n\t"
5920             $ctext insert end $child link$i
5921             setlink $child link$i
5922             $ctext insert end "\n\t[lindex $info 0]"
5923             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5924             set date [formatdate [lindex $info 2]]
5925             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5926         }
5927     }
5928     $ctext conf -state disabled
5929     init_flist {}
5930 }
5931
5932 proc normalline {} {
5933     global thickerline
5934     if {[info exists thickerline]} {
5935         set id $thickerline
5936         unset thickerline
5937         drawlines $id
5938     }
5939 }
5940
5941 proc selbyid {id} {
5942     global commitrow curview
5943     if {[info exists commitrow($curview,$id)]} {
5944         selectline $commitrow($curview,$id) 1
5945     }
5946 }
5947
5948 proc mstime {} {
5949     global startmstime
5950     if {![info exists startmstime]} {
5951         set startmstime [clock clicks -milliseconds]
5952     }
5953     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5954 }
5955
5956 proc rowmenu {x y id} {
5957     global rowctxmenu commitrow selectedline rowmenuid curview
5958     global nullid nullid2 fakerowmenu mainhead
5959
5960     stopfinding
5961     set rowmenuid $id
5962     if {![info exists selectedline]
5963         || $commitrow($curview,$id) eq $selectedline} {
5964         set state disabled
5965     } else {
5966         set state normal
5967     }
5968     if {$id ne $nullid && $id ne $nullid2} {
5969         set menu $rowctxmenu
5970         $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
5971     } else {
5972         set menu $fakerowmenu
5973     }
5974     $menu entryconfigure [mc "Diff this -> selected"] -state $state
5975     $menu entryconfigure [mc "Diff selected -> this"] -state $state
5976     $menu entryconfigure [mc "Make patch"] -state $state
5977     tk_popup $menu $x $y
5978 }
5979
5980 proc diffvssel {dirn} {
5981     global rowmenuid selectedline displayorder
5982
5983     if {![info exists selectedline]} return
5984     if {$dirn} {
5985         set oldid [lindex $displayorder $selectedline]
5986         set newid $rowmenuid
5987     } else {
5988         set oldid $rowmenuid
5989         set newid [lindex $displayorder $selectedline]
5990     }
5991     addtohistory [list doseldiff $oldid $newid]
5992     doseldiff $oldid $newid
5993 }
5994
5995 proc doseldiff {oldid newid} {
5996     global ctext
5997     global commitinfo
5998
5999     $ctext conf -state normal
6000     clear_ctext
6001     init_flist [mc "Top"]
6002     $ctext insert end "[mc "From"] "
6003     $ctext insert end $oldid link0
6004     setlink $oldid link0
6005     $ctext insert end "\n     "
6006     $ctext insert end [lindex $commitinfo($oldid) 0]
6007     $ctext insert end "\n\n[mc "To"]   "
6008     $ctext insert end $newid link1
6009     setlink $newid link1
6010     $ctext insert end "\n     "
6011     $ctext insert end [lindex $commitinfo($newid) 0]
6012     $ctext insert end "\n"
6013     $ctext conf -state disabled
6014     $ctext tag remove found 1.0 end
6015     startdiff [list $oldid $newid]
6016 }
6017
6018 proc mkpatch {} {
6019     global rowmenuid currentid commitinfo patchtop patchnum
6020
6021     if {![info exists currentid]} return
6022     set oldid $currentid
6023     set oldhead [lindex $commitinfo($oldid) 0]
6024     set newid $rowmenuid
6025     set newhead [lindex $commitinfo($newid) 0]
6026     set top .patch
6027     set patchtop $top
6028     catch {destroy $top}
6029     toplevel $top
6030     label $top.title -text [mc "Generate patch"]
6031     grid $top.title - -pady 10
6032     label $top.from -text [mc "From:"]
6033     entry $top.fromsha1 -width 40 -relief flat
6034     $top.fromsha1 insert 0 $oldid
6035     $top.fromsha1 conf -state readonly
6036     grid $top.from $top.fromsha1 -sticky w
6037     entry $top.fromhead -width 60 -relief flat
6038     $top.fromhead insert 0 $oldhead
6039     $top.fromhead conf -state readonly
6040     grid x $top.fromhead -sticky w
6041     label $top.to -text [mc "To:"]
6042     entry $top.tosha1 -width 40 -relief flat
6043     $top.tosha1 insert 0 $newid
6044     $top.tosha1 conf -state readonly
6045     grid $top.to $top.tosha1 -sticky w
6046     entry $top.tohead -width 60 -relief flat
6047     $top.tohead insert 0 $newhead
6048     $top.tohead conf -state readonly
6049     grid x $top.tohead -sticky w
6050     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6051     grid $top.rev x -pady 10
6052     label $top.flab -text [mc "Output file:"]
6053     entry $top.fname -width 60
6054     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6055     incr patchnum
6056     grid $top.flab $top.fname -sticky w
6057     frame $top.buts
6058     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6059     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6060     grid $top.buts.gen $top.buts.can
6061     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6062     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6063     grid $top.buts - -pady 10 -sticky ew
6064     focus $top.fname
6065 }
6066
6067 proc mkpatchrev {} {
6068     global patchtop
6069
6070     set oldid [$patchtop.fromsha1 get]
6071     set oldhead [$patchtop.fromhead get]
6072     set newid [$patchtop.tosha1 get]
6073     set newhead [$patchtop.tohead get]
6074     foreach e [list fromsha1 fromhead tosha1 tohead] \
6075             v [list $newid $newhead $oldid $oldhead] {
6076         $patchtop.$e conf -state normal
6077         $patchtop.$e delete 0 end
6078         $patchtop.$e insert 0 $v
6079         $patchtop.$e conf -state readonly
6080     }
6081 }
6082
6083 proc mkpatchgo {} {
6084     global patchtop nullid nullid2
6085
6086     set oldid [$patchtop.fromsha1 get]
6087     set newid [$patchtop.tosha1 get]
6088     set fname [$patchtop.fname get]
6089     set cmd [diffcmd [list $oldid $newid] -p]
6090     # trim off the initial "|"
6091     set cmd [lrange $cmd 1 end]
6092     lappend cmd >$fname &
6093     if {[catch {eval exec $cmd} err]} {
6094         error_popup "[mc "Error creating patch:"] $err"
6095     }
6096     catch {destroy $patchtop}
6097     unset patchtop
6098 }
6099
6100 proc mkpatchcan {} {
6101     global patchtop
6102
6103     catch {destroy $patchtop}
6104     unset patchtop
6105 }
6106
6107 proc mktag {} {
6108     global rowmenuid mktagtop commitinfo
6109
6110     set top .maketag
6111     set mktagtop $top
6112     catch {destroy $top}
6113     toplevel $top
6114     label $top.title -text [mc "Create tag"]
6115     grid $top.title - -pady 10
6116     label $top.id -text [mc "ID:"]
6117     entry $top.sha1 -width 40 -relief flat
6118     $top.sha1 insert 0 $rowmenuid
6119     $top.sha1 conf -state readonly
6120     grid $top.id $top.sha1 -sticky w
6121     entry $top.head -width 60 -relief flat
6122     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6123     $top.head conf -state readonly
6124     grid x $top.head -sticky w
6125     label $top.tlab -text [mc "Tag name:"]
6126     entry $top.tag -width 60
6127     grid $top.tlab $top.tag -sticky w
6128     frame $top.buts
6129     button $top.buts.gen -text [mc "Create"] -command mktaggo
6130     button $top.buts.can -text [mc "Cancel"] -command mktagcan
6131     grid $top.buts.gen $top.buts.can
6132     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6133     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6134     grid $top.buts - -pady 10 -sticky ew
6135     focus $top.tag
6136 }
6137
6138 proc domktag {} {
6139     global mktagtop env tagids idtags
6140
6141     set id [$mktagtop.sha1 get]
6142     set tag [$mktagtop.tag get]
6143     if {$tag == {}} {
6144         error_popup [mc "No tag name specified"]
6145         return
6146     }
6147     if {[info exists tagids($tag)]} {
6148         error_popup [mc "Tag \"%s\" already exists" $tag]
6149         return
6150     }
6151     if {[catch {
6152         exec git tag $tag $id
6153     } err]} {
6154         error_popup "[mc "Error creating tag:"] $err"
6155         return
6156     }
6157
6158     set tagids($tag) $id
6159     lappend idtags($id) $tag
6160     redrawtags $id
6161     addedtag $id
6162     dispneartags 0
6163     run refill_reflist
6164 }
6165
6166 proc redrawtags {id} {
6167     global canv linehtag commitrow idpos selectedline curview
6168     global canvxmax iddrawn
6169
6170     if {![info exists commitrow($curview,$id)]} return
6171     if {![info exists iddrawn($id)]} return
6172     drawcommits $commitrow($curview,$id)
6173     $canv delete tag.$id
6174     set xt [eval drawtags $id $idpos($id)]
6175     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6176     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6177     set xr [expr {$xt + [font measure mainfont $text]}]
6178     if {$xr > $canvxmax} {
6179         set canvxmax $xr
6180         setcanvscroll
6181     }
6182     if {[info exists selectedline]
6183         && $selectedline == $commitrow($curview,$id)} {
6184         selectline $selectedline 0
6185     }
6186 }
6187
6188 proc mktagcan {} {
6189     global mktagtop
6190
6191     catch {destroy $mktagtop}
6192     unset mktagtop
6193 }
6194
6195 proc mktaggo {} {
6196     domktag
6197     mktagcan
6198 }
6199
6200 proc writecommit {} {
6201     global rowmenuid wrcomtop commitinfo wrcomcmd
6202
6203     set top .writecommit
6204     set wrcomtop $top
6205     catch {destroy $top}
6206     toplevel $top
6207     label $top.title -text [mc "Write commit to file"]
6208     grid $top.title - -pady 10
6209     label $top.id -text [mc "ID:"]
6210     entry $top.sha1 -width 40 -relief flat
6211     $top.sha1 insert 0 $rowmenuid
6212     $top.sha1 conf -state readonly
6213     grid $top.id $top.sha1 -sticky w
6214     entry $top.head -width 60 -relief flat
6215     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6216     $top.head conf -state readonly
6217     grid x $top.head -sticky w
6218     label $top.clab -text [mc "Command:"]
6219     entry $top.cmd -width 60 -textvariable wrcomcmd
6220     grid $top.clab $top.cmd -sticky w -pady 10
6221     label $top.flab -text [mc "Output file:"]
6222     entry $top.fname -width 60
6223     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6224     grid $top.flab $top.fname -sticky w
6225     frame $top.buts
6226     button $top.buts.gen -text [mc "Write"] -command wrcomgo
6227     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6228     grid $top.buts.gen $top.buts.can
6229     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6230     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6231     grid $top.buts - -pady 10 -sticky ew
6232     focus $top.fname
6233 }
6234
6235 proc wrcomgo {} {
6236     global wrcomtop
6237
6238     set id [$wrcomtop.sha1 get]
6239     set cmd "echo $id | [$wrcomtop.cmd get]"
6240     set fname [$wrcomtop.fname get]
6241     if {[catch {exec sh -c $cmd >$fname &} err]} {
6242         error_popup "[mc "Error writing commit:"] $err"
6243     }
6244     catch {destroy $wrcomtop}
6245     unset wrcomtop
6246 }
6247
6248 proc wrcomcan {} {
6249     global wrcomtop
6250
6251     catch {destroy $wrcomtop}
6252     unset wrcomtop
6253 }
6254
6255 proc mkbranch {} {
6256     global rowmenuid mkbrtop
6257
6258     set top .makebranch
6259     catch {destroy $top}
6260     toplevel $top
6261     label $top.title -text [mc "Create new branch"]
6262     grid $top.title - -pady 10
6263     label $top.id -text [mc "ID:"]
6264     entry $top.sha1 -width 40 -relief flat
6265     $top.sha1 insert 0 $rowmenuid
6266     $top.sha1 conf -state readonly
6267     grid $top.id $top.sha1 -sticky w
6268     label $top.nlab -text [mc "Name:"]
6269     entry $top.name -width 40
6270     grid $top.nlab $top.name -sticky w
6271     frame $top.buts
6272     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6273     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6274     grid $top.buts.go $top.buts.can
6275     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6276     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6277     grid $top.buts - -pady 10 -sticky ew
6278     focus $top.name
6279 }
6280
6281 proc mkbrgo {top} {
6282     global headids idheads
6283
6284     set name [$top.name get]
6285     set id [$top.sha1 get]
6286     if {$name eq {}} {
6287         error_popup [mc "Please specify a name for the new branch"]
6288         return
6289     }
6290     catch {destroy $top}
6291     nowbusy newbranch
6292     update
6293     if {[catch {
6294         exec git branch $name $id
6295     } err]} {
6296         notbusy newbranch
6297         error_popup $err
6298     } else {
6299         set headids($name) $id
6300         lappend idheads($id) $name
6301         addedhead $id $name
6302         notbusy newbranch
6303         redrawtags $id
6304         dispneartags 0
6305         run refill_reflist
6306     }
6307 }
6308
6309 proc cherrypick {} {
6310     global rowmenuid curview commitrow
6311     global mainhead
6312
6313     set oldhead [exec git rev-parse HEAD]
6314     set dheads [descheads $rowmenuid]
6315     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6316         set ok [confirm_popup [mc "Commit %s is already\
6317                 included in branch %s -- really re-apply it?" \
6318                                    [string range $rowmenuid 0 7] $mainhead]]
6319         if {!$ok} return
6320     }
6321     nowbusy cherrypick [mc "Cherry-picking"]
6322     update
6323     # Unfortunately git-cherry-pick writes stuff to stderr even when
6324     # no error occurs, and exec takes that as an indication of error...
6325     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6326         notbusy cherrypick
6327         error_popup $err
6328         return
6329     }
6330     set newhead [exec git rev-parse HEAD]
6331     if {$newhead eq $oldhead} {
6332         notbusy cherrypick
6333         error_popup [mc "No changes committed"]
6334         return
6335     }
6336     addnewchild $newhead $oldhead
6337     if {[info exists commitrow($curview,$oldhead)]} {
6338         insertrow $commitrow($curview,$oldhead) $newhead
6339         if {$mainhead ne {}} {
6340             movehead $newhead $mainhead
6341             movedhead $newhead $mainhead
6342         }
6343         redrawtags $oldhead
6344         redrawtags $newhead
6345     }
6346     notbusy cherrypick
6347 }
6348
6349 proc resethead {} {
6350     global mainheadid mainhead rowmenuid confirm_ok resettype
6351
6352     set confirm_ok 0
6353     set w ".confirmreset"
6354     toplevel $w
6355     wm transient $w .
6356     wm title $w [mc "Confirm reset"]
6357     message $w.m -text \
6358         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6359         -justify center -aspect 1000
6360     pack $w.m -side top -fill x -padx 20 -pady 20
6361     frame $w.f -relief sunken -border 2
6362     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6363     grid $w.f.rt -sticky w
6364     set resettype mixed
6365     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6366         -text [mc "Soft: Leave working tree and index untouched"]
6367     grid $w.f.soft -sticky w
6368     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6369         -text [mc "Mixed: Leave working tree untouched, reset index"]
6370     grid $w.f.mixed -sticky w
6371     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6372         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6373     grid $w.f.hard -sticky w
6374     pack $w.f -side top -fill x
6375     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6376     pack $w.ok -side left -fill x -padx 20 -pady 20
6377     button $w.cancel -text [mc Cancel] -command "destroy $w"
6378     pack $w.cancel -side right -fill x -padx 20 -pady 20
6379     bind $w <Visibility> "grab $w; focus $w"
6380     tkwait window $w
6381     if {!$confirm_ok} return
6382     if {[catch {set fd [open \
6383             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6384         error_popup $err
6385     } else {
6386         dohidelocalchanges
6387         filerun $fd [list readresetstat $fd]
6388         nowbusy reset [mc "Resetting"]
6389     }
6390 }
6391
6392 proc readresetstat {fd} {
6393     global mainhead mainheadid showlocalchanges rprogcoord
6394
6395     if {[gets $fd line] >= 0} {
6396         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6397             set rprogcoord [expr {1.0 * $m / $n}]
6398             adjustprogress
6399         }
6400         return 1
6401     }
6402     set rprogcoord 0
6403     adjustprogress
6404     notbusy reset
6405     if {[catch {close $fd} err]} {
6406         error_popup $err
6407     }
6408     set oldhead $mainheadid
6409     set newhead [exec git rev-parse HEAD]
6410     if {$newhead ne $oldhead} {
6411         movehead $newhead $mainhead
6412         movedhead $newhead $mainhead
6413         set mainheadid $newhead
6414         redrawtags $oldhead
6415         redrawtags $newhead
6416     }
6417     if {$showlocalchanges} {
6418         doshowlocalchanges
6419     }
6420     return 0
6421 }
6422
6423 # context menu for a head
6424 proc headmenu {x y id head} {
6425     global headmenuid headmenuhead headctxmenu mainhead
6426
6427     stopfinding
6428     set headmenuid $id
6429     set headmenuhead $head
6430     set state normal
6431     if {$head eq $mainhead} {
6432         set state disabled
6433     }
6434     $headctxmenu entryconfigure 0 -state $state
6435     $headctxmenu entryconfigure 1 -state $state
6436     tk_popup $headctxmenu $x $y
6437 }
6438
6439 proc cobranch {} {
6440     global headmenuid headmenuhead mainhead headids
6441     global showlocalchanges mainheadid
6442
6443     # check the tree is clean first??
6444     set oldmainhead $mainhead
6445     nowbusy checkout [mc "Checking out"]
6446     update
6447     dohidelocalchanges
6448     if {[catch {
6449         exec git checkout -q $headmenuhead
6450     } err]} {
6451         notbusy checkout
6452         error_popup $err
6453     } else {
6454         notbusy checkout
6455         set mainhead $headmenuhead
6456         set mainheadid $headmenuid
6457         if {[info exists headids($oldmainhead)]} {
6458             redrawtags $headids($oldmainhead)
6459         }
6460         redrawtags $headmenuid
6461     }
6462     if {$showlocalchanges} {
6463         dodiffindex
6464     }
6465 }
6466
6467 proc rmbranch {} {
6468     global headmenuid headmenuhead mainhead
6469     global idheads
6470
6471     set head $headmenuhead
6472     set id $headmenuid
6473     # this check shouldn't be needed any more...
6474     if {$head eq $mainhead} {
6475         error_popup [mc "Cannot delete the currently checked-out branch"]
6476         return
6477     }
6478     set dheads [descheads $id]
6479     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6480         # the stuff on this branch isn't on any other branch
6481         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6482                         branch.\nReally delete branch %s?" $head $head]]} return
6483     }
6484     nowbusy rmbranch
6485     update
6486     if {[catch {exec git branch -D $head} err]} {
6487         notbusy rmbranch
6488         error_popup $err
6489         return
6490     }
6491     removehead $id $head
6492     removedhead $id $head
6493     redrawtags $id
6494     notbusy rmbranch
6495     dispneartags 0
6496     run refill_reflist
6497 }
6498
6499 # Display a list of tags and heads
6500 proc showrefs {} {
6501     global showrefstop bgcolor fgcolor selectbgcolor
6502     global bglist fglist reflistfilter reflist maincursor
6503
6504     set top .showrefs
6505     set showrefstop $top
6506     if {[winfo exists $top]} {
6507         raise $top
6508         refill_reflist
6509         return
6510     }
6511     toplevel $top
6512     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6513     text $top.list -background $bgcolor -foreground $fgcolor \
6514         -selectbackground $selectbgcolor -font mainfont \
6515         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6516         -width 30 -height 20 -cursor $maincursor \
6517         -spacing1 1 -spacing3 1 -state disabled
6518     $top.list tag configure highlight -background $selectbgcolor
6519     lappend bglist $top.list
6520     lappend fglist $top.list
6521     scrollbar $top.ysb -command "$top.list yview" -orient vertical
6522     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6523     grid $top.list $top.ysb -sticky nsew
6524     grid $top.xsb x -sticky ew
6525     frame $top.f
6526     label $top.f.l -text "[mc "Filter"]: "
6527     entry $top.f.e -width 20 -textvariable reflistfilter
6528     set reflistfilter "*"
6529     trace add variable reflistfilter write reflistfilter_change
6530     pack $top.f.e -side right -fill x -expand 1
6531     pack $top.f.l -side left
6532     grid $top.f - -sticky ew -pady 2
6533     button $top.close -command [list destroy $top] -text [mc "Close"]
6534     grid $top.close -
6535     grid columnconfigure $top 0 -weight 1
6536     grid rowconfigure $top 0 -weight 1
6537     bind $top.list <1> {break}
6538     bind $top.list <B1-Motion> {break}
6539     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6540     set reflist {}
6541     refill_reflist
6542 }
6543
6544 proc sel_reflist {w x y} {
6545     global showrefstop reflist headids tagids otherrefids
6546
6547     if {![winfo exists $showrefstop]} return
6548     set l [lindex [split [$w index "@$x,$y"] "."] 0]
6549     set ref [lindex $reflist [expr {$l-1}]]
6550     set n [lindex $ref 0]
6551     switch -- [lindex $ref 1] {
6552         "H" {selbyid $headids($n)}
6553         "T" {selbyid $tagids($n)}
6554         "o" {selbyid $otherrefids($n)}
6555     }
6556     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6557 }
6558
6559 proc unsel_reflist {} {
6560     global showrefstop
6561
6562     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6563     $showrefstop.list tag remove highlight 0.0 end
6564 }
6565
6566 proc reflistfilter_change {n1 n2 op} {
6567     global reflistfilter
6568
6569     after cancel refill_reflist
6570     after 200 refill_reflist
6571 }
6572
6573 proc refill_reflist {} {
6574     global reflist reflistfilter showrefstop headids tagids otherrefids
6575     global commitrow curview commitinterest
6576
6577     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6578     set refs {}
6579     foreach n [array names headids] {
6580         if {[string match $reflistfilter $n]} {
6581             if {[info exists commitrow($curview,$headids($n))]} {
6582                 lappend refs [list $n H]
6583             } else {
6584                 set commitinterest($headids($n)) {run refill_reflist}
6585             }
6586         }
6587     }
6588     foreach n [array names tagids] {
6589         if {[string match $reflistfilter $n]} {
6590             if {[info exists commitrow($curview,$tagids($n))]} {
6591                 lappend refs [list $n T]
6592             } else {
6593                 set commitinterest($tagids($n)) {run refill_reflist}
6594             }
6595         }
6596     }
6597     foreach n [array names otherrefids] {
6598         if {[string match $reflistfilter $n]} {
6599             if {[info exists commitrow($curview,$otherrefids($n))]} {
6600                 lappend refs [list $n o]
6601             } else {
6602                 set commitinterest($otherrefids($n)) {run refill_reflist}
6603             }
6604         }
6605     }
6606     set refs [lsort -index 0 $refs]
6607     if {$refs eq $reflist} return
6608
6609     # Update the contents of $showrefstop.list according to the
6610     # differences between $reflist (old) and $refs (new)
6611     $showrefstop.list conf -state normal
6612     $showrefstop.list insert end "\n"
6613     set i 0
6614     set j 0
6615     while {$i < [llength $reflist] || $j < [llength $refs]} {
6616         if {$i < [llength $reflist]} {
6617             if {$j < [llength $refs]} {
6618                 set cmp [string compare [lindex $reflist $i 0] \
6619                              [lindex $refs $j 0]]
6620                 if {$cmp == 0} {
6621                     set cmp [string compare [lindex $reflist $i 1] \
6622                                  [lindex $refs $j 1]]
6623                 }
6624             } else {
6625                 set cmp -1
6626             }
6627         } else {
6628             set cmp 1
6629         }
6630         switch -- $cmp {
6631             -1 {
6632                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6633                 incr i
6634             }
6635             0 {
6636                 incr i
6637                 incr j
6638             }
6639             1 {
6640                 set l [expr {$j + 1}]
6641                 $showrefstop.list image create $l.0 -align baseline \
6642                     -image reficon-[lindex $refs $j 1] -padx 2
6643                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6644                 incr j
6645             }
6646         }
6647     }
6648     set reflist $refs
6649     # delete last newline
6650     $showrefstop.list delete end-2c end-1c
6651     $showrefstop.list conf -state disabled
6652 }
6653
6654 # Stuff for finding nearby tags
6655 proc getallcommits {} {
6656     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6657     global idheads idtags idotherrefs allparents tagobjid
6658
6659     if {![info exists allcommits]} {
6660         set nextarc 0
6661         set allcommits 0
6662         set seeds {}
6663         set allcwait 0
6664         set cachedarcs 0
6665         set allccache [file join [gitdir] "gitk.cache"]
6666         if {![catch {
6667             set f [open $allccache r]
6668             set allcwait 1
6669             getcache $f
6670         }]} return
6671     }
6672
6673     if {$allcwait} {
6674         return
6675     }
6676     set cmd [list | git rev-list --parents]
6677     set allcupdate [expr {$seeds ne {}}]
6678     if {!$allcupdate} {
6679         set ids "--all"
6680     } else {
6681         set refs [concat [array names idheads] [array names idtags] \
6682                       [array names idotherrefs]]
6683         set ids {}
6684         set tagobjs {}
6685         foreach name [array names tagobjid] {
6686             lappend tagobjs $tagobjid($name)
6687         }
6688         foreach id [lsort -unique $refs] {
6689             if {![info exists allparents($id)] &&
6690                 [lsearch -exact $tagobjs $id] < 0} {
6691                 lappend ids $id
6692             }
6693         }
6694         if {$ids ne {}} {
6695             foreach id $seeds {
6696                 lappend ids "^$id"
6697             }
6698         }
6699     }
6700     if {$ids ne {}} {
6701         set fd [open [concat $cmd $ids] r]
6702         fconfigure $fd -blocking 0
6703         incr allcommits
6704         nowbusy allcommits
6705         filerun $fd [list getallclines $fd]
6706     } else {
6707         dispneartags 0
6708     }
6709 }
6710
6711 # Since most commits have 1 parent and 1 child, we group strings of
6712 # such commits into "arcs" joining branch/merge points (BMPs), which
6713 # are commits that either don't have 1 parent or don't have 1 child.
6714 #
6715 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6716 # arcout(id) - outgoing arcs for BMP
6717 # arcids(a) - list of IDs on arc including end but not start
6718 # arcstart(a) - BMP ID at start of arc
6719 # arcend(a) - BMP ID at end of arc
6720 # growing(a) - arc a is still growing
6721 # arctags(a) - IDs out of arcids (excluding end) that have tags
6722 # archeads(a) - IDs out of arcids (excluding end) that have heads
6723 # The start of an arc is at the descendent end, so "incoming" means
6724 # coming from descendents, and "outgoing" means going towards ancestors.
6725
6726 proc getallclines {fd} {
6727     global allparents allchildren idtags idheads nextarc
6728     global arcnos arcids arctags arcout arcend arcstart archeads growing
6729     global seeds allcommits cachedarcs allcupdate
6730     
6731     set nid 0
6732     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6733         set id [lindex $line 0]
6734         if {[info exists allparents($id)]} {
6735             # seen it already
6736             continue
6737         }
6738         set cachedarcs 0
6739         set olds [lrange $line 1 end]
6740         set allparents($id) $olds
6741         if {![info exists allchildren($id)]} {
6742             set allchildren($id) {}
6743             set arcnos($id) {}
6744             lappend seeds $id
6745         } else {
6746             set a $arcnos($id)
6747             if {[llength $olds] == 1 && [llength $a] == 1} {
6748                 lappend arcids($a) $id
6749                 if {[info exists idtags($id)]} {
6750                     lappend arctags($a) $id
6751                 }
6752                 if {[info exists idheads($id)]} {
6753                     lappend archeads($a) $id
6754                 }
6755                 if {[info exists allparents($olds)]} {
6756                     # seen parent already
6757                     if {![info exists arcout($olds)]} {
6758                         splitarc $olds
6759                     }
6760                     lappend arcids($a) $olds
6761                     set arcend($a) $olds
6762                     unset growing($a)
6763                 }
6764                 lappend allchildren($olds) $id
6765                 lappend arcnos($olds) $a
6766                 continue
6767             }
6768         }
6769         foreach a $arcnos($id) {
6770             lappend arcids($a) $id
6771             set arcend($a) $id
6772             unset growing($a)
6773         }
6774
6775         set ao {}
6776         foreach p $olds {
6777             lappend allchildren($p) $id
6778             set a [incr nextarc]
6779             set arcstart($a) $id
6780             set archeads($a) {}
6781             set arctags($a) {}
6782             set archeads($a) {}
6783             set arcids($a) {}
6784             lappend ao $a
6785             set growing($a) 1
6786             if {[info exists allparents($p)]} {
6787                 # seen it already, may need to make a new branch
6788                 if {![info exists arcout($p)]} {
6789                     splitarc $p
6790                 }
6791                 lappend arcids($a) $p
6792                 set arcend($a) $p
6793                 unset growing($a)
6794             }
6795             lappend arcnos($p) $a
6796         }
6797         set arcout($id) $ao
6798     }
6799     if {$nid > 0} {
6800         global cached_dheads cached_dtags cached_atags
6801         catch {unset cached_dheads}
6802         catch {unset cached_dtags}
6803         catch {unset cached_atags}
6804     }
6805     if {![eof $fd]} {
6806         return [expr {$nid >= 1000? 2: 1}]
6807     }
6808     set cacheok 1
6809     if {[catch {
6810         fconfigure $fd -blocking 1
6811         close $fd
6812     } err]} {
6813         # got an error reading the list of commits
6814         # if we were updating, try rereading the whole thing again
6815         if {$allcupdate} {
6816             incr allcommits -1
6817             dropcache $err
6818             return
6819         }
6820         error_popup "[mc "Error reading commit topology information;\
6821                 branch and preceding/following tag information\
6822                 will be incomplete."]\n($err)"
6823         set cacheok 0
6824     }
6825     if {[incr allcommits -1] == 0} {
6826         notbusy allcommits
6827         if {$cacheok} {
6828             run savecache
6829         }
6830     }
6831     dispneartags 0
6832     return 0
6833 }
6834
6835 proc recalcarc {a} {
6836     global arctags archeads arcids idtags idheads
6837
6838     set at {}
6839     set ah {}
6840     foreach id [lrange $arcids($a) 0 end-1] {
6841         if {[info exists idtags($id)]} {
6842             lappend at $id
6843         }
6844         if {[info exists idheads($id)]} {
6845             lappend ah $id
6846         }
6847     }
6848     set arctags($a) $at
6849     set archeads($a) $ah
6850 }
6851
6852 proc splitarc {p} {
6853     global arcnos arcids nextarc arctags archeads idtags idheads
6854     global arcstart arcend arcout allparents growing
6855
6856     set a $arcnos($p)
6857     if {[llength $a] != 1} {
6858         puts "oops splitarc called but [llength $a] arcs already"
6859         return
6860     }
6861     set a [lindex $a 0]
6862     set i [lsearch -exact $arcids($a) $p]
6863     if {$i < 0} {
6864         puts "oops splitarc $p not in arc $a"
6865         return
6866     }
6867     set na [incr nextarc]
6868     if {[info exists arcend($a)]} {
6869         set arcend($na) $arcend($a)
6870     } else {
6871         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6872         set j [lsearch -exact $arcnos($l) $a]
6873         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6874     }
6875     set tail [lrange $arcids($a) [expr {$i+1}] end]
6876     set arcids($a) [lrange $arcids($a) 0 $i]
6877     set arcend($a) $p
6878     set arcstart($na) $p
6879     set arcout($p) $na
6880     set arcids($na) $tail
6881     if {[info exists growing($a)]} {
6882         set growing($na) 1
6883         unset growing($a)
6884     }
6885
6886     foreach id $tail {
6887         if {[llength $arcnos($id)] == 1} {
6888             set arcnos($id) $na
6889         } else {
6890             set j [lsearch -exact $arcnos($id) $a]
6891             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6892         }
6893     }
6894
6895     # reconstruct tags and heads lists
6896     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6897         recalcarc $a
6898         recalcarc $na
6899     } else {
6900         set arctags($na) {}
6901         set archeads($na) {}
6902     }
6903 }
6904
6905 # Update things for a new commit added that is a child of one
6906 # existing commit.  Used when cherry-picking.
6907 proc addnewchild {id p} {
6908     global allparents allchildren idtags nextarc
6909     global arcnos arcids arctags arcout arcend arcstart archeads growing
6910     global seeds allcommits
6911
6912     if {![info exists allcommits] || ![info exists arcnos($p)]} return
6913     set allparents($id) [list $p]
6914     set allchildren($id) {}
6915     set arcnos($id) {}
6916     lappend seeds $id
6917     lappend allchildren($p) $id
6918     set a [incr nextarc]
6919     set arcstart($a) $id
6920     set archeads($a) {}
6921     set arctags($a) {}
6922     set arcids($a) [list $p]
6923     set arcend($a) $p
6924     if {![info exists arcout($p)]} {
6925         splitarc $p
6926     }
6927     lappend arcnos($p) $a
6928     set arcout($id) [list $a]
6929 }
6930
6931 # This implements a cache for the topology information.
6932 # The cache saves, for each arc, the start and end of the arc,
6933 # the ids on the arc, and the outgoing arcs from the end.
6934 proc readcache {f} {
6935     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6936     global idtags idheads allparents cachedarcs possible_seeds seeds growing
6937     global allcwait
6938
6939     set a $nextarc
6940     set lim $cachedarcs
6941     if {$lim - $a > 500} {
6942         set lim [expr {$a + 500}]
6943     }
6944     if {[catch {
6945         if {$a == $lim} {
6946             # finish reading the cache and setting up arctags, etc.
6947             set line [gets $f]
6948             if {$line ne "1"} {error "bad final version"}
6949             close $f
6950             foreach id [array names idtags] {
6951                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6952                     [llength $allparents($id)] == 1} {
6953                     set a [lindex $arcnos($id) 0]
6954                     if {$arctags($a) eq {}} {
6955                         recalcarc $a
6956                     }
6957                 }
6958             }
6959             foreach id [array names idheads] {
6960                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6961                     [llength $allparents($id)] == 1} {
6962                     set a [lindex $arcnos($id) 0]
6963                     if {$archeads($a) eq {}} {
6964                         recalcarc $a
6965                     }
6966                 }
6967             }
6968             foreach id [lsort -unique $possible_seeds] {
6969                 if {$arcnos($id) eq {}} {
6970                     lappend seeds $id
6971                 }
6972             }
6973             set allcwait 0
6974         } else {
6975             while {[incr a] <= $lim} {
6976                 set line [gets $f]
6977                 if {[llength $line] != 3} {error "bad line"}
6978                 set s [lindex $line 0]
6979                 set arcstart($a) $s
6980                 lappend arcout($s) $a
6981                 if {![info exists arcnos($s)]} {
6982                     lappend possible_seeds $s
6983                     set arcnos($s) {}
6984                 }
6985                 set e [lindex $line 1]
6986                 if {$e eq {}} {
6987                     set growing($a) 1
6988                 } else {
6989                     set arcend($a) $e
6990                     if {![info exists arcout($e)]} {
6991                         set arcout($e) {}
6992                     }
6993                 }
6994                 set arcids($a) [lindex $line 2]
6995                 foreach id $arcids($a) {
6996                     lappend allparents($s) $id
6997                     set s $id
6998                     lappend arcnos($id) $a
6999                 }
7000                 if {![info exists allparents($s)]} {
7001                     set allparents($s) {}
7002                 }
7003                 set arctags($a) {}
7004                 set archeads($a) {}
7005             }
7006             set nextarc [expr {$a - 1}]
7007         }
7008     } err]} {
7009         dropcache $err
7010         return 0
7011     }
7012     if {!$allcwait} {
7013         getallcommits
7014     }
7015     return $allcwait
7016 }
7017
7018 proc getcache {f} {
7019     global nextarc cachedarcs possible_seeds
7020
7021     if {[catch {
7022         set line [gets $f]
7023         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7024         # make sure it's an integer
7025         set cachedarcs [expr {int([lindex $line 1])}]
7026         if {$cachedarcs < 0} {error "bad number of arcs"}
7027         set nextarc 0
7028         set possible_seeds {}
7029         run readcache $f
7030     } err]} {
7031         dropcache $err
7032     }
7033     return 0
7034 }
7035
7036 proc dropcache {err} {
7037     global allcwait nextarc cachedarcs seeds
7038
7039     #puts "dropping cache ($err)"
7040     foreach v {arcnos arcout arcids arcstart arcend growing \
7041                    arctags archeads allparents allchildren} {
7042         global $v
7043         catch {unset $v}
7044     }
7045     set allcwait 0
7046     set nextarc 0
7047     set cachedarcs 0
7048     set seeds {}
7049     getallcommits
7050 }
7051
7052 proc writecache {f} {
7053     global cachearc cachedarcs allccache
7054     global arcstart arcend arcnos arcids arcout
7055
7056     set a $cachearc
7057     set lim $cachedarcs
7058     if {$lim - $a > 1000} {
7059         set lim [expr {$a + 1000}]
7060     }
7061     if {[catch {
7062         while {[incr a] <= $lim} {
7063             if {[info exists arcend($a)]} {
7064                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7065             } else {
7066                 puts $f [list $arcstart($a) {} $arcids($a)]
7067             }
7068         }
7069     } err]} {
7070         catch {close $f}
7071         catch {file delete $allccache}
7072         #puts "writing cache failed ($err)"
7073         return 0
7074     }
7075     set cachearc [expr {$a - 1}]
7076     if {$a > $cachedarcs} {
7077         puts $f "1"
7078         close $f
7079         return 0
7080     }
7081     return 1
7082 }
7083
7084 proc savecache {} {
7085     global nextarc cachedarcs cachearc allccache
7086
7087     if {$nextarc == $cachedarcs} return
7088     set cachearc 0
7089     set cachedarcs $nextarc
7090     catch {
7091         set f [open $allccache w]
7092         puts $f [list 1 $cachedarcs]
7093         run writecache $f
7094     }
7095 }
7096
7097 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7098 # or 0 if neither is true.
7099 proc anc_or_desc {a b} {
7100     global arcout arcstart arcend arcnos cached_isanc
7101
7102     if {$arcnos($a) eq $arcnos($b)} {
7103         # Both are on the same arc(s); either both are the same BMP,
7104         # or if one is not a BMP, the other is also not a BMP or is
7105         # the BMP at end of the arc (and it only has 1 incoming arc).
7106         # Or both can be BMPs with no incoming arcs.
7107         if {$a eq $b || $arcnos($a) eq {}} {
7108             return 0
7109         }
7110         # assert {[llength $arcnos($a)] == 1}
7111         set arc [lindex $arcnos($a) 0]
7112         set i [lsearch -exact $arcids($arc) $a]
7113         set j [lsearch -exact $arcids($arc) $b]
7114         if {$i < 0 || $i > $j} {
7115             return 1
7116         } else {
7117             return -1
7118         }
7119     }
7120
7121     if {![info exists arcout($a)]} {
7122         set arc [lindex $arcnos($a) 0]
7123         if {[info exists arcend($arc)]} {
7124             set aend $arcend($arc)
7125         } else {
7126             set aend {}
7127         }
7128         set a $arcstart($arc)
7129     } else {
7130         set aend $a
7131     }
7132     if {![info exists arcout($b)]} {
7133         set arc [lindex $arcnos($b) 0]
7134         if {[info exists arcend($arc)]} {
7135             set bend $arcend($arc)
7136         } else {
7137             set bend {}
7138         }
7139         set b $arcstart($arc)
7140     } else {
7141         set bend $b
7142     }
7143     if {$a eq $bend} {
7144         return 1
7145     }
7146     if {$b eq $aend} {
7147         return -1
7148     }
7149     if {[info exists cached_isanc($a,$bend)]} {
7150         if {$cached_isanc($a,$bend)} {
7151             return 1
7152         }
7153     }
7154     if {[info exists cached_isanc($b,$aend)]} {
7155         if {$cached_isanc($b,$aend)} {
7156             return -1
7157         }
7158         if {[info exists cached_isanc($a,$bend)]} {
7159             return 0
7160         }
7161     }
7162
7163     set todo [list $a $b]
7164     set anc($a) a
7165     set anc($b) b
7166     for {set i 0} {$i < [llength $todo]} {incr i} {
7167         set x [lindex $todo $i]
7168         if {$anc($x) eq {}} {
7169             continue
7170         }
7171         foreach arc $arcnos($x) {
7172             set xd $arcstart($arc)
7173             if {$xd eq $bend} {
7174                 set cached_isanc($a,$bend) 1
7175                 set cached_isanc($b,$aend) 0
7176                 return 1
7177             } elseif {$xd eq $aend} {
7178                 set cached_isanc($b,$aend) 1
7179                 set cached_isanc($a,$bend) 0
7180                 return -1
7181             }
7182             if {![info exists anc($xd)]} {
7183                 set anc($xd) $anc($x)
7184                 lappend todo $xd
7185             } elseif {$anc($xd) ne $anc($x)} {
7186                 set anc($xd) {}
7187             }
7188         }
7189     }
7190     set cached_isanc($a,$bend) 0
7191     set cached_isanc($b,$aend) 0
7192     return 0
7193 }
7194
7195 # This identifies whether $desc has an ancestor that is
7196 # a growing tip of the graph and which is not an ancestor of $anc
7197 # and returns 0 if so and 1 if not.
7198 # If we subsequently discover a tag on such a growing tip, and that
7199 # turns out to be a descendent of $anc (which it could, since we
7200 # don't necessarily see children before parents), then $desc
7201 # isn't a good choice to display as a descendent tag of
7202 # $anc (since it is the descendent of another tag which is
7203 # a descendent of $anc).  Similarly, $anc isn't a good choice to
7204 # display as a ancestor tag of $desc.
7205 #
7206 proc is_certain {desc anc} {
7207     global arcnos arcout arcstart arcend growing problems
7208
7209     set certain {}
7210     if {[llength $arcnos($anc)] == 1} {
7211         # tags on the same arc are certain
7212         if {$arcnos($desc) eq $arcnos($anc)} {
7213             return 1
7214         }
7215         if {![info exists arcout($anc)]} {
7216             # if $anc is partway along an arc, use the start of the arc instead
7217             set a [lindex $arcnos($anc) 0]
7218             set anc $arcstart($a)
7219         }
7220     }
7221     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7222         set x $desc
7223     } else {
7224         set a [lindex $arcnos($desc) 0]
7225         set x $arcend($a)
7226     }
7227     if {$x == $anc} {
7228         return 1
7229     }
7230     set anclist [list $x]
7231     set dl($x) 1
7232     set nnh 1
7233     set ngrowanc 0
7234     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7235         set x [lindex $anclist $i]
7236         if {$dl($x)} {
7237             incr nnh -1
7238         }
7239         set done($x) 1
7240         foreach a $arcout($x) {
7241             if {[info exists growing($a)]} {
7242                 if {![info exists growanc($x)] && $dl($x)} {
7243                     set growanc($x) 1
7244                     incr ngrowanc
7245                 }
7246             } else {
7247                 set y $arcend($a)
7248                 if {[info exists dl($y)]} {
7249                     if {$dl($y)} {
7250                         if {!$dl($x)} {
7251                             set dl($y) 0
7252                             if {![info exists done($y)]} {
7253                                 incr nnh -1
7254                             }
7255                             if {[info exists growanc($x)]} {
7256                                 incr ngrowanc -1
7257                             }
7258                             set xl [list $y]
7259                             for {set k 0} {$k < [llength $xl]} {incr k} {
7260                                 set z [lindex $xl $k]
7261                                 foreach c $arcout($z) {
7262                                     if {[info exists arcend($c)]} {
7263                                         set v $arcend($c)
7264                                         if {[info exists dl($v)] && $dl($v)} {
7265                                             set dl($v) 0
7266                                             if {![info exists done($v)]} {
7267                                                 incr nnh -1
7268                                             }
7269                                             if {[info exists growanc($v)]} {
7270                                                 incr ngrowanc -1
7271                                             }
7272                                             lappend xl $v
7273                                         }
7274                                     }
7275                                 }
7276                             }
7277                         }
7278                     }
7279                 } elseif {$y eq $anc || !$dl($x)} {
7280                     set dl($y) 0
7281                     lappend anclist $y
7282                 } else {
7283                     set dl($y) 1
7284                     lappend anclist $y
7285                     incr nnh
7286                 }
7287             }
7288         }
7289     }
7290     foreach x [array names growanc] {
7291         if {$dl($x)} {
7292             return 0
7293         }
7294         return 0
7295     }
7296     return 1
7297 }
7298
7299 proc validate_arctags {a} {
7300     global arctags idtags
7301
7302     set i -1
7303     set na $arctags($a)
7304     foreach id $arctags($a) {
7305         incr i
7306         if {![info exists idtags($id)]} {
7307             set na [lreplace $na $i $i]
7308             incr i -1
7309         }
7310     }
7311     set arctags($a) $na
7312 }
7313
7314 proc validate_archeads {a} {
7315     global archeads idheads
7316
7317     set i -1
7318     set na $archeads($a)
7319     foreach id $archeads($a) {
7320         incr i
7321         if {![info exists idheads($id)]} {
7322             set na [lreplace $na $i $i]
7323             incr i -1
7324         }
7325     }
7326     set archeads($a) $na
7327 }
7328
7329 # Return the list of IDs that have tags that are descendents of id,
7330 # ignoring IDs that are descendents of IDs already reported.
7331 proc desctags {id} {
7332     global arcnos arcstart arcids arctags idtags allparents
7333     global growing cached_dtags
7334
7335     if {![info exists allparents($id)]} {
7336         return {}
7337     }
7338     set t1 [clock clicks -milliseconds]
7339     set argid $id
7340     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7341         # part-way along an arc; check that arc first
7342         set a [lindex $arcnos($id) 0]
7343         if {$arctags($a) ne {}} {
7344             validate_arctags $a
7345             set i [lsearch -exact $arcids($a) $id]
7346             set tid {}
7347             foreach t $arctags($a) {
7348                 set j [lsearch -exact $arcids($a) $t]
7349                 if {$j >= $i} break
7350                 set tid $t
7351             }
7352             if {$tid ne {}} {
7353                 return $tid
7354             }
7355         }
7356         set id $arcstart($a)
7357         if {[info exists idtags($id)]} {
7358             return $id
7359         }
7360     }
7361     if {[info exists cached_dtags($id)]} {
7362         return $cached_dtags($id)
7363     }
7364
7365     set origid $id
7366     set todo [list $id]
7367     set queued($id) 1
7368     set nc 1
7369     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7370         set id [lindex $todo $i]
7371         set done($id) 1
7372         set ta [info exists hastaggedancestor($id)]
7373         if {!$ta} {
7374             incr nc -1
7375         }
7376         # ignore tags on starting node
7377         if {!$ta && $i > 0} {
7378             if {[info exists idtags($id)]} {
7379                 set tagloc($id) $id
7380                 set ta 1
7381             } elseif {[info exists cached_dtags($id)]} {
7382                 set tagloc($id) $cached_dtags($id)
7383                 set ta 1
7384             }
7385         }
7386         foreach a $arcnos($id) {
7387             set d $arcstart($a)
7388             if {!$ta && $arctags($a) ne {}} {
7389                 validate_arctags $a
7390                 if {$arctags($a) ne {}} {
7391                     lappend tagloc($id) [lindex $arctags($a) end]
7392                 }
7393             }
7394             if {$ta || $arctags($a) ne {}} {
7395                 set tomark [list $d]
7396                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7397                     set dd [lindex $tomark $j]
7398                     if {![info exists hastaggedancestor($dd)]} {
7399                         if {[info exists done($dd)]} {
7400                             foreach b $arcnos($dd) {
7401                                 lappend tomark $arcstart($b)
7402                             }
7403                             if {[info exists tagloc($dd)]} {
7404                                 unset tagloc($dd)
7405                             }
7406                         } elseif {[info exists queued($dd)]} {
7407                             incr nc -1
7408                         }
7409                         set hastaggedancestor($dd) 1
7410                     }
7411                 }
7412             }
7413             if {![info exists queued($d)]} {
7414                 lappend todo $d
7415                 set queued($d) 1
7416                 if {![info exists hastaggedancestor($d)]} {
7417                     incr nc
7418                 }
7419             }
7420         }
7421     }
7422     set tags {}
7423     foreach id [array names tagloc] {
7424         if {![info exists hastaggedancestor($id)]} {
7425             foreach t $tagloc($id) {
7426                 if {[lsearch -exact $tags $t] < 0} {
7427                     lappend tags $t
7428                 }
7429             }
7430         }
7431     }
7432     set t2 [clock clicks -milliseconds]
7433     set loopix $i
7434
7435     # remove tags that are descendents of other tags
7436     for {set i 0} {$i < [llength $tags]} {incr i} {
7437         set a [lindex $tags $i]
7438         for {set j 0} {$j < $i} {incr j} {
7439             set b [lindex $tags $j]
7440             set r [anc_or_desc $a $b]
7441             if {$r == 1} {
7442                 set tags [lreplace $tags $j $j]
7443                 incr j -1
7444                 incr i -1
7445             } elseif {$r == -1} {
7446                 set tags [lreplace $tags $i $i]
7447                 incr i -1
7448                 break
7449             }
7450         }
7451     }
7452
7453     if {[array names growing] ne {}} {
7454         # graph isn't finished, need to check if any tag could get
7455         # eclipsed by another tag coming later.  Simply ignore any
7456         # tags that could later get eclipsed.
7457         set ctags {}
7458         foreach t $tags {
7459             if {[is_certain $t $origid]} {
7460                 lappend ctags $t
7461             }
7462         }
7463         if {$tags eq $ctags} {
7464             set cached_dtags($origid) $tags
7465         } else {
7466             set tags $ctags
7467         }
7468     } else {
7469         set cached_dtags($origid) $tags
7470     }
7471     set t3 [clock clicks -milliseconds]
7472     if {0 && $t3 - $t1 >= 100} {
7473         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7474             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7475     }
7476     return $tags
7477 }
7478
7479 proc anctags {id} {
7480     global arcnos arcids arcout arcend arctags idtags allparents
7481     global growing cached_atags
7482
7483     if {![info exists allparents($id)]} {
7484         return {}
7485     }
7486     set t1 [clock clicks -milliseconds]
7487     set argid $id
7488     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7489         # part-way along an arc; check that arc first
7490         set a [lindex $arcnos($id) 0]
7491         if {$arctags($a) ne {}} {
7492             validate_arctags $a
7493             set i [lsearch -exact $arcids($a) $id]
7494             foreach t $arctags($a) {
7495                 set j [lsearch -exact $arcids($a) $t]
7496                 if {$j > $i} {
7497                     return $t
7498                 }
7499             }
7500         }
7501         if {![info exists arcend($a)]} {
7502             return {}
7503         }
7504         set id $arcend($a)
7505         if {[info exists idtags($id)]} {
7506             return $id
7507         }
7508     }
7509     if {[info exists cached_atags($id)]} {
7510         return $cached_atags($id)
7511     }
7512
7513     set origid $id
7514     set todo [list $id]
7515     set queued($id) 1
7516     set taglist {}
7517     set nc 1
7518     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7519         set id [lindex $todo $i]
7520         set done($id) 1
7521         set td [info exists hastaggeddescendent($id)]
7522         if {!$td} {
7523             incr nc -1
7524         }
7525         # ignore tags on starting node
7526         if {!$td && $i > 0} {
7527             if {[info exists idtags($id)]} {
7528                 set tagloc($id) $id
7529                 set td 1
7530             } elseif {[info exists cached_atags($id)]} {
7531                 set tagloc($id) $cached_atags($id)
7532                 set td 1
7533             }
7534         }
7535         foreach a $arcout($id) {
7536             if {!$td && $arctags($a) ne {}} {
7537                 validate_arctags $a
7538                 if {$arctags($a) ne {}} {
7539                     lappend tagloc($id) [lindex $arctags($a) 0]
7540                 }
7541             }
7542             if {![info exists arcend($a)]} continue
7543             set d $arcend($a)
7544             if {$td || $arctags($a) ne {}} {
7545                 set tomark [list $d]
7546                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7547                     set dd [lindex $tomark $j]
7548                     if {![info exists hastaggeddescendent($dd)]} {
7549                         if {[info exists done($dd)]} {
7550                             foreach b $arcout($dd) {
7551                                 if {[info exists arcend($b)]} {
7552                                     lappend tomark $arcend($b)
7553                                 }
7554                             }
7555                             if {[info exists tagloc($dd)]} {
7556                                 unset tagloc($dd)
7557                             }
7558                         } elseif {[info exists queued($dd)]} {
7559                             incr nc -1
7560                         }
7561                         set hastaggeddescendent($dd) 1
7562                     }
7563                 }
7564             }
7565             if {![info exists queued($d)]} {
7566                 lappend todo $d
7567                 set queued($d) 1
7568                 if {![info exists hastaggeddescendent($d)]} {
7569                     incr nc
7570                 }
7571             }
7572         }
7573     }
7574     set t2 [clock clicks -milliseconds]
7575     set loopix $i
7576     set tags {}
7577     foreach id [array names tagloc] {
7578         if {![info exists hastaggeddescendent($id)]} {
7579             foreach t $tagloc($id) {
7580                 if {[lsearch -exact $tags $t] < 0} {
7581                     lappend tags $t
7582                 }
7583             }
7584         }
7585     }
7586
7587     # remove tags that are ancestors of other tags
7588     for {set i 0} {$i < [llength $tags]} {incr i} {
7589         set a [lindex $tags $i]
7590         for {set j 0} {$j < $i} {incr j} {
7591             set b [lindex $tags $j]
7592             set r [anc_or_desc $a $b]
7593             if {$r == -1} {
7594                 set tags [lreplace $tags $j $j]
7595                 incr j -1
7596                 incr i -1
7597             } elseif {$r == 1} {
7598                 set tags [lreplace $tags $i $i]
7599                 incr i -1
7600                 break
7601             }
7602         }
7603     }
7604
7605     if {[array names growing] ne {}} {
7606         # graph isn't finished, need to check if any tag could get
7607         # eclipsed by another tag coming later.  Simply ignore any
7608         # tags that could later get eclipsed.
7609         set ctags {}
7610         foreach t $tags {
7611             if {[is_certain $origid $t]} {
7612                 lappend ctags $t
7613             }
7614         }
7615         if {$tags eq $ctags} {
7616             set cached_atags($origid) $tags
7617         } else {
7618             set tags $ctags
7619         }
7620     } else {
7621         set cached_atags($origid) $tags
7622     }
7623     set t3 [clock clicks -milliseconds]
7624     if {0 && $t3 - $t1 >= 100} {
7625         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7626             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7627     }
7628     return $tags
7629 }
7630
7631 # Return the list of IDs that have heads that are descendents of id,
7632 # including id itself if it has a head.
7633 proc descheads {id} {
7634     global arcnos arcstart arcids archeads idheads cached_dheads
7635     global allparents
7636
7637     if {![info exists allparents($id)]} {
7638         return {}
7639     }
7640     set aret {}
7641     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7642         # part-way along an arc; check it first
7643         set a [lindex $arcnos($id) 0]
7644         if {$archeads($a) ne {}} {
7645             validate_archeads $a
7646             set i [lsearch -exact $arcids($a) $id]
7647             foreach t $archeads($a) {
7648                 set j [lsearch -exact $arcids($a) $t]
7649                 if {$j > $i} break
7650                 lappend aret $t
7651             }
7652         }
7653         set id $arcstart($a)
7654     }
7655     set origid $id
7656     set todo [list $id]
7657     set seen($id) 1
7658     set ret {}
7659     for {set i 0} {$i < [llength $todo]} {incr i} {
7660         set id [lindex $todo $i]
7661         if {[info exists cached_dheads($id)]} {
7662             set ret [concat $ret $cached_dheads($id)]
7663         } else {
7664             if {[info exists idheads($id)]} {
7665                 lappend ret $id
7666             }
7667             foreach a $arcnos($id) {
7668                 if {$archeads($a) ne {}} {
7669                     validate_archeads $a
7670                     if {$archeads($a) ne {}} {
7671                         set ret [concat $ret $archeads($a)]
7672                     }
7673                 }
7674                 set d $arcstart($a)
7675                 if {![info exists seen($d)]} {
7676                     lappend todo $d
7677                     set seen($d) 1
7678                 }
7679             }
7680         }
7681     }
7682     set ret [lsort -unique $ret]
7683     set cached_dheads($origid) $ret
7684     return [concat $ret $aret]
7685 }
7686
7687 proc addedtag {id} {
7688     global arcnos arcout cached_dtags cached_atags
7689
7690     if {![info exists arcnos($id)]} return
7691     if {![info exists arcout($id)]} {
7692         recalcarc [lindex $arcnos($id) 0]
7693     }
7694     catch {unset cached_dtags}
7695     catch {unset cached_atags}
7696 }
7697
7698 proc addedhead {hid head} {
7699     global arcnos arcout cached_dheads
7700
7701     if {![info exists arcnos($hid)]} return
7702     if {![info exists arcout($hid)]} {
7703         recalcarc [lindex $arcnos($hid) 0]
7704     }
7705     catch {unset cached_dheads}
7706 }
7707
7708 proc removedhead {hid head} {
7709     global cached_dheads
7710
7711     catch {unset cached_dheads}
7712 }
7713
7714 proc movedhead {hid head} {
7715     global arcnos arcout cached_dheads
7716
7717     if {![info exists arcnos($hid)]} return
7718     if {![info exists arcout($hid)]} {
7719         recalcarc [lindex $arcnos($hid) 0]
7720     }
7721     catch {unset cached_dheads}
7722 }
7723
7724 proc changedrefs {} {
7725     global cached_dheads cached_dtags cached_atags
7726     global arctags archeads arcnos arcout idheads idtags
7727
7728     foreach id [concat [array names idheads] [array names idtags]] {
7729         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7730             set a [lindex $arcnos($id) 0]
7731             if {![info exists donearc($a)]} {
7732                 recalcarc $a
7733                 set donearc($a) 1
7734             }
7735         }
7736     }
7737     catch {unset cached_dtags}
7738     catch {unset cached_atags}
7739     catch {unset cached_dheads}
7740 }
7741
7742 proc rereadrefs {} {
7743     global idtags idheads idotherrefs mainhead
7744
7745     set refids [concat [array names idtags] \
7746                     [array names idheads] [array names idotherrefs]]
7747     foreach id $refids {
7748         if {![info exists ref($id)]} {
7749             set ref($id) [listrefs $id]
7750         }
7751     }
7752     set oldmainhead $mainhead
7753     readrefs
7754     changedrefs
7755     set refids [lsort -unique [concat $refids [array names idtags] \
7756                         [array names idheads] [array names idotherrefs]]]
7757     foreach id $refids {
7758         set v [listrefs $id]
7759         if {![info exists ref($id)] || $ref($id) != $v ||
7760             ($id eq $oldmainhead && $id ne $mainhead) ||
7761             ($id eq $mainhead && $id ne $oldmainhead)} {
7762             redrawtags $id
7763         }
7764     }
7765     run refill_reflist
7766 }
7767
7768 proc listrefs {id} {
7769     global idtags idheads idotherrefs
7770
7771     set x {}
7772     if {[info exists idtags($id)]} {
7773         set x $idtags($id)
7774     }
7775     set y {}
7776     if {[info exists idheads($id)]} {
7777         set y $idheads($id)
7778     }
7779     set z {}
7780     if {[info exists idotherrefs($id)]} {
7781         set z $idotherrefs($id)
7782     }
7783     return [list $x $y $z]
7784 }
7785
7786 proc showtag {tag isnew} {
7787     global ctext tagcontents tagids linknum tagobjid
7788
7789     if {$isnew} {
7790         addtohistory [list showtag $tag 0]
7791     }
7792     $ctext conf -state normal
7793     clear_ctext
7794     settabs 0
7795     set linknum 0
7796     if {![info exists tagcontents($tag)]} {
7797         catch {
7798             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7799         }
7800     }
7801     if {[info exists tagcontents($tag)]} {
7802         set text $tagcontents($tag)
7803     } else {
7804         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
7805     }
7806     appendwithlinks $text {}
7807     $ctext conf -state disabled
7808     init_flist {}
7809 }
7810
7811 proc doquit {} {
7812     global stopped
7813     set stopped 100
7814     savestuff .
7815     destroy .
7816 }
7817
7818 proc mkfontdisp {font top which} {
7819     global fontattr fontpref $font
7820
7821     set fontpref($font) [set $font]
7822     button $top.${font}but -text $which -font optionfont \
7823         -command [list choosefont $font $which]
7824     label $top.$font -relief flat -font $font \
7825         -text $fontattr($font,family) -justify left
7826     grid x $top.${font}but $top.$font -sticky w
7827 }
7828
7829 proc choosefont {font which} {
7830     global fontparam fontlist fonttop fontattr
7831
7832     set fontparam(which) $which
7833     set fontparam(font) $font
7834     set fontparam(family) [font actual $font -family]
7835     set fontparam(size) $fontattr($font,size)
7836     set fontparam(weight) $fontattr($font,weight)
7837     set fontparam(slant) $fontattr($font,slant)
7838     set top .gitkfont
7839     set fonttop $top
7840     if {![winfo exists $top]} {
7841         font create sample
7842         eval font config sample [font actual $font]
7843         toplevel $top
7844         wm title $top [mc "Gitk font chooser"]
7845         label $top.l -textvariable fontparam(which)
7846         pack $top.l -side top
7847         set fontlist [lsort [font families]]
7848         frame $top.f
7849         listbox $top.f.fam -listvariable fontlist \
7850             -yscrollcommand [list $top.f.sb set]
7851         bind $top.f.fam <<ListboxSelect>> selfontfam
7852         scrollbar $top.f.sb -command [list $top.f.fam yview]
7853         pack $top.f.sb -side right -fill y
7854         pack $top.f.fam -side left -fill both -expand 1
7855         pack $top.f -side top -fill both -expand 1
7856         frame $top.g
7857         spinbox $top.g.size -from 4 -to 40 -width 4 \
7858             -textvariable fontparam(size) \
7859             -validatecommand {string is integer -strict %s}
7860         checkbutton $top.g.bold -padx 5 \
7861             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7862             -variable fontparam(weight) -onvalue bold -offvalue normal
7863         checkbutton $top.g.ital -padx 5 \
7864             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
7865             -variable fontparam(slant) -onvalue italic -offvalue roman
7866         pack $top.g.size $top.g.bold $top.g.ital -side left
7867         pack $top.g -side top
7868         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7869             -background white
7870         $top.c create text 100 25 -anchor center -text $which -font sample \
7871             -fill black -tags text
7872         bind $top.c <Configure> [list centertext $top.c]
7873         pack $top.c -side top -fill x
7874         frame $top.buts
7875         button $top.buts.ok -text [mc "OK"] -command fontok -default active
7876         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7877         grid $top.buts.ok $top.buts.can
7878         grid columnconfigure $top.buts 0 -weight 1 -uniform a
7879         grid columnconfigure $top.buts 1 -weight 1 -uniform a
7880         pack $top.buts -side bottom -fill x
7881         trace add variable fontparam write chg_fontparam
7882     } else {
7883         raise $top
7884         $top.c itemconf text -text $which
7885     }
7886     set i [lsearch -exact $fontlist $fontparam(family)]
7887     if {$i >= 0} {
7888         $top.f.fam selection set $i
7889         $top.f.fam see $i
7890     }
7891 }
7892
7893 proc centertext {w} {
7894     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7895 }
7896
7897 proc fontok {} {
7898     global fontparam fontpref prefstop
7899
7900     set f $fontparam(font)
7901     set fontpref($f) [list $fontparam(family) $fontparam(size)]
7902     if {$fontparam(weight) eq "bold"} {
7903         lappend fontpref($f) "bold"
7904     }
7905     if {$fontparam(slant) eq "italic"} {
7906         lappend fontpref($f) "italic"
7907     }
7908     set w $prefstop.$f
7909     $w conf -text $fontparam(family) -font $fontpref($f)
7910         
7911     fontcan
7912 }
7913
7914 proc fontcan {} {
7915     global fonttop fontparam
7916
7917     if {[info exists fonttop]} {
7918         catch {destroy $fonttop}
7919         catch {font delete sample}
7920         unset fonttop
7921         unset fontparam
7922     }
7923 }
7924
7925 proc selfontfam {} {
7926     global fonttop fontparam
7927
7928     set i [$fonttop.f.fam curselection]
7929     if {$i ne {}} {
7930         set fontparam(family) [$fonttop.f.fam get $i]
7931     }
7932 }
7933
7934 proc chg_fontparam {v sub op} {
7935     global fontparam
7936
7937     font config sample -$sub $fontparam($sub)
7938 }
7939
7940 proc doprefs {} {
7941     global maxwidth maxgraphpct
7942     global oldprefs prefstop showneartags showlocalchanges
7943     global bgcolor fgcolor ctext diffcolors selectbgcolor
7944     global tabstop limitdiffs
7945
7946     set top .gitkprefs
7947     set prefstop $top
7948     if {[winfo exists $top]} {
7949         raise $top
7950         return
7951     }
7952     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7953                    limitdiffs tabstop} {
7954         set oldprefs($v) [set $v]
7955     }
7956     toplevel $top
7957     wm title $top [mc "Gitk preferences"]
7958     label $top.ldisp -text [mc "Commit list display options"]
7959     grid $top.ldisp - -sticky w -pady 10
7960     label $top.spacer -text " "
7961     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7962         -font optionfont
7963     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7964     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7965     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7966         -font optionfont
7967     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7968     grid x $top.maxpctl $top.maxpct -sticky w
7969     frame $top.showlocal
7970     label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7971     checkbutton $top.showlocal.b -variable showlocalchanges
7972     pack $top.showlocal.b $top.showlocal.l -side left
7973     grid x $top.showlocal -sticky w
7974
7975     label $top.ddisp -text [mc "Diff display options"]
7976     grid $top.ddisp - -sticky w -pady 10
7977     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7978     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7979     grid x $top.tabstopl $top.tabstop -sticky w
7980     frame $top.ntag
7981     label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7982     checkbutton $top.ntag.b -variable showneartags
7983     pack $top.ntag.b $top.ntag.l -side left
7984     grid x $top.ntag -sticky w
7985     frame $top.ldiff
7986     label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7987     checkbutton $top.ldiff.b -variable limitdiffs
7988     pack $top.ldiff.b $top.ldiff.l -side left
7989     grid x $top.ldiff -sticky w
7990
7991     label $top.cdisp -text [mc "Colors: press to choose"]
7992     grid $top.cdisp - -sticky w -pady 10
7993     label $top.bg -padx 40 -relief sunk -background $bgcolor
7994     button $top.bgbut -text [mc "Background"] -font optionfont \
7995         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7996     grid x $top.bgbut $top.bg -sticky w
7997     label $top.fg -padx 40 -relief sunk -background $fgcolor
7998     button $top.fgbut -text [mc "Foreground"] -font optionfont \
7999         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8000     grid x $top.fgbut $top.fg -sticky w
8001     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8002     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8003         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8004                       [list $ctext tag conf d0 -foreground]]
8005     grid x $top.diffoldbut $top.diffold -sticky w
8006     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8007     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8008         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8009                       [list $ctext tag conf d1 -foreground]]
8010     grid x $top.diffnewbut $top.diffnew -sticky w
8011     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8012     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8013         -command [list choosecolor diffcolors 2 $top.hunksep \
8014                       "diff hunk header" \
8015                       [list $ctext tag conf hunksep -foreground]]
8016     grid x $top.hunksepbut $top.hunksep -sticky w
8017     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8018     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8019         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8020     grid x $top.selbgbut $top.selbgsep -sticky w
8021
8022     label $top.cfont -text [mc "Fonts: press to choose"]
8023     grid $top.cfont - -sticky w -pady 10
8024     mkfontdisp mainfont $top [mc "Main font"]
8025     mkfontdisp textfont $top [mc "Diff display font"]
8026     mkfontdisp uifont $top [mc "User interface font"]
8027
8028     frame $top.buts
8029     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8030     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8031     grid $top.buts.ok $top.buts.can
8032     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8033     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8034     grid $top.buts - - -pady 10 -sticky ew
8035     bind $top <Visibility> "focus $top.buts.ok"
8036 }
8037
8038 proc choosecolor {v vi w x cmd} {
8039     global $v
8040
8041     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8042                -title [mc "Gitk: choose color for %s" $x]]
8043     if {$c eq {}} return
8044     $w conf -background $c
8045     lset $v $vi $c
8046     eval $cmd $c
8047 }
8048
8049 proc setselbg {c} {
8050     global bglist cflist
8051     foreach w $bglist {
8052         $w configure -selectbackground $c
8053     }
8054     $cflist tag configure highlight \
8055         -background [$cflist cget -selectbackground]
8056     allcanvs itemconf secsel -fill $c
8057 }
8058
8059 proc setbg {c} {
8060     global bglist
8061
8062     foreach w $bglist {
8063         $w conf -background $c
8064     }
8065 }
8066
8067 proc setfg {c} {
8068     global fglist canv
8069
8070     foreach w $fglist {
8071         $w conf -foreground $c
8072     }
8073     allcanvs itemconf text -fill $c
8074     $canv itemconf circle -outline $c
8075 }
8076
8077 proc prefscan {} {
8078     global oldprefs prefstop
8079
8080     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8081                    limitdiffs tabstop} {
8082         global $v
8083         set $v $oldprefs($v)
8084     }
8085     catch {destroy $prefstop}
8086     unset prefstop
8087     fontcan
8088 }
8089
8090 proc prefsok {} {
8091     global maxwidth maxgraphpct
8092     global oldprefs prefstop showneartags showlocalchanges
8093     global fontpref mainfont textfont uifont
8094     global limitdiffs treediffs
8095
8096     catch {destroy $prefstop}
8097     unset prefstop
8098     fontcan
8099     set fontchanged 0
8100     if {$mainfont ne $fontpref(mainfont)} {
8101         set mainfont $fontpref(mainfont)
8102         parsefont mainfont $mainfont
8103         eval font configure mainfont [fontflags mainfont]
8104         eval font configure mainfontbold [fontflags mainfont 1]
8105         setcoords
8106         set fontchanged 1
8107     }
8108     if {$textfont ne $fontpref(textfont)} {
8109         set textfont $fontpref(textfont)
8110         parsefont textfont $textfont
8111         eval font configure textfont [fontflags textfont]
8112         eval font configure textfontbold [fontflags textfont 1]
8113     }
8114     if {$uifont ne $fontpref(uifont)} {
8115         set uifont $fontpref(uifont)
8116         parsefont uifont $uifont
8117         eval font configure uifont [fontflags uifont]
8118     }
8119     settabs
8120     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8121         if {$showlocalchanges} {
8122             doshowlocalchanges
8123         } else {
8124             dohidelocalchanges
8125         }
8126     }
8127     if {$limitdiffs != $oldprefs(limitdiffs)} {
8128         # treediffs elements are limited by path
8129         catch {unset treediffs}
8130     }
8131     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8132         || $maxgraphpct != $oldprefs(maxgraphpct)} {
8133         redisplay
8134     } elseif {$showneartags != $oldprefs(showneartags) ||
8135           $limitdiffs != $oldprefs(limitdiffs)} {
8136         reselectline
8137     }
8138 }
8139
8140 proc formatdate {d} {
8141     global datetimeformat
8142     if {$d ne {}} {
8143         set d [clock format $d -format $datetimeformat]
8144     }
8145     return $d
8146 }
8147
8148 # This list of encoding names and aliases is distilled from
8149 # http://www.iana.org/assignments/character-sets.
8150 # Not all of them are supported by Tcl.
8151 set encoding_aliases {
8152     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8153       ISO646-US US-ASCII us IBM367 cp367 csASCII }
8154     { ISO-10646-UTF-1 csISO10646UTF1 }
8155     { ISO_646.basic:1983 ref csISO646basic1983 }
8156     { INVARIANT csINVARIANT }
8157     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8158     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8159     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8160     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8161     { NATS-DANO iso-ir-9-1 csNATSDANO }
8162     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8163     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8164     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8165     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8166     { ISO-2022-KR csISO2022KR }
8167     { EUC-KR csEUCKR }
8168     { ISO-2022-JP csISO2022JP }
8169     { ISO-2022-JP-2 csISO2022JP2 }
8170     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8171       csISO13JISC6220jp }
8172     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8173     { IT iso-ir-15 ISO646-IT csISO15Italian }
8174     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8175     { ES iso-ir-17 ISO646-ES csISO17Spanish }
8176     { greek7-old iso-ir-18 csISO18Greek7Old }
8177     { latin-greek iso-ir-19 csISO19LatinGreek }
8178     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8179     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8180     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8181     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8182     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8183     { BS_viewdata iso-ir-47 csISO47BSViewdata }
8184     { INIS iso-ir-49 csISO49INIS }
8185     { INIS-8 iso-ir-50 csISO50INIS8 }
8186     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8187     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8188     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8189     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8190     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8191     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8192       csISO60Norwegian1 }
8193     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8194     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8195     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8196     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8197     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8198     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8199     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8200     { greek7 iso-ir-88 csISO88Greek7 }
8201     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8202     { iso-ir-90 csISO90 }
8203     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8204     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8205       csISO92JISC62991984b }
8206     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8207     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8208     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8209       csISO95JIS62291984handadd }
8210     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8211     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8212     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8213     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8214       CP819 csISOLatin1 }
8215     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8216     { T.61-7bit iso-ir-102 csISO102T617bit }
8217     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8218     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8219     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8220     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8221     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8222     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8223     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8224     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8225       arabic csISOLatinArabic }
8226     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8227     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8228     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8229       greek greek8 csISOLatinGreek }
8230     { T.101-G2 iso-ir-128 csISO128T101G2 }
8231     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8232       csISOLatinHebrew }
8233     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8234     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8235     { CSN_369103 iso-ir-139 csISO139CSN369103 }
8236     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8237     { ISO_6937-2-add iso-ir-142 csISOTextComm }
8238     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8239     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8240       csISOLatinCyrillic }
8241     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8242     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8243     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8244     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8245     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8246     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8247     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8248     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8249     { ISO_10367-box iso-ir-155 csISO10367Box }
8250     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8251     { latin-lap lap iso-ir-158 csISO158Lap }
8252     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8253     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8254     { us-dk csUSDK }
8255     { dk-us csDKUS }
8256     { JIS_X0201 X0201 csHalfWidthKatakana }
8257     { KSC5636 ISO646-KR csKSC5636 }
8258     { ISO-10646-UCS-2 csUnicode }
8259     { ISO-10646-UCS-4 csUCS4 }
8260     { DEC-MCS dec csDECMCS }
8261     { hp-roman8 roman8 r8 csHPRoman8 }
8262     { macintosh mac csMacintosh }
8263     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8264       csIBM037 }
8265     { IBM038 EBCDIC-INT cp038 csIBM038 }
8266     { IBM273 CP273 csIBM273 }
8267     { IBM274 EBCDIC-BE CP274 csIBM274 }
8268     { IBM275 EBCDIC-BR cp275 csIBM275 }
8269     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8270     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8271     { IBM280 CP280 ebcdic-cp-it csIBM280 }
8272     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8273     { IBM284 CP284 ebcdic-cp-es csIBM284 }
8274     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8275     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8276     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8277     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8278     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8279     { IBM424 cp424 ebcdic-cp-he csIBM424 }
8280     { IBM437 cp437 437 csPC8CodePage437 }
8281     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8282     { IBM775 cp775 csPC775Baltic }
8283     { IBM850 cp850 850 csPC850Multilingual }
8284     { IBM851 cp851 851 csIBM851 }
8285     { IBM852 cp852 852 csPCp852 }
8286     { IBM855 cp855 855 csIBM855 }
8287     { IBM857 cp857 857 csIBM857 }
8288     { IBM860 cp860 860 csIBM860 }
8289     { IBM861 cp861 861 cp-is csIBM861 }
8290     { IBM862 cp862 862 csPC862LatinHebrew }
8291     { IBM863 cp863 863 csIBM863 }
8292     { IBM864 cp864 csIBM864 }
8293     { IBM865 cp865 865 csIBM865 }
8294     { IBM866 cp866 866 csIBM866 }
8295     { IBM868 CP868 cp-ar csIBM868 }
8296     { IBM869 cp869 869 cp-gr csIBM869 }
8297     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8298     { IBM871 CP871 ebcdic-cp-is csIBM871 }
8299     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8300     { IBM891 cp891 csIBM891 }
8301     { IBM903 cp903 csIBM903 }
8302     { IBM904 cp904 904 csIBBM904 }
8303     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8304     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8305     { IBM1026 CP1026 csIBM1026 }
8306     { EBCDIC-AT-DE csIBMEBCDICATDE }
8307     { EBCDIC-AT-DE-A csEBCDICATDEA }
8308     { EBCDIC-CA-FR csEBCDICCAFR }
8309     { EBCDIC-DK-NO csEBCDICDKNO }
8310     { EBCDIC-DK-NO-A csEBCDICDKNOA }
8311     { EBCDIC-FI-SE csEBCDICFISE }
8312     { EBCDIC-FI-SE-A csEBCDICFISEA }
8313     { EBCDIC-FR csEBCDICFR }
8314     { EBCDIC-IT csEBCDICIT }
8315     { EBCDIC-PT csEBCDICPT }
8316     { EBCDIC-ES csEBCDICES }
8317     { EBCDIC-ES-A csEBCDICESA }
8318     { EBCDIC-ES-S csEBCDICESS }
8319     { EBCDIC-UK csEBCDICUK }
8320     { EBCDIC-US csEBCDICUS }
8321     { UNKNOWN-8BIT csUnknown8BiT }
8322     { MNEMONIC csMnemonic }
8323     { MNEM csMnem }
8324     { VISCII csVISCII }
8325     { VIQR csVIQR }
8326     { KOI8-R csKOI8R }
8327     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8328     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8329     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8330     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8331     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8332     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8333     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8334     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8335     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8336     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8337     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8338     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8339     { IBM1047 IBM-1047 }
8340     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8341     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8342     { UNICODE-1-1 csUnicode11 }
8343     { CESU-8 csCESU-8 }
8344     { BOCU-1 csBOCU-1 }
8345     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8346     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8347       l8 }
8348     { ISO-8859-15 ISO_8859-15 Latin-9 }
8349     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8350     { GBK CP936 MS936 windows-936 }
8351     { JIS_Encoding csJISEncoding }
8352     { Shift_JIS MS_Kanji csShiftJIS }
8353     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8354       EUC-JP }
8355     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8356     { ISO-10646-UCS-Basic csUnicodeASCII }
8357     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8358     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8359     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8360     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8361     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8362     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8363     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8364     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8365     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8366     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8367     { Adobe-Standard-Encoding csAdobeStandardEncoding }
8368     { Ventura-US csVenturaUS }
8369     { Ventura-International csVenturaInternational }
8370     { PC8-Danish-Norwegian csPC8DanishNorwegian }
8371     { PC8-Turkish csPC8Turkish }
8372     { IBM-Symbols csIBMSymbols }
8373     { IBM-Thai csIBMThai }
8374     { HP-Legal csHPLegal }
8375     { HP-Pi-font csHPPiFont }
8376     { HP-Math8 csHPMath8 }
8377     { Adobe-Symbol-Encoding csHPPSMath }
8378     { HP-DeskTop csHPDesktop }
8379     { Ventura-Math csVenturaMath }
8380     { Microsoft-Publishing csMicrosoftPublishing }
8381     { Windows-31J csWindows31J }
8382     { GB2312 csGB2312 }
8383     { Big5 csBig5 }
8384 }
8385
8386 proc tcl_encoding {enc} {
8387     global encoding_aliases
8388     set names [encoding names]
8389     set lcnames [string tolower $names]
8390     set enc [string tolower $enc]
8391     set i [lsearch -exact $lcnames $enc]
8392     if {$i < 0} {
8393         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8394         if {[regsub {^iso[-_]} $enc iso encx]} {
8395             set i [lsearch -exact $lcnames $encx]
8396         }
8397     }
8398     if {$i < 0} {
8399         foreach l $encoding_aliases {
8400             set ll [string tolower $l]
8401             if {[lsearch -exact $ll $enc] < 0} continue
8402             # look through the aliases for one that tcl knows about
8403             foreach e $ll {
8404                 set i [lsearch -exact $lcnames $e]
8405                 if {$i < 0} {
8406                     if {[regsub {^iso[-_]} $e iso ex]} {
8407                         set i [lsearch -exact $lcnames $ex]
8408                     }
8409                 }
8410                 if {$i >= 0} break
8411             }
8412             break
8413         }
8414     }
8415     if {$i >= 0} {
8416         return [lindex $names $i]
8417     }
8418     return {}
8419 }
8420
8421 # First check that Tcl/Tk is recent enough
8422 if {[catch {package require Tk 8.4} err]} {
8423     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8424                      Gitk requires at least Tcl/Tk 8.4."]
8425     exit 1
8426 }
8427
8428 # defaults...
8429 set datemode 0
8430 set wrcomcmd "git diff-tree --stdin -p --pretty"
8431
8432 set gitencoding {}
8433 catch {
8434     set gitencoding [exec git config --get i18n.commitencoding]
8435 }
8436 if {$gitencoding == ""} {
8437     set gitencoding "utf-8"
8438 }
8439 set tclencoding [tcl_encoding $gitencoding]
8440 if {$tclencoding == {}} {
8441     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8442 }
8443
8444 set mainfont {Helvetica 9}
8445 set textfont {Courier 9}
8446 set uifont {Helvetica 9 bold}
8447 set tabstop 8
8448 set findmergefiles 0
8449 set maxgraphpct 50
8450 set maxwidth 16
8451 set revlistorder 0
8452 set fastdate 0
8453 set uparrowlen 5
8454 set downarrowlen 5
8455 set mingaplen 100
8456 set cmitmode "patch"
8457 set wrapcomment "none"
8458 set showneartags 1
8459 set maxrefs 20
8460 set maxlinelen 200
8461 set showlocalchanges 1
8462 set limitdiffs 1
8463 set datetimeformat "%Y-%m-%d %H:%M:%S"
8464
8465 set colors {green red blue magenta darkgrey brown orange}
8466 set bgcolor white
8467 set fgcolor black
8468 set diffcolors {red "#00a000" blue}
8469 set diffcontext 3
8470 set ignorespace 0
8471 set selectbgcolor gray85
8472
8473 ## For msgcat loading, first locate the installation location.
8474 if { [info exists ::env(GITK_MSGSDIR)] } {
8475     ## Msgsdir was manually set in the environment.
8476     set gitk_msgsdir $::env(GITK_MSGSDIR)
8477 } else {
8478     ## Let's guess the prefix from argv0.
8479     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8480     set gitk_libdir [file join $gitk_prefix share gitk lib]
8481     set gitk_msgsdir [file join $gitk_libdir msgs]
8482     unset gitk_prefix
8483 }
8484
8485 ## Internationalization (i18n) through msgcat and gettext. See
8486 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8487 package require msgcat
8488 namespace import ::msgcat::mc
8489 ## And eventually load the actual message catalog
8490 ::msgcat::mcload $gitk_msgsdir
8491
8492 catch {source ~/.gitk}
8493
8494 font create optionfont -family sans-serif -size -12
8495
8496 parsefont mainfont $mainfont
8497 eval font create mainfont [fontflags mainfont]
8498 eval font create mainfontbold [fontflags mainfont 1]
8499
8500 parsefont textfont $textfont
8501 eval font create textfont [fontflags textfont]
8502 eval font create textfontbold [fontflags textfont 1]
8503
8504 parsefont uifont $uifont
8505 eval font create uifont [fontflags uifont]
8506
8507 setoptions
8508
8509 # check that we can find a .git directory somewhere...
8510 if {[catch {set gitdir [gitdir]}]} {
8511     show_error {} . [mc "Cannot find a git repository here."]
8512     exit 1
8513 }
8514 if {![file isdirectory $gitdir]} {
8515     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8516     exit 1
8517 }
8518
8519 set mergeonly 0
8520 set revtreeargs {}
8521 set cmdline_files {}
8522 set i 0
8523 foreach arg $argv {
8524     switch -- $arg {
8525         "" { }
8526         "-d" { set datemode 1 }
8527         "--merge" {
8528             set mergeonly 1
8529             lappend revtreeargs $arg
8530         }
8531         "--" {
8532             set cmdline_files [lrange $argv [expr {$i + 1}] end]
8533             break
8534         }
8535         default {
8536             lappend revtreeargs $arg
8537         }
8538     }
8539     incr i
8540 }
8541
8542 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8543     # no -- on command line, but some arguments (other than -d)
8544     if {[catch {
8545         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8546         set cmdline_files [split $f "\n"]
8547         set n [llength $cmdline_files]
8548         set revtreeargs [lrange $revtreeargs 0 end-$n]
8549         # Unfortunately git rev-parse doesn't produce an error when
8550         # something is both a revision and a filename.  To be consistent
8551         # with git log and git rev-list, check revtreeargs for filenames.
8552         foreach arg $revtreeargs {
8553             if {[file exists $arg]} {
8554                 show_error {} . [mc "Ambiguous argument '%s': both revision\
8555                                  and filename" $arg]
8556                 exit 1
8557             }
8558         }
8559     } err]} {
8560         # unfortunately we get both stdout and stderr in $err,
8561         # so look for "fatal:".
8562         set i [string first "fatal:" $err]
8563         if {$i > 0} {
8564             set err [string range $err [expr {$i + 6}] end]
8565         }
8566         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8567         exit 1
8568     }
8569 }
8570
8571 if {$mergeonly} {
8572     # find the list of unmerged files
8573     set mlist {}
8574     set nr_unmerged 0
8575     if {[catch {
8576         set fd [open "| git ls-files -u" r]
8577     } err]} {
8578         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8579         exit 1
8580     }
8581     while {[gets $fd line] >= 0} {
8582         set i [string first "\t" $line]
8583         if {$i < 0} continue
8584         set fname [string range $line [expr {$i+1}] end]
8585         if {[lsearch -exact $mlist $fname] >= 0} continue
8586         incr nr_unmerged
8587         if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8588             lappend mlist $fname
8589         }
8590     }
8591     catch {close $fd}
8592     if {$mlist eq {}} {
8593         if {$nr_unmerged == 0} {
8594             show_error {} . [mc "No files selected: --merge specified but\
8595                              no files are unmerged."]
8596         } else {
8597             show_error {} . [mc "No files selected: --merge specified but\
8598                              no unmerged files are within file limit."]
8599         }
8600         exit 1
8601     }
8602     set cmdline_files $mlist
8603 }
8604
8605 set nullid "0000000000000000000000000000000000000000"
8606 set nullid2 "0000000000000000000000000000000000000001"
8607
8608 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8609
8610 set runq {}
8611 set history {}
8612 set historyindex 0
8613 set fh_serial 0
8614 set nhl_names {}
8615 set highlight_paths {}
8616 set findpattern {}
8617 set searchdirn -forwards
8618 set boldrows {}
8619 set boldnamerows {}
8620 set diffelide {0 0}
8621 set markingmatches 0
8622 set linkentercount 0
8623 set need_redisplay 0
8624 set nrows_drawn 0
8625 set firsttabstop 0
8626
8627 set nextviewnum 1
8628 set curview 0
8629 set selectedview 0
8630 set selectedhlview [mc "None"]
8631 set highlight_related [mc "None"]
8632 set highlight_files {}
8633 set viewfiles(0) {}
8634 set viewperm(0) 0
8635 set viewargs(0) {}
8636
8637 set cmdlineok 0
8638 set stopped 0
8639 set stuffsaved 0
8640 set patchnum 0
8641 set localirow -1
8642 set localfrow -1
8643 set lserial 0
8644 setcoords
8645 makewindow
8646 # wait for the window to become visible
8647 tkwait visibility .
8648 wm title . "[file tail $argv0]: [file tail [pwd]]"
8649 readrefs
8650
8651 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8652     # create a view for the files/dirs specified on the command line
8653     set curview 1
8654     set selectedview 1
8655     set nextviewnum 2
8656     set viewname(1) [mc "Command line"]
8657     set viewfiles(1) $cmdline_files
8658     set viewargs(1) $revtreeargs
8659     set viewperm(1) 0
8660     addviewmenu 1
8661     .bar.view entryconf [mc "Edit view..."] -state normal
8662     .bar.view entryconf [mc "Delete view"] -state normal
8663 }
8664
8665 if {[info exists permviews]} {
8666     foreach v $permviews {
8667         set n $nextviewnum
8668         incr nextviewnum
8669         set viewname($n) [lindex $v 0]
8670         set viewfiles($n) [lindex $v 1]
8671         set viewargs($n) [lindex $v 2]
8672         set viewperm($n) 1
8673         addviewmenu $n
8674     }
8675 }
8676 getcommits