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