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