Code

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