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