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