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