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