2 # Tcl ignores the next line -*- tcl -*- \
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.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
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.
28 if {[info exists isonrunq
($script)]} return
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 set tstart
[clock clicks
-milliseconds]
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]
68 fileevent
$fd readable
[list filereadable
$fd $script]
70 } elseif
{$fd eq
{}} {
71 unset isonrunq
($script)
74 if {$t1 - $tstart >= 80} break
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list
{view
} {
84 global commfd leftover tclencoding datemode
85 global viewargs viewargscmd 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 args
$viewargs($view)
94 if {$viewargscmd($view) ne
{}} {
96 set str
[exec sh
-c $viewargscmd($view)]
98 error_popup
"Error executing --argscmd command: $err"
101 set args
[concat
$args [split $str "\n"]]
103 set order
"--topo-order"
105 set order
"--date-order"
108 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$order --parents \
109 --boundary $args "--" $viewfiles($view)] r
]
111 error_popup
"[mc "Error executing git rev-list
:"] $err"
114 set commfd
($view) $fd
115 set leftover
($view) {}
116 if {$showlocalchanges} {
117 lappend commitinterest
($mainheadid) {dodiffindex
}
119 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
120 if {$tclencoding != {}} {
121 fconfigure
$fd -encoding $tclencoding
123 filerun
$fd [list getcommitlines
$fd $view]
124 nowbusy
$view [mc
"Reading"]
125 if {$view == $curview} {
127 set progresscoords
{0 0}
132 proc stop_rev_list
{} {
133 global commfd curview
135 if {![info exists commfd
($curview)]} return
136 set fd
$commfd($curview)
142 unset commfd
($curview)
146 global phase canv curview
150 start_rev_list
$curview
151 show_status
[mc
"Reading commits..."]
154 # This makes a string representation of a positive integer which
155 # sorts as a string in numerical order
158 return [format
"%x" $n]
159 } elseif
{$n < 256} {
160 return [format
"x%.2x" $n]
161 } elseif
{$n < 65536} {
162 return [format
"y%.4x" $n]
164 return [format
"z%.8x" $n]
167 proc getcommitlines
{fd view
} {
168 global commitlisted commitinterest
169 global leftover commfd
170 global displayorder commitidx viewcomplete commitrow commitdata
171 global parentlist children curview hlview
172 global vparentlist vdisporder vcmitlisted
173 global ordertok vnextroot idpending
175 set stuff
[read $fd 500000]
176 # git log doesn't terminate the last commit with a null...
177 if {$stuff == {} && $leftover($view) ne
{} && [eof
$fd]} {
184 # Check if we have seen any ids listed as parents that haven't
185 # appeared in the list
186 foreach vid
[array names idpending
"$view,*"] {
187 # should only get here if git log is buggy
188 set id
[lindex
[split $vid ","] 1]
189 set commitrow
($vid) $commitidx($view)
190 incr commitidx
($view)
191 if {$view == $curview} {
192 lappend parentlist
{}
193 lappend displayorder
$id
194 lappend commitlisted
0
196 lappend vparentlist
($view) {}
197 lappend vdisporder
($view) $id
198 lappend vcmitlisted
($view) 0
201 set viewcomplete
($view) 1
202 global viewname progresscoords
205 set progresscoords
{0 0}
207 # set it blocking so we wait for the process to terminate
208 fconfigure
$fd -blocking 1
209 if {[catch
{close
$fd} err
]} {
211 if {$view != $curview} {
212 set fv
" for the \"$viewname($view)\" view"
214 if {[string range
$err 0 4] == "usage"} {
215 set err
"Gitk: error reading commits$fv:\
216 bad arguments to git rev-list."
217 if {$viewname($view) eq
"Command line"} {
219 " (Note: arguments to gitk are passed to git rev-list\
220 to allow selection of commits to be displayed.)"
223 set err
"Error reading commits$fv: $err"
227 if {$view == $curview} {
228 run chewcommits
$view
235 set i
[string first
"\0" $stuff $start]
237 append leftover
($view) [string range
$stuff $start end
]
241 set cmit
$leftover($view)
242 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
243 set leftover
($view) {}
245 set cmit
[string range
$stuff $start [expr {$i - 1}]]
247 set start
[expr {$i + 1}]
248 set j
[string first
"\n" $cmit]
251 if {$j >= 0 && [string match
"commit *" $cmit]} {
252 set ids
[string range
$cmit 7 [expr {$j - 1}]]
253 if {[string match
{[-^
<>]*} $ids]} {
254 switch
-- [string index
$ids 0] {
260 set ids
[string range
$ids 1 end
]
264 if {[string length
$id] != 40} {
272 if {[string length
$shortcmit] > 80} {
273 set shortcmit
"[string range $shortcmit 0 80]..."
275 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
278 set id [lindex $ids 0]
279 if {![info exists ordertok($view,$id)]} {
280 set otok "o[strrep $vnextroot($view)]"
281 incr vnextroot($view)
282 set ordertok($view,$id) $otok
284 set otok $ordertok($view,$id)
285 unset idpending($view,$id)
288 set olds [lrange $ids 1 end]
289 if {[llength $olds] == 1} {
290 set p [lindex $olds 0]
291 lappend children($view,$p) $id
292 if {![info exists ordertok($view,$p)]} {
293 set ordertok($view,$p) $ordertok($view,$id)
294 set idpending($view,$p) 1
299 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
300 lappend children($view,$p) $id
302 if {![info exists ordertok($view,$p)]} {
303 set ordertok($view,$p) "$otok[strrep $i]]"
304 set idpending($view,$p) 1
312 if {![info exists children($view,$id)]} {
313 set children($view,$id) {}
315 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
316 set commitrow($view,$id) $commitidx($view)
317 incr commitidx($view)
318 if {$view == $curview} {
319 lappend parentlist $olds
320 lappend displayorder $id
321 lappend commitlisted $listed
323 lappend vparentlist($view) $olds
324 lappend vdisporder($view) $id
325 lappend vcmitlisted($view) $listed
327 if {[info exists commitinterest($id)]} {
328 foreach script $commitinterest($id) {
329 eval [string map [list "%I" $id] $script]
331 unset commitinterest($id)
336 run chewcommits $view
337 if {$view == $curview} {
338 # update progress bar
339 global progressdirn progresscoords proglastnc
340 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
341 set proglastnc $commitidx($view)
342 set l [lindex $progresscoords 0]
343 set r [lindex $progresscoords 1]
345 set r [expr {$r + $inc}]
351 set l [expr {$r - 0.2}]
354 set l [expr {$l - $inc}]
359 set r [expr {$l + 0.2}]
361 set progresscoords [list $l $r]
368 proc chewcommits {view} {
369 global curview hlview viewcomplete
370 global selectedline pending_select
372 if {$view == $curview} {
374 if {$viewcomplete($view)} {
375 global displayorder commitidx phase
376 global numcommits startmsecs
378 if {[info exists pending_select]} {
379 set row [first_real_row]
382 if {$commitidx($curview) > 0} {
383 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
384 #puts "overall $ms ms for $numcommits commits"
386 show_status [mc "No commits selected"]
392 if {[info exists hlview] && $view == $hlview} {
398 proc readcommit {id} {
399 if {[catch {set contents [exec git cat-file commit $id]}]} return
400 parsecommit $id $contents 0
403 proc updatecommits {} {
404 global viewdata curview phase displayorder ordertok idpending
405 global children commitrow selectedline thickerline showneartags
408 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
415 foreach id $displayorder {
416 catch {unset children($n,$id)}
417 catch {unset commitrow($n,$id)}
418 catch {unset ordertok($n,$id)}
420 foreach vid [array names idpending "$n,*"] {
421 unset idpending($vid)
424 catch {unset selectedline}
425 catch {unset thickerline}
426 catch {unset viewdata($n)}
435 proc parsecommit {id contents listed} {
436 global commitinfo cdate
445 set hdrend [string first "\n\n" $contents]
447 # should never happen...
448 set hdrend [string length $contents]
450 set header [string range $contents 0 [expr {$hdrend - 1}]]
451 set comment [string range $contents [expr {$hdrend + 2}] end]
452 foreach line [split $header "\n"] {
453 set tag [lindex $line 0]
454 if {$tag == "author"} {
455 set audate [lindex $line end-1]
456 set auname [lrange $line 1 end-2]
457 } elseif {$tag == "committer"} {
458 set comdate [lindex $line end-1]
459 set comname [lrange $line 1 end-2]
463 # take the first non-blank line of the comment as the headline
464 set headline [string trimleft $comment]
465 set i [string first "\n" $headline]
467 set headline [string range $headline 0 $i]
469 set headline [string trimright $headline]
470 set i [string first "\r" $headline]
472 set headline [string trimright [string range $headline 0 $i]]
475 # git rev-list indents the comment by 4 spaces;
476 # if we got this via git cat-file, add the indentation
478 foreach line [split $comment "\n"] {
479 append newcomment " "
480 append newcomment $line
481 append newcomment "\n"
483 set comment $newcomment
485 if {$comdate != {}} {
486 set cdate($id) $comdate
488 set commitinfo($id) [list $headline $auname $audate \
489 $comname $comdate $comment]
492 proc getcommit {id} {
493 global commitdata commitinfo
495 if {[info exists commitdata($id)]} {
496 parsecommit $id $commitdata($id) 1
499 if {![info exists commitinfo($id)]} {
500 set commitinfo($id) [list [mc "No commit information available"]]
507 global tagids idtags headids idheads tagobjid
508 global otherrefids idotherrefs mainhead mainheadid
510 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
513 set refd [open [list | git show-ref -d] r]
514 while {[gets $refd line] >= 0} {
515 if {[string index $line 40] ne " "} continue
516 set id [string range $line 0 39]
517 set ref [string range $line 41 end]
518 if {![string match "refs/*" $ref]} continue
519 set name [string range $ref 5 end]
520 if {[string match "remotes/*" $name]} {
521 if {![string match "*/HEAD" $name]} {
522 set headids($name) $id
523 lappend idheads($id) $name
525 } elseif {[string match "heads/*" $name]} {
526 set name [string range $name 6 end]
527 set headids($name) $id
528 lappend idheads($id) $name
529 } elseif {[string match "tags/*" $name]} {
530 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
531 # which is what we want since the former is the commit ID
532 set name [string range $name 5 end]
533 if {[string match "*^{}" $name]} {
534 set name [string range $name 0 end-3]
536 set tagobjid($name) $id
538 set tagids($name) $id
539 lappend idtags($id) $name
541 set otherrefids($name) $id
542 lappend idotherrefs($id) $name
549 set thehead [exec git symbolic-ref HEAD]
550 if {[string match "refs/heads/*" $thehead]} {
551 set mainhead [string range $thehead 11 end]
552 if {[info exists headids($mainhead)]} {
553 set mainheadid $headids($mainhead)
559 # skip over fake commits
560 proc first_real_row {} {
561 global nullid nullid2 displayorder numcommits
563 for {set row 0} {$row < $numcommits} {incr row} {
564 set id [lindex $displayorder $row]
565 if {$id ne $nullid && $id ne $nullid2} {
572 # update things for a head moved to a child of its previous location
573 proc movehead {id name} {
574 global headids idheads
576 removehead $headids($name) $name
577 set headids($name) $id
578 lappend idheads($id) $name
581 # update things when a head has been removed
582 proc removehead {id name} {
583 global headids idheads
585 if {$idheads($id) eq $name} {
588 set i [lsearch -exact $idheads($id) $name]
590 set idheads($id) [lreplace $idheads($id) $i $i]
596 proc show_error {w top msg} {
597 message $w.m -text $msg -justify center -aspect 400
598 pack $w.m -side top -fill x -padx 20 -pady 20
599 button $w.ok -text [mc OK] -command "destroy $top"
600 pack $w.ok -side bottom -fill x
601 bind $top <Visibility> "grab $top; focus $top"
602 bind $top <Key-Return> "destroy $top"
606 proc error_popup msg {
610 show_error $w $w $msg
613 proc confirm_popup msg {
619 message $w.m -text $msg -justify center -aspect 400
620 pack $w.m -side top -fill x -padx 20 -pady 20
621 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
622 pack $w.ok -side left -fill x
623 button $w.cancel -text [mc Cancel] -command "destroy $w"
624 pack $w.cancel -side right -fill x
625 bind $w <Visibility> "grab $w; focus $w"
631 option add *Panedwindow.showHandle 1 startupFile
632 option add *Panedwindow.sashRelief raised startupFile
633 option add *Button.font uifont startupFile
634 option add *Checkbutton.font uifont startupFile
635 option add *Radiobutton.font uifont startupFile
636 option add *Menu.font uifont startupFile
637 option add *Menubutton.font uifont startupFile
638 option add *Label.font uifont startupFile
639 option add *Message.font uifont startupFile
640 option add *Entry.font uifont startupFile
644 global canv canv2 canv3 linespc charspc ctext cflist
646 global findtype findtypemenu findloc findstring fstring geometry
647 global entries sha1entry sha1string sha1but
648 global diffcontextstring diffcontext
650 global maincursor textcursor curtextcursor
651 global rowctxmenu fakerowmenu mergemax wrapcomment
652 global highlight_files gdttype
653 global searchstring sstring
654 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
655 global headctxmenu progresscanv progressitem progresscoords statusw
656 global fprogitem fprogcoord lastprogupdate progupdatepending
657 global rprogitem rprogcoord
661 .bar add cascade -label [mc "File"] -menu .bar.file
663 .bar.file add command -label [mc "Update"] -command updatecommits
664 .bar.file add command -label [mc "Reread references"] -command rereadrefs
665 .bar.file add command -label [mc "List references"] -command showrefs
666 .bar.file add command -label [mc "Quit"] -command doquit
668 .bar add cascade -label [mc "Edit"] -menu .bar.edit
669 .bar.edit add command -label [mc "Preferences"] -command doprefs
672 .bar add cascade -label [mc "View"] -menu .bar.view
673 .bar.view add command -label [mc "New view..."] -command {newview 0}
674 .bar.view add command -label [mc "Edit view..."] -command editview \
676 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
677 .bar.view add separator
678 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
679 -variable selectedview -value 0
682 .bar add cascade -label [mc "Help"] -menu .bar.help
683 .bar.help add command -label [mc "About gitk"] -command about
684 .bar.help add command -label [mc "Key bindings"] -command keys
686 . configure -menu .bar
688 # the gui has upper and lower half, parts of a paned window.
689 panedwindow .ctop -orient vertical
691 # possibly use assumed geometry
692 if {![info exists geometry(pwsash0)]} {
693 set geometry(topheight) [expr {15 * $linespc}]
694 set geometry(topwidth) [expr {80 * $charspc}]
695 set geometry(botheight) [expr {15 * $linespc}]
696 set geometry(botwidth) [expr {50 * $charspc}]
697 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
698 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
701 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
702 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
704 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
706 # create three canvases
707 set cscroll .tf.histframe.csb
708 set canv .tf.histframe.pwclist.canv
710 -selectbackground $selectbgcolor \
711 -background $bgcolor -bd 0 \
712 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
713 .tf.histframe.pwclist add $canv
714 set canv2 .tf.histframe.pwclist.canv2
716 -selectbackground $selectbgcolor \
717 -background $bgcolor -bd 0 -yscrollincr $linespc
718 .tf.histframe.pwclist add $canv2
719 set canv3 .tf.histframe.pwclist.canv3
721 -selectbackground $selectbgcolor \
722 -background $bgcolor -bd 0 -yscrollincr $linespc
723 .tf.histframe.pwclist add $canv3
724 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
725 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
727 # a scroll bar to rule them
728 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
729 pack $cscroll -side right -fill y
730 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
731 lappend bglist $canv $canv2 $canv3
732 pack .tf.histframe.pwclist -fill both -expand 1 -side left
734 # we have two button bars at bottom of top frame. Bar 1
736 frame .tf.lbar -height 15
738 set sha1entry .tf.bar.sha1
739 set entries $sha1entry
740 set sha1but .tf.bar.sha1label
741 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
742 -command gotocommit -width 8
743 $sha1but conf -disabledforeground [$sha1but cget -foreground]
744 pack .tf.bar.sha1label -side left
745 entry $sha1entry -width 40 -font textfont -textvariable sha1string
746 trace add variable sha1string write sha1change
747 pack $sha1entry -side left -pady 2
749 image create bitmap bm-left -data {
750 #define left_width 16
751 #define left_height 16
752 static unsigned char left_bits[] = {
753 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
754 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
755 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
757 image create bitmap bm-right -data {
758 #define right_width 16
759 #define right_height 16
760 static unsigned char right_bits[] = {
761 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
762 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
763 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
765 button .tf.bar.leftbut -image bm-left -command goback \
766 -state disabled -width 26
767 pack .tf.bar.leftbut -side left -fill y
768 button .tf.bar.rightbut -image bm-right -command goforw \
769 -state disabled -width 26
770 pack .tf.bar.rightbut -side left -fill y
772 # Status label and progress bar
773 set statusw .tf.bar.status
774 label $statusw -width 15 -relief sunken
775 pack $statusw -side left -padx 5
776 set h [expr {[font metrics uifont -linespace] + 2}]
777 set progresscanv .tf.bar.progress
778 canvas $progresscanv -relief sunken -height $h -borderwidth 2
779 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
780 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
781 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
782 pack $progresscanv -side right -expand 1 -fill x
783 set progresscoords {0 0}
786 bind $progresscanv <Configure> adjustprogress
787 set lastprogupdate [clock clicks -milliseconds]
788 set progupdatepending 0
790 # build up the bottom bar of upper window
791 label .tf.lbar.flabel -text "[mc "Find"] "
792 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
793 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
794 label .tf.lbar.flab2 -text " [mc "commit"] "
795 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
797 set gdttype [mc "containing:"]
798 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
800 [mc "touching paths:"] \
801 [mc "adding/removing string:"]]
802 trace add variable gdttype write gdttype_change
803 pack .tf.lbar.gdttype -side left -fill y
806 set fstring .tf.lbar.findstring
807 lappend entries $fstring
808 entry $fstring -width 30 -font textfont -textvariable findstring
809 trace add variable findstring write find_change
810 set findtype [mc "Exact"]
811 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
812 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
813 trace add variable findtype write findcom_change
814 set findloc [mc "All fields"]
815 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
816 [mc "Comments"] [mc "Author"] [mc "Committer"]
817 trace add variable findloc write find_change
818 pack .tf.lbar.findloc -side right
819 pack .tf.lbar.findtype -side right
820 pack $fstring -side left -expand 1 -fill x
822 # Finish putting the upper half of the viewer together
823 pack .tf.lbar -in .tf -side bottom -fill x
824 pack .tf.bar -in .tf -side bottom -fill x
825 pack .tf.histframe -fill both -side top -expand 1
827 .ctop paneconfigure .tf -height $geometry(topheight)
828 .ctop paneconfigure .tf -width $geometry(topwidth)
830 # now build up the bottom
831 panedwindow .pwbottom -orient horizontal
833 # lower left, a text box over search bar, scroll bar to the right
834 # if we know window height, then that will set the lower text height, otherwise
835 # we set lower text height which will drive window height
836 if {[info exists geometry(main)]} {
837 frame .bleft -width $geometry(botwidth)
839 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
845 button .bleft.top.search -text [mc "Search"] -command dosearch
846 pack .bleft.top.search -side left -padx 5
847 set sstring .bleft.top.sstring
848 entry $sstring -width 20 -font textfont -textvariable searchstring
849 lappend entries $sstring
850 trace add variable searchstring write incrsearch
851 pack $sstring -side left -expand 1 -fill x
852 radiobutton .bleft.mid.diff -text [mc "Diff"] \
853 -command changediffdisp -variable diffelide -value {0 0}
854 radiobutton .bleft.mid.old -text [mc "Old version"] \
855 -command changediffdisp -variable diffelide -value {0 1}
856 radiobutton .bleft.mid.new -text [mc "New version"] \
857 -command changediffdisp -variable diffelide -value {1 0}
858 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
859 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
860 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
861 -from 1 -increment 1 -to 10000000 \
862 -validate all -validatecommand "diffcontextvalidate %P" \
863 -textvariable diffcontextstring
864 .bleft.mid.diffcontext set $diffcontext
865 trace add variable diffcontextstring write diffcontextchange
866 lappend entries .bleft.mid.diffcontext
867 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
868 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
869 -command changeignorespace -variable ignorespace
870 pack .bleft.mid.ignspace -side left -padx 5
871 set ctext .bleft.bottom.ctext
872 text $ctext -background $bgcolor -foreground $fgcolor \
873 -state disabled -font textfont \
874 -yscrollcommand scrolltext -wrap none \
875 -xscrollcommand ".bleft.bottom.sbhorizontal set"
877 $ctext conf -tabstyle wordprocessor
879 scrollbar .bleft.bottom.sb -command "$ctext yview"
880 scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \
882 pack .bleft.top -side top -fill x
883 pack .bleft.mid -side top -fill x
884 grid $ctext .bleft.bottom.sb -sticky nsew
885 grid .bleft.bottom.sbhorizontal -sticky ew
886 grid columnconfigure .bleft.bottom 0 -weight 1
887 grid rowconfigure .bleft.bottom 0 -weight 1
888 grid rowconfigure .bleft.bottom 1 -weight 0
889 pack .bleft.bottom -side top -fill both -expand 1
890 lappend bglist $ctext
891 lappend fglist $ctext
893 $ctext tag conf comment -wrap $wrapcomment
894 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
895 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
896 $ctext tag conf d0 -fore [lindex $diffcolors 0]
897 $ctext tag conf d1 -fore [lindex $diffcolors 1]
898 $ctext tag conf m0 -fore red
899 $ctext tag conf m1 -fore blue
900 $ctext tag conf m2 -fore green
901 $ctext tag conf m3 -fore purple
902 $ctext tag conf m4 -fore brown
903 $ctext tag conf m5 -fore "#009090"
904 $ctext tag conf m6 -fore magenta
905 $ctext tag conf m7 -fore "#808000"
906 $ctext tag conf m8 -fore "#009000"
907 $ctext tag conf m9 -fore "#ff0080"
908 $ctext tag conf m10 -fore cyan
909 $ctext tag conf m11 -fore "#b07070"
910 $ctext tag conf m12 -fore "#70b0f0"
911 $ctext tag conf m13 -fore "#70f0b0"
912 $ctext tag conf m14 -fore "#f0b070"
913 $ctext tag conf m15 -fore "#ff70b0"
914 $ctext tag conf mmax -fore darkgrey
916 $ctext tag conf mresult -font textfontbold
917 $ctext tag conf msep -font textfontbold
918 $ctext tag conf found -back yellow
921 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
926 radiobutton .bright.mode.patch -text [mc "Patch"] \
927 -command reselectline -variable cmitmode -value "patch"
928 radiobutton .bright.mode.tree -text [mc "Tree"] \
929 -command reselectline -variable cmitmode -value "tree"
930 grid .bright.mode.patch .bright.mode.tree -sticky ew
931 pack .bright.mode -side top -fill x
932 set cflist .bright.cfiles
933 set indent [font measure mainfont "nn"]
935 -selectbackground $selectbgcolor \
936 -background $bgcolor -foreground $fgcolor \
938 -tabs [list $indent [expr {2 * $indent}]] \
939 -yscrollcommand ".bright.sb set" \
940 -cursor [. cget -cursor] \
941 -spacing1 1 -spacing3 1
942 lappend bglist $cflist
943 lappend fglist $cflist
944 scrollbar .bright.sb -command "$cflist yview"
945 pack .bright.sb -side right -fill y
946 pack $cflist -side left -fill both -expand 1
947 $cflist tag configure highlight \
948 -background [$cflist cget -selectbackground]
949 $cflist tag configure bold -font mainfontbold
951 .pwbottom add .bright
954 # restore window width & height if known
955 if {[info exists geometry(main)]} {
956 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
957 if {$w > [winfo screenwidth .]} {
958 set w [winfo screenwidth .]
960 if {$h > [winfo screenheight .]} {
961 set h [winfo screenheight .]
963 wm geometry . "${w}x$h"
967 if {[tk windowingsystem] eq {aqua}} {
973 bind .pwbottom <Configure> {resizecdetpanes %W %w}
974 pack .ctop -fill both -expand 1
975 bindall <1> {selcanvline %W %x %y}
976 #bindall <B1-Motion> {selcanvline %W %x %y}
977 if {[tk windowingsystem] == "win32"} {
978 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
979 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
981 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
982 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
983 if {[tk windowingsystem] eq "aqua"} {
984 bindall <MouseWheel> {
985 set delta [expr {- (%D)}]
986 allcanvs yview scroll $delta units
990 bindall <2> "canvscan mark %W %x %y"
991 bindall <B2-Motion> "canvscan dragto %W %x %y"
992 bindkey <Home> selfirstline
993 bindkey <End> sellastline
994 bind . <Key-Up> "selnextline -1"
995 bind . <Key-Down> "selnextline 1"
996 bind . <Shift-Key-Up> "dofind -1 0"
997 bind . <Shift-Key-Down> "dofind 1 0"
998 bindkey <Key-Right> "goforw"
999 bindkey <Key-Left> "goback"
1000 bind . <Key-Prior> "selnextpage -1"
1001 bind . <Key-Next> "selnextpage 1"
1002 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1003 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1004 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1005 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1006 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1007 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1008 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1009 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1010 bindkey <Key-space> "$ctext yview scroll 1 pages"
1011 bindkey p "selnextline -1"
1012 bindkey n "selnextline 1"
1015 bindkey i "selnextline -1"
1016 bindkey k "selnextline 1"
1020 bindkey d "$ctext yview scroll 18 units"
1021 bindkey u "$ctext yview scroll -18 units"
1022 bindkey / {dofind 1 1}
1023 bindkey <Key-Return> {dofind 1 1}
1024 bindkey ? {dofind -1 1}
1026 bindkey <F5> updatecommits
1027 bind . <$M1B-q> doquit
1028 bind . <$M1B-f> {dofind 1 1}
1029 bind . <$M1B-g> {dofind 1 0}
1030 bind . <$M1B-r> dosearchback
1031 bind . <$M1B-s> dosearch
1032 bind . <$M1B-equal> {incrfont 1}
1033 bind . <$M1B-plus> {incrfont 1}
1034 bind . <$M1B-KP_Add> {incrfont 1}
1035 bind . <$M1B-minus> {incrfont -1}
1036 bind . <$M1B-KP_Subtract> {incrfont -1}
1037 wm protocol . WM_DELETE_WINDOW doquit
1038 bind . <Button-1> "click %W"
1039 bind $fstring <Key-Return> {dofind 1 1}
1040 bind $sha1entry <Key-Return> gotocommit
1041 bind $sha1entry <<PasteSelection>> clearsha1
1042 bind $cflist <1> {sel_flist %W %x %y; break}
1043 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1044 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1045 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1047 set maincursor [. cget -cursor]
1048 set textcursor [$ctext cget -cursor]
1049 set curtextcursor $textcursor
1051 set rowctxmenu .rowctxmenu
1052 menu $rowctxmenu -tearoff 0
1053 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1054 -command {diffvssel 0}
1055 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1056 -command {diffvssel 1}
1057 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1058 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1059 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1060 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1061 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1063 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1066 set fakerowmenu .fakerowmenu
1067 menu $fakerowmenu -tearoff 0
1068 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1069 -command {diffvssel 0}
1070 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1071 -command {diffvssel 1}
1072 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1073 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1074 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1075 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1077 set headctxmenu .headctxmenu
1078 menu $headctxmenu -tearoff 0
1079 $headctxmenu add command -label [mc "Check out this branch"] \
1081 $headctxmenu add command -label [mc "Remove this branch"] \
1085 set flist_menu .flistctxmenu
1086 menu $flist_menu -tearoff 0
1087 $flist_menu add command -label [mc "Highlight this too"] \
1088 -command {flist_hl 0}
1089 $flist_menu add command -label [mc "Highlight this only"] \
1090 -command {flist_hl 1}
1093 # Windows sends all mouse wheel events to the current focused window, not
1094 # the one where the mouse hovers, so bind those events here and redirect
1095 # to the correct window
1096 proc windows_mousewheel_redirector {W X Y D} {
1097 global canv canv2 canv3
1098 set w [winfo containing -displayof $W $X $Y]
1100 set u [expr {$D < 0 ? 5 : -5}]
1101 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1102 allcanvs yview scroll $u units
1105 $w yview scroll $u units
1111 # mouse-2 makes all windows scan vertically, but only the one
1112 # the cursor is in scans horizontally
1113 proc canvscan {op w x y} {
1114 global canv canv2 canv3
1115 foreach c [list $canv $canv2 $canv3] {
1124 proc scrollcanv {cscroll f0 f1} {
1125 $cscroll set $f0 $f1
1130 # when we make a key binding for the toplevel, make sure
1131 # it doesn't get triggered when that key is pressed
in the
1132 # find string entry widget.
1133 proc bindkey
{ev
script} {
1136 set escript
[bind Entry
$ev]
1137 if {$escript == {}} {
1138 set escript
[bind Entry
<Key
>]
1140 foreach e
$entries {
1141 bind $e $ev "$escript; break"
1145 # set the focus back to the toplevel for any click outside
1148 global ctext entries
1149 foreach e
[concat
$entries $ctext] {
1150 if {$w == $e} return
1155 # Adjust the progress bar for a change in requested extent or canvas size
1156 proc adjustprogress
{} {
1157 global progresscanv progressitem progresscoords
1158 global fprogitem fprogcoord lastprogupdate progupdatepending
1159 global rprogitem rprogcoord
1161 set w
[expr {[winfo width
$progresscanv] - 4}]
1162 set x0
[expr {$w * [lindex
$progresscoords 0]}]
1163 set x1
[expr {$w * [lindex
$progresscoords 1]}]
1164 set h
[winfo height
$progresscanv]
1165 $progresscanv coords
$progressitem $x0 0 $x1 $h
1166 $progresscanv coords
$fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1167 $progresscanv coords
$rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1168 set now
[clock clicks
-milliseconds]
1169 if {$now >= $lastprogupdate + 100} {
1170 set progupdatepending
0
1172 } elseif
{!$progupdatepending} {
1173 set progupdatepending
1
1174 after
[expr {$lastprogupdate + 100 - $now}] doprogupdate
1178 proc doprogupdate
{} {
1179 global lastprogupdate progupdatepending
1181 if {$progupdatepending} {
1182 set progupdatepending
0
1183 set lastprogupdate
[clock clicks
-milliseconds]
1188 proc savestuff
{w
} {
1189 global canv canv2 canv3 mainfont textfont uifont tabstop
1190 global stuffsaved findmergefiles maxgraphpct
1191 global maxwidth showneartags showlocalchanges
1192 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
1193 global cmitmode wrapcomment datetimeformat limitdiffs
1194 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1197 if {$stuffsaved} return
1198 if {![winfo viewable .
]} return
1200 set f
[open
"~/.gitk-new" w
]
1201 puts
$f [list
set mainfont
$mainfont]
1202 puts
$f [list
set textfont
$textfont]
1203 puts
$f [list
set uifont
$uifont]
1204 puts
$f [list
set tabstop
$tabstop]
1205 puts
$f [list
set findmergefiles
$findmergefiles]
1206 puts
$f [list
set maxgraphpct
$maxgraphpct]
1207 puts
$f [list
set maxwidth
$maxwidth]
1208 puts
$f [list
set cmitmode
$cmitmode]
1209 puts
$f [list
set wrapcomment
$wrapcomment]
1210 puts
$f [list
set autoselect
$autoselect]
1211 puts
$f [list
set showneartags
$showneartags]
1212 puts
$f [list
set showlocalchanges
$showlocalchanges]
1213 puts
$f [list
set datetimeformat
$datetimeformat]
1214 puts
$f [list
set limitdiffs
$limitdiffs]
1215 puts
$f [list
set bgcolor
$bgcolor]
1216 puts
$f [list
set fgcolor
$fgcolor]
1217 puts
$f [list
set colors
$colors]
1218 puts
$f [list
set diffcolors
$diffcolors]
1219 puts
$f [list
set diffcontext
$diffcontext]
1220 puts
$f [list
set selectbgcolor
$selectbgcolor]
1222 puts
$f "set geometry(main) [wm geometry .]"
1223 puts
$f "set geometry(topwidth) [winfo width .tf]"
1224 puts
$f "set geometry(topheight) [winfo height .tf]"
1225 puts
$f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1226 puts
$f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1227 puts
$f "set geometry(botwidth) [winfo width .bleft]"
1228 puts
$f "set geometry(botheight) [winfo height .bleft]"
1230 puts
-nonewline $f "set permviews {"
1231 for {set v
0} {$v < $nextviewnum} {incr v
} {
1232 if {$viewperm($v)} {
1233 puts
$f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
1238 file rename
-force "~/.gitk-new" "~/.gitk"
1243 proc resizeclistpanes
{win w
} {
1245 if {[info exists oldwidth
($win)]} {
1246 set s0
[$win sash coord
0]
1247 set s1
[$win sash coord
1]
1249 set sash0
[expr {int
($w/2 - 2)}]
1250 set sash1
[expr {int
($w*5/6 - 2)}]
1252 set factor [expr {1.0 * $w / $oldwidth($win)}]
1253 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1254 set sash1
[expr {int
($factor * [lindex
$s1 0])}]
1258 if {$sash1 < $sash0 + 20} {
1259 set sash1
[expr {$sash0 + 20}]
1261 if {$sash1 > $w - 10} {
1262 set sash1
[expr {$w - 10}]
1263 if {$sash0 > $sash1 - 20} {
1264 set sash0
[expr {$sash1 - 20}]
1268 $win sash place
0 $sash0 [lindex
$s0 1]
1269 $win sash place
1 $sash1 [lindex
$s1 1]
1271 set oldwidth
($win) $w
1274 proc resizecdetpanes
{win w
} {
1276 if {[info exists oldwidth
($win)]} {
1277 set s0
[$win sash coord
0]
1279 set sash0
[expr {int
($w*3/4 - 2)}]
1281 set factor [expr {1.0 * $w / $oldwidth($win)}]
1282 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1286 if {$sash0 > $w - 15} {
1287 set sash0
[expr {$w - 15}]
1290 $win sash place
0 $sash0 [lindex
$s0 1]
1292 set oldwidth
($win) $w
1295 proc allcanvs args
{
1296 global canv canv2 canv3
1302 proc bindall
{event action
} {
1303 global canv canv2 canv3
1304 bind $canv $event $action
1305 bind $canv2 $event $action
1306 bind $canv3 $event $action
1312 if {[winfo exists
$w]} {
1317 wm title
$w [mc
"About gitk"]
1318 message
$w.m
-text [mc
"
1319 Gitk - a commit viewer for git
1321 Copyright © 2005-2006 Paul Mackerras
1323 Use and redistribute under the terms of the GNU General Public License"] \
1324 -justify center
-aspect 400 -border 2 -bg white
-relief groove
1325 pack
$w.m
-side top
-fill x
-padx 2 -pady 2
1326 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1327 pack
$w.ok
-side bottom
1328 bind $w <Visibility
> "focus $w.ok"
1329 bind $w <Key-Escape
> "destroy $w"
1330 bind $w <Key-Return
> "destroy $w"
1335 if {[winfo exists
$w]} {
1339 if {[tk windowingsystem
] eq
{aqua
}} {
1345 wm title
$w [mc
"Gitk key bindings"]
1346 message
$w.m
-text "
1347 [mc "Gitk key bindings
:"]
1349 [mc "<%s-Q
> Quit
" $M1T]
1350 [mc "<Home
> Move to first commit
"]
1351 [mc "<End
> Move to last commit
"]
1352 [mc "<Up
>, p
, i Move up one commit
"]
1353 [mc "<Down
>, n
, k Move down one commit
"]
1354 [mc "<Left
>, z
, j Go back
in history list
"]
1355 [mc "<Right
>, x
, l Go forward
in history list
"]
1356 [mc "<PageUp
> Move up one page
in commit list
"]
1357 [mc "<PageDown
> Move down one page
in commit list
"]
1358 [mc "<%s-Home
> Scroll to top of commit list
" $M1T]
1359 [mc "<%s-End
> Scroll to bottom of commit list
" $M1T]
1360 [mc "<%s-Up
> Scroll commit list up one line
" $M1T]
1361 [mc "<%s-Down
> Scroll commit list down one line
" $M1T]
1362 [mc "<%s-PageUp
> Scroll commit list up one page
" $M1T]
1363 [mc "<%s-PageDown
> Scroll commit list down one page
" $M1T]
1364 [mc "<Shift-Up
> Find backwards
(upwards
, later commits
)"]
1365 [mc "<Shift-Down
> Find forwards
(downwards
, earlier commits
)"]
1366 [mc "<Delete
>, b Scroll
diff view up one page
"]
1367 [mc "<Backspace
> Scroll
diff view up one page
"]
1368 [mc "<Space
> Scroll
diff view down one page
"]
1369 [mc "u Scroll
diff view up
18 lines
"]
1370 [mc "d Scroll
diff view down
18 lines
"]
1371 [mc "<%s-F
> Find
" $M1T]
1372 [mc "<%s-G
> Move to next
find hit
" $M1T]
1373 [mc "<Return
> Move to next
find hit
"]
1374 [mc "/ Move to next
find hit
, or redo
find"]
1375 [mc "? Move to previous
find hit
"]
1376 [mc "f Scroll
diff view to next
file"]
1377 [mc "<%s-S
> Search
for next hit
in diff view
" $M1T]
1378 [mc "<%s-R
> Search
for previous hit
in diff view
" $M1T]
1379 [mc "<%s-KP
+> Increase font size
" $M1T]
1380 [mc "<%s-plus
> Increase font size
" $M1T]
1381 [mc "<%s-KP-
> Decrease font size
" $M1T]
1382 [mc "<%s-minus
> Decrease font size
" $M1T]
1385 -justify left
-bg white
-border 2 -relief groove
1386 pack
$w.m
-side top
-fill both
-padx 2 -pady 2
1387 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1388 pack
$w.ok
-side bottom
1389 bind $w <Visibility
> "focus $w.ok"
1390 bind $w <Key-Escape
> "destroy $w"
1391 bind $w <Key-Return
> "destroy $w"
1394 # Procedures for manipulating the file list window at the
1395 # bottom right of the overall window.
1397 proc treeview
{w l openlevs
} {
1398 global treecontents treediropen treeheight treeparent treeindex
1408 set treecontents
() {}
1409 $w conf
-state normal
1411 while {[string range
$f 0 $prefixend] ne
$prefix} {
1412 if {$lev <= $openlevs} {
1413 $w mark
set e
:$treeindex($prefix) "end -1c"
1414 $w mark gravity e
:$treeindex($prefix) left
1416 set treeheight
($prefix) $ht
1417 incr ht
[lindex
$htstack end
]
1418 set htstack
[lreplace
$htstack end end
]
1419 set prefixend
[lindex
$prefendstack end
]
1420 set prefendstack
[lreplace
$prefendstack end end
]
1421 set prefix
[string range
$prefix 0 $prefixend]
1424 set tail [string range
$f [expr {$prefixend+1}] end
]
1425 while {[set slash
[string first
"/" $tail]] >= 0} {
1428 lappend prefendstack
$prefixend
1429 incr prefixend
[expr {$slash + 1}]
1430 set d
[string range
$tail 0 $slash]
1431 lappend treecontents
($prefix) $d
1432 set oldprefix
$prefix
1434 set treecontents
($prefix) {}
1435 set treeindex
($prefix) [incr ix
]
1436 set treeparent
($prefix) $oldprefix
1437 set tail [string range
$tail [expr {$slash+1}] end
]
1438 if {$lev <= $openlevs} {
1440 set treediropen
($prefix) [expr {$lev < $openlevs}]
1441 set bm
[expr {$lev == $openlevs?
"tri-rt": "tri-dn"}]
1442 $w mark
set d
:$ix "end -1c"
1443 $w mark gravity d
:$ix left
1445 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1447 $w image create end
-align center
-image $bm -padx 1 \
1449 $w insert end
$d [highlight_tag
$prefix]
1450 $w mark
set s
:$ix "end -1c"
1451 $w mark gravity s
:$ix left
1456 if {$lev <= $openlevs} {
1459 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1461 $w insert end
$tail [highlight_tag
$f]
1463 lappend treecontents
($prefix) $tail
1466 while {$htstack ne
{}} {
1467 set treeheight
($prefix) $ht
1468 incr ht
[lindex
$htstack end
]
1469 set htstack
[lreplace
$htstack end end
]
1470 set prefixend
[lindex
$prefendstack end
]
1471 set prefendstack
[lreplace
$prefendstack end end
]
1472 set prefix
[string range
$prefix 0 $prefixend]
1474 $w conf
-state disabled
1477 proc linetoelt
{l
} {
1478 global treeheight treecontents
1483 foreach e
$treecontents($prefix) {
1488 if {[string index
$e end
] eq
"/"} {
1489 set n
$treeheight($prefix$e)
1501 proc highlight_tree
{y prefix
} {
1502 global treeheight treecontents cflist
1504 foreach e
$treecontents($prefix) {
1506 if {[highlight_tag
$path] ne
{}} {
1507 $cflist tag add bold
$y.0 "$y.0 lineend"
1510 if {[string index
$e end
] eq
"/" && $treeheight($path) > 1} {
1511 set y
[highlight_tree
$y $path]
1517 proc treeclosedir
{w dir
} {
1518 global treediropen treeheight treeparent treeindex
1520 set ix
$treeindex($dir)
1521 $w conf
-state normal
1522 $w delete s
:$ix e
:$ix
1523 set treediropen
($dir) 0
1524 $w image configure a
:$ix -image tri-rt
1525 $w conf
-state disabled
1526 set n
[expr {1 - $treeheight($dir)}]
1527 while {$dir ne
{}} {
1528 incr treeheight
($dir) $n
1529 set dir
$treeparent($dir)
1533 proc treeopendir
{w dir
} {
1534 global treediropen treeheight treeparent treecontents treeindex
1536 set ix
$treeindex($dir)
1537 $w conf
-state normal
1538 $w image configure a
:$ix -image tri-dn
1539 $w mark
set e
:$ix s
:$ix
1540 $w mark gravity e
:$ix right
1543 set n
[llength
$treecontents($dir)]
1544 for {set x
$dir} {$x ne
{}} {set x
$treeparent($x)} {
1547 incr treeheight
($x) $n
1549 foreach e
$treecontents($dir) {
1551 if {[string index
$e end
] eq
"/"} {
1552 set iy
$treeindex($de)
1553 $w mark
set d
:$iy e
:$ix
1554 $w mark gravity d
:$iy left
1555 $w insert e
:$ix $str
1556 set treediropen
($de) 0
1557 $w image create e
:$ix -align center
-image tri-rt
-padx 1 \
1559 $w insert e
:$ix $e [highlight_tag
$de]
1560 $w mark
set s
:$iy e
:$ix
1561 $w mark gravity s
:$iy left
1562 set treeheight
($de) 1
1564 $w insert e
:$ix $str
1565 $w insert e
:$ix $e [highlight_tag
$de]
1568 $w mark gravity e
:$ix left
1569 $w conf
-state disabled
1570 set treediropen
($dir) 1
1571 set top
[lindex
[split [$w index @
0,0] .
] 0]
1572 set ht
[$w cget
-height]
1573 set l
[lindex
[split [$w index s
:$ix] .
] 0]
1576 } elseif
{$l + $n + 1 > $top + $ht} {
1577 set top
[expr {$l + $n + 2 - $ht}]
1585 proc treeclick
{w x y
} {
1586 global treediropen cmitmode ctext cflist cflist_top
1588 if {$cmitmode ne
"tree"} return
1589 if {![info exists cflist_top
]} return
1590 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1591 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1592 $cflist tag add highlight
$l.0 "$l.0 lineend"
1598 set e
[linetoelt
$l]
1599 if {[string index
$e end
] ne
"/"} {
1601 } elseif
{$treediropen($e)} {
1608 proc setfilelist
{id
} {
1609 global treefilelist cflist
1611 treeview
$cflist $treefilelist($id) 0
1614 image create bitmap tri-rt
-background black
-foreground blue
-data {
1615 #define tri-rt_width 13
1616 #define tri-rt_height 13
1617 static unsigned char tri-rt_bits
[] = {
1618 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1619 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1622 #define tri-rt-mask_width 13
1623 #define tri-rt-mask_height 13
1624 static unsigned char tri-rt-mask_bits
[] = {
1625 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1626 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1629 image create bitmap tri-dn
-background black
-foreground blue
-data {
1630 #define tri-dn_width 13
1631 #define tri-dn_height 13
1632 static unsigned char tri-dn_bits
[] = {
1633 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1634 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1637 #define tri-dn-mask_width 13
1638 #define tri-dn-mask_height 13
1639 static unsigned char tri-dn-mask_bits
[] = {
1640 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1641 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1645 image create bitmap reficon-T
-background black
-foreground yellow
-data {
1646 #define tagicon_width 13
1647 #define tagicon_height 9
1648 static unsigned char tagicon_bits
[] = {
1649 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1650 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1652 #define tagicon-mask_width 13
1653 #define tagicon-mask_height 9
1654 static unsigned char tagicon-mask_bits
[] = {
1655 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1656 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1659 #define headicon_width 13
1660 #define headicon_height 9
1661 static unsigned char headicon_bits
[] = {
1662 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1663 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1666 #define headicon-mask_width 13
1667 #define headicon-mask_height 9
1668 static unsigned char headicon-mask_bits
[] = {
1669 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1670 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1672 image create bitmap reficon-H
-background black
-foreground green \
1673 -data $rectdata -maskdata $rectmask
1674 image create bitmap reficon-o
-background black
-foreground "#ddddff" \
1675 -data $rectdata -maskdata $rectmask
1677 proc init_flist
{first
} {
1678 global cflist cflist_top selectedline difffilestart
1680 $cflist conf
-state normal
1681 $cflist delete
0.0 end
1683 $cflist insert end
$first
1685 $cflist tag add highlight
1.0 "1.0 lineend"
1687 catch
{unset cflist_top
}
1689 $cflist conf
-state disabled
1690 set difffilestart
{}
1693 proc highlight_tag
{f
} {
1694 global highlight_paths
1696 foreach p
$highlight_paths {
1697 if {[string match
$p $f]} {
1704 proc highlight_filelist
{} {
1705 global cmitmode cflist
1707 $cflist conf
-state normal
1708 if {$cmitmode ne
"tree"} {
1709 set end
[lindex
[split [$cflist index end
] .
] 0]
1710 for {set l
2} {$l < $end} {incr l
} {
1711 set line
[$cflist get
$l.0 "$l.0 lineend"]
1712 if {[highlight_tag
$line] ne
{}} {
1713 $cflist tag add bold
$l.0 "$l.0 lineend"
1719 $cflist conf
-state disabled
1722 proc unhighlight_filelist
{} {
1725 $cflist conf
-state normal
1726 $cflist tag remove bold
1.0 end
1727 $cflist conf
-state disabled
1730 proc add_flist
{fl
} {
1733 $cflist conf
-state normal
1735 $cflist insert end
"\n"
1736 $cflist insert end
$f [highlight_tag
$f]
1738 $cflist conf
-state disabled
1741 proc sel_flist
{w x y
} {
1742 global ctext difffilestart cflist cflist_top cmitmode
1744 if {$cmitmode eq
"tree"} return
1745 if {![info exists cflist_top
]} return
1746 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1747 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1748 $cflist tag add highlight
$l.0 "$l.0 lineend"
1753 catch
{$ctext yview
[lindex
$difffilestart [expr {$l - 2}]]}
1757 proc pop_flist_menu
{w X Y x y
} {
1758 global ctext cflist cmitmode flist_menu flist_menu_file
1759 global treediffs diffids
1762 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1764 if {$cmitmode eq
"tree"} {
1765 set e
[linetoelt
$l]
1766 if {[string index
$e end
] eq
"/"} return
1768 set e
[lindex
$treediffs($diffids) [expr {$l-2}]]
1770 set flist_menu_file
$e
1771 tk_popup
$flist_menu $X $Y
1774 proc flist_hl
{only
} {
1775 global flist_menu_file findstring gdttype
1777 set x
[shellquote
$flist_menu_file]
1778 if {$only ||
$findstring eq
{} ||
$gdttype ne
[mc
"touching paths:"]} {
1781 append findstring
" " $x
1783 set gdttype
[mc
"touching paths:"]
1786 # Functions for adding and removing shell-type quoting
1788 proc shellquote
{str
} {
1789 if {![string match
"*\['\"\\ \t]*" $str]} {
1792 if {![string match
"*\['\"\\]*" $str]} {
1795 if {![string match
"*'*" $str]} {
1798 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1801 proc shellarglist
{l
} {
1807 append str
[shellquote
$a]
1812 proc shelldequote
{str
} {
1817 if {![regexp
-start $used -indices "\['\"\\\\ \t]" $str first
]} {
1818 append ret
[string range
$str $used end
]
1819 set used
[string length
$str]
1822 set first
[lindex
$first 0]
1823 set ch
[string index
$str $first]
1824 if {$first > $used} {
1825 append ret
[string range
$str $used [expr {$first - 1}]]
1828 if {$ch eq
" " ||
$ch eq
"\t"} break
1831 set first
[string first
"'" $str $used]
1833 error
"unmatched single-quote"
1835 append ret
[string range
$str $used [expr {$first - 1}]]
1840 if {$used >= [string length
$str]} {
1841 error
"trailing backslash"
1843 append ret
[string index
$str $used]
1848 if {![regexp
-start $used -indices "\[\"\\\\]" $str first
]} {
1849 error
"unmatched double-quote"
1851 set first
[lindex
$first 0]
1852 set ch
[string index
$str $first]
1853 if {$first > $used} {
1854 append ret
[string range
$str $used [expr {$first - 1}]]
1857 if {$ch eq
"\""} break
1859 append ret
[string index
$str $used]
1863 return [list
$used $ret]
1866 proc shellsplit
{str
} {
1869 set str
[string trimleft
$str]
1870 if {$str eq
{}} break
1871 set dq
[shelldequote
$str]
1872 set n
[lindex
$dq 0]
1873 set word
[lindex
$dq 1]
1874 set str
[string range
$str $n end
]
1880 # Code to implement multiple views
1882 proc newview
{ishighlight
} {
1883 global nextviewnum newviewname newviewperm newishighlight
1884 global newviewargs revtreeargs viewargscmd newviewargscmd curview
1886 set newishighlight
$ishighlight
1888 if {[winfo exists
$top]} {
1892 set newviewname
($nextviewnum) "[mc "View
"] $nextviewnum"
1893 set newviewperm
($nextviewnum) 0
1894 set newviewargs
($nextviewnum) [shellarglist
$revtreeargs]
1895 set newviewargscmd
($nextviewnum) $viewargscmd($curview)
1896 vieweditor
$top $nextviewnum [mc
"Gitk view definition"]
1901 global viewname viewperm newviewname newviewperm
1902 global viewargs newviewargs viewargscmd newviewargscmd
1904 set top .gitkvedit-
$curview
1905 if {[winfo exists
$top]} {
1909 set newviewname
($curview) $viewname($curview)
1910 set newviewperm
($curview) $viewperm($curview)
1911 set newviewargs
($curview) [shellarglist
$viewargs($curview)]
1912 set newviewargscmd
($curview) $viewargscmd($curview)
1913 vieweditor
$top $curview "Gitk: edit view $viewname($curview)"
1916 proc vieweditor
{top n title
} {
1917 global newviewname newviewperm viewfiles bgcolor
1920 wm title
$top $title
1921 label
$top.
nl -text [mc
"Name"]
1922 entry
$top.name
-width 20 -textvariable newviewname
($n)
1923 grid
$top.
nl $top.name
-sticky w
-pady 5
1924 checkbutton
$top.perm
-text [mc
"Remember this view"] \
1925 -variable newviewperm
($n)
1926 grid
$top.perm
- -pady 5 -sticky w
1927 message
$top.al
-aspect 1000 \
1928 -text [mc
"Commits to include (arguments to git rev-list):"]
1929 grid
$top.al
- -sticky w
-pady 5
1930 entry
$top.args
-width 50 -textvariable newviewargs
($n) \
1931 -background $bgcolor
1932 grid
$top.args
- -sticky ew
-padx 5
1934 message
$top.ac
-aspect 1000 \
1935 -text [mc
"Command to generate more commits to include:"]
1936 grid
$top.ac
- -sticky w
-pady 5
1937 entry
$top.argscmd
-width 50 -textvariable newviewargscmd
($n) \
1939 grid
$top.argscmd
- -sticky ew
-padx 5
1941 message
$top.l
-aspect 1000 \
1942 -text [mc
"Enter files and directories to include, one per line:"]
1943 grid
$top.l
- -sticky w
1944 text
$top.t
-width 40 -height 10 -background $bgcolor -font uifont
1945 if {[info exists viewfiles
($n)]} {
1946 foreach f
$viewfiles($n) {
1947 $top.t insert end
$f
1948 $top.t insert end
"\n"
1950 $top.t delete
{end
- 1c
} end
1951 $top.t mark
set insert
0.0
1953 grid
$top.t
- -sticky ew
-padx 5
1955 button
$top.buts.ok
-text [mc
"OK"] -command [list newviewok
$top $n]
1956 button
$top.buts.can
-text [mc
"Cancel"] -command [list destroy
$top]
1957 grid
$top.buts.ok
$top.buts.can
1958 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
1959 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
1960 grid
$top.buts
- -pady 10 -sticky ew
1964 proc doviewmenu
{m first cmd op argv
} {
1965 set nmenu
[$m index end
]
1966 for {set i
$first} {$i <= $nmenu} {incr i
} {
1967 if {[$m entrycget
$i -command] eq
$cmd} {
1968 eval $m $op $i $argv
1974 proc allviewmenus
{n op args
} {
1977 doviewmenu .bar.view
5 [list showview
$n] $op $args
1978 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1981 proc newviewok
{top n
} {
1982 global nextviewnum newviewperm newviewname newishighlight
1983 global viewname viewfiles viewperm selectedview curview
1984 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
1987 set newargs
[shellsplit
$newviewargs($n)]
1989 error_popup
"[mc "Error
in commit selection arguments
:"] $err"
1995 foreach f
[split [$top.t get
0.0 end
] "\n"] {
1996 set ft
[string trim
$f]
2001 if {![info exists viewfiles
($n)]} {
2002 # creating a new view
2004 set viewname
($n) $newviewname($n)
2005 set viewperm
($n) $newviewperm($n)
2006 set viewfiles
($n) $files
2007 set viewargs
($n) $newargs
2008 set viewargscmd
($n) $newviewargscmd($n)
2010 if {!$newishighlight} {
2013 run addvhighlight
$n
2016 # editing an existing view
2017 set viewperm
($n) $newviewperm($n)
2018 if {$newviewname($n) ne
$viewname($n)} {
2019 set viewname
($n) $newviewname($n)
2020 doviewmenu .bar.view
5 [list showview
$n] \
2021 entryconf
[list
-label $viewname($n)]
2022 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2023 # entryconf [list -label $viewname($n) -value $viewname($n)]
2025 if {$files ne
$viewfiles($n) ||
$newargs ne
$viewargs($n) || \
2026 $newviewargscmd($n) ne
$viewargscmd($n)} {
2027 set viewfiles
($n) $files
2028 set viewargs
($n) $newargs
2029 set viewargscmd
($n) $newviewargscmd($n)
2030 if {$curview == $n} {
2035 catch
{destroy
$top}
2039 global curview viewdata viewperm hlview selectedhlview
2041 if {$curview == 0} return
2042 if {[info exists hlview
] && $hlview == $curview} {
2043 set selectedhlview
[mc
"None"]
2046 allviewmenus
$curview delete
2047 set viewdata
($curview) {}
2048 set viewperm
($curview) 0
2052 proc addviewmenu
{n
} {
2053 global viewname viewhlmenu
2055 .bar.view add radiobutton
-label $viewname($n) \
2056 -command [list showview
$n] -variable selectedview
-value $n
2057 #$viewhlmenu add radiobutton -label $viewname($n) \
2058 # -command [list addvhighlight $n] -variable selectedhlview
2061 proc flatten
{var
} {
2065 foreach i
[array names
$var] {
2066 lappend ret
$i [set $var\
($i\
)]
2071 proc unflatten
{var l
} {
2081 global curview viewdata viewfiles
2082 global displayorder parentlist rowidlist rowisopt rowfinal
2083 global colormap rowtextx commitrow nextcolor canvxmax
2084 global numcommits commitlisted
2085 global selectedline currentid canv canvy0
2087 global pending_select phase
2090 global selectedview selectfirst
2091 global vparentlist vdisporder vcmitlisted
2092 global hlview selectedhlview commitinterest
2094 if {$n == $curview} return
2096 if {[info exists selectedline
]} {
2097 set selid
$currentid
2098 set y
[yc
$selectedline]
2099 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2100 set span
[$canv yview
]
2101 set ytop
[expr {[lindex
$span 0] * $ymax}]
2102 set ybot
[expr {[lindex
$span 1] * $ymax}]
2103 if {$ytop < $y && $y < $ybot} {
2104 set yscreen
[expr {$y - $ytop}]
2106 } elseif
{[info exists pending_select
]} {
2107 set selid
$pending_select
2108 unset pending_select
2112 if {$curview >= 0} {
2113 set vparentlist
($curview) $parentlist
2114 set vdisporder
($curview) $displayorder
2115 set vcmitlisted
($curview) $commitlisted
2117 ![info exists viewdata
($curview)] ||
2118 [lindex
$viewdata($curview) 0] ne
{}} {
2119 set viewdata
($curview) \
2120 [list
$phase $rowidlist $rowisopt $rowfinal]
2123 catch
{unset treediffs
}
2125 if {[info exists hlview
] && $hlview == $n} {
2127 set selectedhlview
[mc
"None"]
2129 catch
{unset commitinterest
}
2133 .bar.view entryconf
[mc
"Edit view..."] -state [expr {$n == 0?
"disabled": "normal"}]
2134 .bar.view entryconf
[mc
"Delete view"] -state [expr {$n == 0?
"disabled": "normal"}]
2137 if {![info exists viewdata
($n)]} {
2139 set pending_select
$selid
2146 set phase
[lindex
$v 0]
2147 set displayorder
$vdisporder($n)
2148 set parentlist
$vparentlist($n)
2149 set commitlisted
$vcmitlisted($n)
2150 set rowidlist
[lindex
$v 1]
2151 set rowisopt
[lindex
$v 2]
2152 set rowfinal
[lindex
$v 3]
2153 set numcommits
$commitidx($n)
2155 catch
{unset colormap
}
2156 catch
{unset rowtextx
}
2158 set canvxmax
[$canv cget
-width]
2165 if {[info exists yscreen
] && [info exists commitrow
($n,$selid)]} {
2166 set row
$commitrow($n,$selid)
2167 # try to get the selected row in the same position on the screen
2168 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2169 set ytop
[expr {[yc
$row] - $yscreen}]
2173 set yf
[expr {$ytop * 1.0 / $ymax}]
2175 allcanvs yview moveto
$yf
2179 } elseif
{$selid ne
{}} {
2180 set pending_select
$selid
2182 set row
[first_real_row
]
2183 if {$row < $numcommits} {
2190 if {$phase eq
"getcommits"} {
2191 show_status
[mc
"Reading commits..."]
2194 } elseif
{$numcommits == 0} {
2195 show_status
[mc
"No commits selected"]
2199 # Stuff relating to the highlighting facility
2201 proc ishighlighted
{row
} {
2202 global vhighlights fhighlights nhighlights rhighlights
2204 if {[info exists nhighlights
($row)] && $nhighlights($row) > 0} {
2205 return $nhighlights($row)
2207 if {[info exists vhighlights
($row)] && $vhighlights($row) > 0} {
2208 return $vhighlights($row)
2210 if {[info exists fhighlights
($row)] && $fhighlights($row) > 0} {
2211 return $fhighlights($row)
2213 if {[info exists rhighlights
($row)] && $rhighlights($row) > 0} {
2214 return $rhighlights($row)
2219 proc bolden
{row font
} {
2220 global canv linehtag selectedline boldrows
2222 lappend boldrows
$row
2223 $canv itemconf
$linehtag($row) -font $font
2224 if {[info exists selectedline
] && $row == $selectedline} {
2226 set t
[eval $canv create rect
[$canv bbox
$linehtag($row)] \
2227 -outline {{}} -tags secsel \
2228 -fill [$canv cget
-selectbackground]]
2233 proc bolden_name
{row font
} {
2234 global canv2 linentag selectedline boldnamerows
2236 lappend boldnamerows
$row
2237 $canv2 itemconf
$linentag($row) -font $font
2238 if {[info exists selectedline
] && $row == $selectedline} {
2239 $canv2 delete secsel
2240 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($row)] \
2241 -outline {{}} -tags secsel \
2242 -fill [$canv2 cget
-selectbackground]]
2251 foreach row
$boldrows {
2252 if {![ishighlighted
$row]} {
2253 bolden
$row mainfont
2255 lappend stillbold
$row
2258 set boldrows
$stillbold
2261 proc addvhighlight
{n
} {
2262 global hlview curview viewdata vhl_done vhighlights commitidx
2264 if {[info exists hlview
]} {
2268 if {$n != $curview && ![info exists viewdata
($n)]} {
2269 set viewdata
($n) [list getcommits
{{}} 0 0 0]
2270 set vparentlist
($n) {}
2271 set vdisporder
($n) {}
2272 set vcmitlisted
($n) {}
2275 set vhl_done
$commitidx($hlview)
2276 if {$vhl_done > 0} {
2281 proc delvhighlight
{} {
2282 global hlview vhighlights
2284 if {![info exists hlview
]} return
2286 catch
{unset vhighlights
}
2290 proc vhighlightmore
{} {
2291 global hlview vhl_done commitidx vhighlights
2292 global displayorder vdisporder curview
2294 set max
$commitidx($hlview)
2295 if {$hlview == $curview} {
2296 set disp
$displayorder
2298 set disp
$vdisporder($hlview)
2300 set vr
[visiblerows
]
2301 set r0
[lindex
$vr 0]
2302 set r1
[lindex
$vr 1]
2303 for {set i
$vhl_done} {$i < $max} {incr i
} {
2304 set id
[lindex
$disp $i]
2305 if {[info exists commitrow
($curview,$id)]} {
2306 set row
$commitrow($curview,$id)
2307 if {$r0 <= $row && $row <= $r1} {
2308 if {![highlighted
$row]} {
2309 bolden
$row mainfontbold
2311 set vhighlights
($row) 1
2318 proc askvhighlight
{row id
} {
2319 global hlview vhighlights commitrow iddrawn
2321 if {[info exists commitrow
($hlview,$id)]} {
2322 if {[info exists iddrawn
($id)] && ![ishighlighted
$row]} {
2323 bolden
$row mainfontbold
2325 set vhighlights
($row) 1
2327 set vhighlights
($row) 0
2331 proc hfiles_change
{} {
2332 global highlight_files filehighlight fhighlights fh_serial
2333 global highlight_paths gdttype
2335 if {[info exists filehighlight
]} {
2336 # delete previous highlights
2337 catch
{close
$filehighlight}
2339 catch
{unset fhighlights
}
2341 unhighlight_filelist
2343 set highlight_paths
{}
2344 after cancel do_file_hl
$fh_serial
2346 if {$highlight_files ne
{}} {
2347 after
300 do_file_hl
$fh_serial
2351 proc gdttype_change
{name ix op
} {
2352 global gdttype highlight_files findstring findpattern
2355 if {$findstring ne
{}} {
2356 if {$gdttype eq
[mc
"containing:"]} {
2357 if {$highlight_files ne
{}} {
2358 set highlight_files
{}
2363 if {$findpattern ne
{}} {
2367 set highlight_files
$findstring
2372 # enable/disable findtype/findloc menus too
2375 proc find_change
{name ix op
} {
2376 global gdttype findstring highlight_files
2379 if {$gdttype eq
[mc
"containing:"]} {
2382 if {$highlight_files ne
$findstring} {
2383 set highlight_files
$findstring
2390 proc findcom_change args
{
2391 global nhighlights boldnamerows
2392 global findpattern findtype findstring gdttype
2395 # delete previous highlights, if any
2396 foreach row
$boldnamerows {
2397 bolden_name
$row mainfont
2400 catch
{unset nhighlights
}
2403 if {$gdttype ne
[mc
"containing:"] ||
$findstring eq
{}} {
2405 } elseif
{$findtype eq
[mc
"Regexp"]} {
2406 set findpattern
$findstring
2408 set e
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2410 set findpattern
"*$e*"
2414 proc makepatterns
{l
} {
2417 set ee
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2418 if {[string index
$ee end
] eq
"/"} {
2428 proc do_file_hl
{serial
} {
2429 global highlight_files filehighlight highlight_paths gdttype fhl_list
2431 if {$gdttype eq
[mc
"touching paths:"]} {
2432 if {[catch
{set paths
[shellsplit
$highlight_files]}]} return
2433 set highlight_paths
[makepatterns
$paths]
2435 set gdtargs
[concat
-- $paths]
2436 } elseif
{$gdttype eq
[mc
"adding/removing string:"]} {
2437 set gdtargs
[list
"-S$highlight_files"]
2439 # must be "containing:", i.e. we're searching commit info
2442 set cmd
[concat | git diff-tree
-r -s --stdin $gdtargs]
2443 set filehighlight
[open
$cmd r
+]
2444 fconfigure
$filehighlight -blocking 0
2445 filerun
$filehighlight readfhighlight
2451 proc flushhighlights
{} {
2452 global filehighlight fhl_list
2454 if {[info exists filehighlight
]} {
2456 puts
$filehighlight ""
2457 flush
$filehighlight
2461 proc askfilehighlight
{row id
} {
2462 global filehighlight fhighlights fhl_list
2464 lappend fhl_list
$id
2465 set fhighlights
($row) -1
2466 puts
$filehighlight $id
2469 proc readfhighlight
{} {
2470 global filehighlight fhighlights commitrow curview iddrawn
2471 global fhl_list find_dirn
2473 if {![info exists filehighlight
]} {
2477 while {[incr nr
] <= 100 && [gets
$filehighlight line
] >= 0} {
2478 set line
[string trim
$line]
2479 set i
[lsearch
-exact $fhl_list $line]
2480 if {$i < 0} continue
2481 for {set j
0} {$j < $i} {incr j
} {
2482 set id
[lindex
$fhl_list $j]
2483 if {[info exists commitrow
($curview,$id)]} {
2484 set fhighlights
($commitrow($curview,$id)) 0
2487 set fhl_list
[lrange
$fhl_list [expr {$i+1}] end
]
2488 if {$line eq
{}} continue
2489 if {![info exists commitrow
($curview,$line)]} continue
2490 set row
$commitrow($curview,$line)
2491 if {[info exists iddrawn
($line)] && ![ishighlighted
$row]} {
2492 bolden
$row mainfontbold
2494 set fhighlights
($row) 1
2496 if {[eof
$filehighlight]} {
2498 puts
"oops, git diff-tree died"
2499 catch
{close
$filehighlight}
2503 if {[info exists find_dirn
]} {
2509 proc doesmatch
{f
} {
2510 global findtype findpattern
2512 if {$findtype eq
[mc
"Regexp"]} {
2513 return [regexp
$findpattern $f]
2514 } elseif
{$findtype eq
[mc
"IgnCase"]} {
2515 return [string match
-nocase $findpattern $f]
2517 return [string match
$findpattern $f]
2521 proc askfindhighlight
{row id
} {
2522 global nhighlights commitinfo iddrawn
2524 global markingmatches
2526 if {![info exists commitinfo
($id)]} {
2529 set info
$commitinfo($id)
2531 set fldtypes
[list
[mc Headline
] [mc Author
] [mc Date
] [mc Committer
] [mc CDate
] [mc Comments
]]
2532 foreach f
$info ty
$fldtypes {
2533 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
2535 if {$ty eq
[mc
"Author"]} {
2542 if {$isbold && [info exists iddrawn
($id)]} {
2543 if {![ishighlighted
$row]} {
2544 bolden
$row mainfontbold
2546 bolden_name
$row mainfontbold
2549 if {$markingmatches} {
2550 markrowmatches
$row $id
2553 set nhighlights
($row) $isbold
2556 proc markrowmatches
{row id
} {
2557 global canv canv2 linehtag linentag commitinfo findloc
2559 set headline
[lindex
$commitinfo($id) 0]
2560 set author
[lindex
$commitinfo($id) 1]
2561 $canv delete match
$row
2562 $canv2 delete match
$row
2563 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Headline"]} {
2564 set m
[findmatches
$headline]
2566 markmatches
$canv $row $headline $linehtag($row) $m \
2567 [$canv itemcget
$linehtag($row) -font] $row
2570 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Author"]} {
2571 set m
[findmatches
$author]
2573 markmatches
$canv2 $row $author $linentag($row) $m \
2574 [$canv2 itemcget
$linentag($row) -font] $row
2579 proc vrel_change
{name ix op
} {
2580 global highlight_related
2583 if {$highlight_related ne
[mc
"None"]} {
2588 # prepare for testing whether commits are descendents or ancestors of a
2589 proc rhighlight_sel
{a
} {
2590 global descendent desc_todo ancestor anc_todo
2591 global highlight_related rhighlights
2593 catch
{unset descendent
}
2594 set desc_todo
[list
$a]
2595 catch
{unset ancestor
}
2596 set anc_todo
[list
$a]
2597 if {$highlight_related ne
[mc
"None"]} {
2603 proc rhighlight_none
{} {
2606 catch
{unset rhighlights
}
2610 proc is_descendent
{a
} {
2611 global curview children commitrow descendent desc_todo
2614 set la
$commitrow($v,$a)
2618 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2619 set do [lindex
$todo $i]
2620 if {$commitrow($v,$do) < $la} {
2621 lappend leftover
$do
2624 foreach nk
$children($v,$do) {
2625 if {![info exists descendent
($nk)]} {
2626 set descendent
($nk) 1
2634 set desc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2638 set descendent
($a) 0
2639 set desc_todo
$leftover
2642 proc is_ancestor
{a
} {
2643 global curview parentlist commitrow ancestor anc_todo
2646 set la
$commitrow($v,$a)
2650 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2651 set do [lindex
$todo $i]
2652 if {![info exists commitrow
($v,$do)] ||
$commitrow($v,$do) > $la} {
2653 lappend leftover
$do
2656 foreach np
[lindex
$parentlist $commitrow($v,$do)] {
2657 if {![info exists ancestor
($np)]} {
2666 set anc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2671 set anc_todo
$leftover
2674 proc askrelhighlight
{row id
} {
2675 global descendent highlight_related iddrawn rhighlights
2676 global selectedline ancestor
2678 if {![info exists selectedline
]} return
2680 if {$highlight_related eq
[mc
"Descendant"] ||
2681 $highlight_related eq
[mc
"Not descendant"]} {
2682 if {![info exists descendent
($id)]} {
2685 if {$descendent($id) == ($highlight_related eq
[mc
"Descendant"])} {
2688 } elseif
{$highlight_related eq
[mc
"Ancestor"] ||
2689 $highlight_related eq
[mc
"Not ancestor"]} {
2690 if {![info exists ancestor
($id)]} {
2693 if {$ancestor($id) == ($highlight_related eq
[mc
"Ancestor"])} {
2697 if {[info exists iddrawn
($id)]} {
2698 if {$isbold && ![ishighlighted
$row]} {
2699 bolden
$row mainfontbold
2702 set rhighlights
($row) $isbold
2705 # Graph layout functions
2707 proc shortids
{ids
} {
2710 if {[llength
$id] > 1} {
2711 lappend res
[shortids
$id]
2712 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $id]} {
2713 lappend res
[string range
$id 0 7]
2724 for {set mask
1} {$mask <= $n} {incr mask
$mask} {
2725 if {($n & $mask) != 0} {
2726 set ret
[concat
$ret $o]
2728 set o
[concat
$o $o]
2733 # Work out where id should go in idlist so that order-token
2734 # values increase from left to right
2735 proc idcol
{idlist id
{i
0}} {
2736 global ordertok curview
2738 set t
$ordertok($curview,$id)
2739 if {$i >= [llength
$idlist] ||
2740 $t < $ordertok($curview,[lindex
$idlist $i])} {
2741 if {$i > [llength
$idlist]} {
2742 set i
[llength
$idlist]
2744 while {[incr i
-1] >= 0 &&
2745 $t < $ordertok($curview,[lindex
$idlist $i])} {}
2748 if {$t > $ordertok($curview,[lindex
$idlist $i])} {
2749 while {[incr i
] < [llength
$idlist] &&
2750 $t >= $ordertok($curview,[lindex
$idlist $i])} {}
2756 proc initlayout
{} {
2757 global rowidlist rowisopt rowfinal displayorder commitlisted
2758 global numcommits canvxmax canv
2761 global colormap rowtextx
2772 set canvxmax
[$canv cget
-width]
2773 catch
{unset colormap
}
2774 catch
{unset rowtextx
}
2778 proc setcanvscroll
{} {
2779 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2781 set ymax
[expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2782 $canv conf
-scrollregion [list
0 0 $canvxmax $ymax]
2783 $canv2 conf
-scrollregion [list
0 0 0 $ymax]
2784 $canv3 conf
-scrollregion [list
0 0 0 $ymax]
2787 proc visiblerows
{} {
2788 global canv numcommits linespc
2790 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2791 if {$ymax eq
{} ||
$ymax == 0} return
2793 set y0
[expr {int
([lindex
$f 0] * $ymax)}]
2794 set r0
[expr {int
(($y0 - 3) / $linespc) - 1}]
2798 set y1
[expr {int
([lindex
$f 1] * $ymax)}]
2799 set r1
[expr {int
(($y1 - 3) / $linespc) + 1}]
2800 if {$r1 >= $numcommits} {
2801 set r1
[expr {$numcommits - 1}]
2803 return [list
$r0 $r1]
2806 proc layoutmore
{} {
2807 global commitidx viewcomplete numcommits
2808 global uparrowlen downarrowlen mingaplen curview
2810 set show
$commitidx($curview)
2811 if {$show > $numcommits ||
$viewcomplete($curview)} {
2812 showstuff
$show $viewcomplete($curview)
2816 proc showstuff
{canshow last
} {
2817 global numcommits commitrow pending_select selectedline curview
2818 global mainheadid displayorder selectfirst
2819 global lastscrollset commitinterest
2821 if {$numcommits == 0} {
2823 set phase
"incrdraw"
2827 set prev
$numcommits
2828 set numcommits
$canshow
2829 set t
[clock clicks
-milliseconds]
2830 if {$prev < 100 ||
$last ||
$t - $lastscrollset > 500} {
2831 set lastscrollset
$t
2834 set rows
[visiblerows
]
2835 set r1
[lindex
$rows 1]
2836 if {$r1 >= $canshow} {
2837 set r1
[expr {$canshow - 1}]
2842 if {[info exists pending_select
] &&
2843 [info exists commitrow
($curview,$pending_select)] &&
2844 $commitrow($curview,$pending_select) < $numcommits} {
2845 selectline
$commitrow($curview,$pending_select) 1
2848 if {[info exists selectedline
] ||
[info exists pending_select
]} {
2851 set l
[first_real_row
]
2858 proc doshowlocalchanges
{} {
2859 global curview mainheadid phase commitrow
2861 if {[info exists commitrow
($curview,$mainheadid)] &&
2862 ($phase eq
{} ||
$commitrow($curview,$mainheadid) < $numcommits - 1)} {
2864 } elseif
{$phase ne
{}} {
2865 lappend commitinterest
($mainheadid) {}
2869 proc dohidelocalchanges
{} {
2870 global localfrow localirow lserial
2872 if {$localfrow >= 0} {
2873 removerow
$localfrow
2875 if {$localirow > 0} {
2879 if {$localirow >= 0} {
2880 removerow
$localirow
2886 # spawn off a process to do git diff-index --cached HEAD
2887 proc dodiffindex
{} {
2888 global localirow localfrow lserial showlocalchanges
2891 if {!$showlocalchanges ||
!$isworktree} return
2895 set fd
[open
"|git diff-index --cached HEAD" r
]
2896 fconfigure
$fd -blocking 0
2897 filerun
$fd [list readdiffindex
$fd $lserial]
2900 proc readdiffindex
{fd serial
} {
2901 global localirow commitrow mainheadid nullid2 curview
2902 global commitinfo commitdata lserial
2905 if {[gets
$fd line
] < 0} {
2911 # we only need to see one line and we don't really care what it says...
2914 # now see if there are any local changes not checked in to the index
2915 if {$serial == $lserial} {
2916 set fd
[open
"|git diff-files" r
]
2917 fconfigure
$fd -blocking 0
2918 filerun
$fd [list readdifffiles
$fd $serial]
2921 if {$isdiff && $serial == $lserial && $localirow == -1} {
2922 # add the line for the changes in the index to the graph
2923 set localirow
$commitrow($curview,$mainheadid)
2924 set hl
[mc
"Local changes checked in to index but not committed"]
2925 set commitinfo
($nullid2) [list
$hl {} {} {} {} " $hl\n"]
2926 set commitdata
($nullid2) "\n $hl\n"
2927 insertrow
$localirow $nullid2
2932 proc readdifffiles
{fd serial
} {
2933 global localirow localfrow commitrow mainheadid nullid curview
2934 global commitinfo commitdata lserial
2937 if {[gets
$fd line
] < 0} {
2943 # we only need to see one line and we don't really care what it says...
2946 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2947 # add the line for the local diff to the graph
2948 if {$localirow >= 0} {
2949 set localfrow
$localirow
2952 set localfrow
$commitrow($curview,$mainheadid)
2954 set hl
[mc
"Local uncommitted changes, not checked in to index"]
2955 set commitinfo
($nullid) [list
$hl {} {} {} {} " $hl\n"]
2956 set commitdata
($nullid) "\n $hl\n"
2957 insertrow
$localfrow $nullid
2962 proc nextuse
{id row
} {
2963 global commitrow curview children
2965 if {[info exists children
($curview,$id)]} {
2966 foreach kid
$children($curview,$id) {
2967 if {![info exists commitrow
($curview,$kid)]} {
2970 if {$commitrow($curview,$kid) > $row} {
2971 return $commitrow($curview,$kid)
2975 if {[info exists commitrow
($curview,$id)]} {
2976 return $commitrow($curview,$id)
2981 proc prevuse
{id row
} {
2982 global commitrow curview children
2985 if {[info exists children
($curview,$id)]} {
2986 foreach kid
$children($curview,$id) {
2987 if {![info exists commitrow
($curview,$kid)]} break
2988 if {$commitrow($curview,$kid) < $row} {
2989 set ret
$commitrow($curview,$kid)
2996 proc make_idlist
{row
} {
2997 global displayorder parentlist uparrowlen downarrowlen mingaplen
2998 global commitidx curview ordertok children commitrow
3000 set r
[expr {$row - $mingaplen - $downarrowlen - 1}]
3004 set ra
[expr {$row - $downarrowlen}]
3008 set rb
[expr {$row + $uparrowlen}]
3009 if {$rb > $commitidx($curview)} {
3010 set rb
$commitidx($curview)
3013 for {} {$r < $ra} {incr r
} {
3014 set nextid
[lindex
$displayorder [expr {$r + 1}]]
3015 foreach p
[lindex
$parentlist $r] {
3016 if {$p eq
$nextid} continue
3017 set rn
[nextuse
$p $r]
3019 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3020 lappend ids
[list
$ordertok($curview,$p) $p]
3024 for {} {$r < $row} {incr r
} {
3025 set nextid
[lindex
$displayorder [expr {$r + 1}]]
3026 foreach p
[lindex
$parentlist $r] {
3027 if {$p eq
$nextid} continue
3028 set rn
[nextuse
$p $r]
3029 if {$rn < 0 ||
$rn >= $row} {
3030 lappend ids
[list
$ordertok($curview,$p) $p]
3034 set id
[lindex
$displayorder $row]
3035 lappend ids
[list
$ordertok($curview,$id) $id]
3037 foreach p
[lindex
$parentlist $r] {
3038 set firstkid
[lindex
$children($curview,$p) 0]
3039 if {$commitrow($curview,$firstkid) < $row} {
3040 lappend ids
[list
$ordertok($curview,$p) $p]
3044 set id
[lindex
$displayorder $r]
3046 set firstkid
[lindex
$children($curview,$id) 0]
3047 if {$firstkid ne
{} && $commitrow($curview,$firstkid) < $row} {
3048 lappend ids
[list
$ordertok($curview,$id) $id]
3053 foreach idx
[lsort
-unique $ids] {
3054 lappend idlist
[lindex
$idx 1]
3059 proc rowsequal
{a b
} {
3060 while {[set i
[lsearch
-exact $a {}]] >= 0} {
3061 set a
[lreplace
$a $i $i]
3063 while {[set i
[lsearch
-exact $b {}]] >= 0} {
3064 set b
[lreplace
$b $i $i]
3066 return [expr {$a eq
$b}]
3069 proc makeupline
{id row rend
col} {
3070 global rowidlist uparrowlen downarrowlen mingaplen
3072 for {set r
$rend} {1} {set r
$rstart} {
3073 set rstart
[prevuse
$id $r]
3074 if {$rstart < 0} return
3075 if {$rstart < $row} break
3077 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3078 set rstart
[expr {$rend - $uparrowlen - 1}]
3080 for {set r
$rstart} {[incr r
] <= $row} {} {
3081 set idlist
[lindex
$rowidlist $r]
3082 if {$idlist ne
{} && [lsearch
-exact $idlist $id] < 0} {
3083 set col [idcol
$idlist $id $col]
3084 lset rowidlist
$r [linsert
$idlist $col $id]
3090 proc layoutrows
{row endrow
} {
3091 global rowidlist rowisopt rowfinal displayorder
3092 global uparrowlen downarrowlen maxwidth mingaplen
3093 global children parentlist
3094 global commitidx viewcomplete curview commitrow
3098 set rm1
[expr {$row - 1}]
3099 foreach id
[lindex
$rowidlist $rm1] {
3104 set final
[lindex
$rowfinal $rm1]
3106 for {} {$row < $endrow} {incr row
} {
3107 set rm1
[expr {$row - 1}]
3108 if {$rm1 < 0 ||
$idlist eq
{}} {
3109 set idlist
[make_idlist
$row]
3112 set id
[lindex
$displayorder $rm1]
3113 set col [lsearch
-exact $idlist $id]
3114 set idlist
[lreplace
$idlist $col $col]
3115 foreach p
[lindex
$parentlist $rm1] {
3116 if {[lsearch
-exact $idlist $p] < 0} {
3117 set col [idcol
$idlist $p $col]
3118 set idlist
[linsert
$idlist $col $p]
3119 # if not the first child, we have to insert a line going up
3120 if {$id ne
[lindex
$children($curview,$p) 0]} {
3121 makeupline
$p $rm1 $row $col
3125 set id
[lindex
$displayorder $row]
3126 if {$row > $downarrowlen} {
3127 set termrow
[expr {$row - $downarrowlen - 1}]
3128 foreach p
[lindex
$parentlist $termrow] {
3129 set i
[lsearch
-exact $idlist $p]
3130 if {$i < 0} continue
3131 set nr
[nextuse
$p $termrow]
3132 if {$nr < 0 ||
$nr >= $row + $mingaplen + $uparrowlen} {
3133 set idlist
[lreplace
$idlist $i $i]
3137 set col [lsearch
-exact $idlist $id]
3139 set col [idcol
$idlist $id]
3140 set idlist
[linsert
$idlist $col $id]
3141 if {$children($curview,$id) ne
{}} {
3142 makeupline
$id $rm1 $row $col
3145 set r
[expr {$row + $uparrowlen - 1}]
3146 if {$r < $commitidx($curview)} {
3148 foreach p
[lindex
$parentlist $r] {
3149 if {[lsearch
-exact $idlist $p] >= 0} continue
3150 set fk
[lindex
$children($curview,$p) 0]
3151 if {$commitrow($curview,$fk) < $row} {
3152 set x
[idcol
$idlist $p $x]
3153 set idlist
[linsert
$idlist $x $p]
3156 if {[incr r
] < $commitidx($curview)} {
3157 set p
[lindex
$displayorder $r]
3158 if {[lsearch
-exact $idlist $p] < 0} {
3159 set fk
[lindex
$children($curview,$p) 0]
3160 if {$fk ne
{} && $commitrow($curview,$fk) < $row} {
3161 set x
[idcol
$idlist $p $x]
3162 set idlist
[linsert
$idlist $x $p]
3168 if {$final && !$viewcomplete($curview) &&
3169 $row + $uparrowlen + $mingaplen + $downarrowlen
3170 >= $commitidx($curview)} {
3173 set l
[llength
$rowidlist]
3175 lappend rowidlist
$idlist
3177 lappend rowfinal
$final
3178 } elseif
{$row < $l} {
3179 if {![rowsequal
$idlist [lindex
$rowidlist $row]]} {
3180 lset rowidlist
$row $idlist
3183 lset rowfinal
$row $final
3185 set pad
[ntimes
[expr {$row - $l}] {}]
3186 set rowidlist
[concat
$rowidlist $pad]
3187 lappend rowidlist
$idlist
3188 set rowfinal
[concat
$rowfinal $pad]
3189 lappend rowfinal
$final
3190 set rowisopt
[concat
$rowisopt [ntimes
[expr {$row - $l + 1}] 0]]
3196 proc changedrow
{row
} {
3197 global displayorder iddrawn rowisopt need_redisplay
3199 set l
[llength
$rowisopt]
3201 lset rowisopt
$row 0
3202 if {$row + 1 < $l} {
3203 lset rowisopt
[expr {$row + 1}] 0
3204 if {$row + 2 < $l} {
3205 lset rowisopt
[expr {$row + 2}] 0
3209 set id
[lindex
$displayorder $row]
3210 if {[info exists iddrawn
($id)]} {
3211 set need_redisplay
1
3215 proc insert_pad
{row
col npad
} {
3218 set pad
[ntimes
$npad {}]
3219 set idlist
[lindex
$rowidlist $row]
3220 set bef
[lrange
$idlist 0 [expr {$col - 1}]]
3221 set aft
[lrange
$idlist $col end
]
3222 set i
[lsearch
-exact $aft {}]
3224 set aft
[lreplace
$aft $i $i]
3226 lset rowidlist
$row [concat
$bef $pad $aft]
3230 proc optimize_rows
{row
col endrow
} {
3231 global rowidlist rowisopt displayorder curview children
3236 for {} {$row < $endrow} {incr row
; set col 0} {
3237 if {[lindex
$rowisopt $row]} continue
3239 set y0
[expr {$row - 1}]
3240 set ym
[expr {$row - 2}]
3241 set idlist
[lindex
$rowidlist $row]
3242 set previdlist
[lindex
$rowidlist $y0]
3243 if {$idlist eq
{} ||
$previdlist eq
{}} continue
3245 set pprevidlist
[lindex
$rowidlist $ym]
3246 if {$pprevidlist eq
{}} continue
3252 for {} {$col < [llength
$idlist]} {incr
col} {
3253 set id
[lindex
$idlist $col]
3254 if {[lindex
$previdlist $col] eq
$id} continue
3259 set x0
[lsearch
-exact $previdlist $id]
3260 if {$x0 < 0} continue
3261 set z
[expr {$x0 - $col}]
3265 set xm
[lsearch
-exact $pprevidlist $id]
3267 set z0
[expr {$xm - $x0}]
3271 # if row y0 is the first child of $id then it's not an arrow
3272 if {[lindex
$children($curview,$id) 0] ne
3273 [lindex
$displayorder $y0]} {
3277 if {!$isarrow && $id ne
[lindex
$displayorder $row] &&
3278 [lsearch
-exact [lindex
$rowidlist [expr {$row+1}]] $id] < 0} {
3281 # Looking at lines from this row to the previous row,
3282 # make them go straight up if they end in an arrow on
3283 # the previous row; otherwise make them go straight up
3285 if {$z < -1 ||
($z < 0 && $isarrow)} {
3286 # Line currently goes left too much;
3287 # insert pads in the previous row, then optimize it
3288 set npad
[expr {-1 - $z + $isarrow}]
3289 insert_pad
$y0 $x0 $npad
3291 optimize_rows
$y0 $x0 $row
3293 set previdlist
[lindex
$rowidlist $y0]
3294 set x0
[lsearch
-exact $previdlist $id]
3295 set z
[expr {$x0 - $col}]
3297 set pprevidlist
[lindex
$rowidlist $ym]
3298 set xm
[lsearch
-exact $pprevidlist $id]
3299 set z0
[expr {$xm - $x0}]
3301 } elseif
{$z > 1 ||
($z > 0 && $isarrow)} {
3302 # Line currently goes right too much;
3303 # insert pads in this line
3304 set npad
[expr {$z - 1 + $isarrow}]
3305 insert_pad
$row $col $npad
3306 set idlist
[lindex
$rowidlist $row]
3308 set z
[expr {$x0 - $col}]
3311 if {$z0 eq
{} && !$isarrow && $ym >= 0} {
3312 # this line links to its first child on row $row-2
3313 set id
[lindex
$displayorder $ym]
3314 set xc
[lsearch
-exact $pprevidlist $id]
3316 set z0
[expr {$xc - $x0}]
3319 # avoid lines jigging left then immediately right
3320 if {$z0 ne
{} && $z < 0 && $z0 > 0} {
3321 insert_pad
$y0 $x0 1
3323 optimize_rows
$y0 $x0 $row
3324 set previdlist
[lindex
$rowidlist $y0]
3328 # Find the first column that doesn't have a line going right
3329 for {set col [llength
$idlist]} {[incr
col -1] >= 0} {} {
3330 set id
[lindex
$idlist $col]
3331 if {$id eq
{}} break
3332 set x0
[lsearch
-exact $previdlist $id]
3334 # check if this is the link to the first child
3335 set kid
[lindex
$displayorder $y0]
3336 if {[lindex
$children($curview,$id) 0] eq
$kid} {
3337 # it is, work out offset to child
3338 set x0
[lsearch
-exact $previdlist $kid]
3341 if {$x0 <= $col} break
3343 # Insert a pad at that column as long as it has a line and
3344 # isn't the last column
3345 if {$x0 >= 0 && [incr
col] < [llength
$idlist]} {
3346 set idlist
[linsert
$idlist $col {}]
3347 lset rowidlist
$row $idlist
3355 global canvx0 linespc
3356 return [expr {$canvx0 + $col * $linespc}]
3360 global canvy0 linespc
3361 return [expr {$canvy0 + $row * $linespc}]
3364 proc linewidth
{id
} {
3365 global thickerline lthickness
3368 if {[info exists thickerline
] && $id eq
$thickerline} {
3369 set wid
[expr {2 * $lthickness}]
3374 proc rowranges
{id
} {
3375 global commitrow curview children uparrowlen downarrowlen
3378 set kids
$children($curview,$id)
3384 foreach child
$kids {
3385 if {![info exists commitrow
($curview,$child)]} break
3386 set row
$commitrow($curview,$child)
3387 if {![info exists prev
]} {
3388 lappend ret
[expr {$row + 1}]
3390 if {$row <= $prevrow} {
3391 puts
"oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3393 # see if the line extends the whole way from prevrow to row
3394 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3395 [lsearch
-exact [lindex
$rowidlist \
3396 [expr {int
(($row + $prevrow) / 2)}]] $id] < 0} {
3397 # it doesn't, see where it ends
3398 set r
[expr {$prevrow + $downarrowlen}]
3399 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3400 while {[incr r
-1] > $prevrow &&
3401 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3403 while {[incr r
] <= $row &&
3404 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3408 # see where it starts up again
3409 set r
[expr {$row - $uparrowlen}]
3410 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3411 while {[incr r
] < $row &&
3412 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3414 while {[incr r
-1] >= $prevrow &&
3415 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3421 if {$child eq
$id} {
3430 proc drawlineseg
{id row endrow arrowlow
} {
3431 global rowidlist displayorder iddrawn linesegs
3432 global canv colormap linespc curview maxlinelen parentlist
3434 set cols
[list
[lsearch
-exact [lindex
$rowidlist $row] $id]]
3435 set le
[expr {$row + 1}]
3438 set c
[lsearch
-exact [lindex
$rowidlist $le] $id]
3444 set x
[lindex
$displayorder $le]
3449 if {[info exists iddrawn
($x)] ||
$le == $endrow} {
3450 set c
[lsearch
-exact [lindex
$rowidlist [expr {$le+1}]] $id]
3466 if {[info exists linesegs
($id)]} {
3467 set lines
$linesegs($id)
3469 set r0
[lindex
$li 0]
3471 if {$r0 == $le && [lindex
$li 1] - $row <= $maxlinelen} {
3481 set li
[lindex
$lines [expr {$i-1}]]
3482 set r1
[lindex
$li 1]
3483 if {$r1 == $row && $le - [lindex
$li 0] <= $maxlinelen} {
3488 set x
[lindex
$cols [expr {$le - $row}]]
3489 set xp
[lindex
$cols [expr {$le - 1 - $row}]]
3490 set dir
[expr {$xp - $x}]
3492 set ith
[lindex
$lines $i 2]
3493 set coords
[$canv coords
$ith]
3494 set ah
[$canv itemcget
$ith -arrow]
3495 set arrowhigh
[expr {$ah eq
"first" ||
$ah eq
"both"}]
3496 set x2
[lindex
$cols [expr {$le + 1 - $row}]]
3497 if {$x2 ne
{} && $x - $x2 == $dir} {
3498 set coords
[lrange
$coords 0 end-2
]
3501 set coords
[list
[xc
$le $x] [yc
$le]]
3504 set itl
[lindex
$lines [expr {$i-1}] 2]
3505 set al
[$canv itemcget
$itl -arrow]
3506 set arrowlow
[expr {$al eq
"last" ||
$al eq
"both"}]
3507 } elseif
{$arrowlow} {
3508 if {[lsearch
-exact [lindex
$rowidlist [expr {$row-1}]] $id] >= 0 ||
3509 [lsearch
-exact [lindex
$parentlist [expr {$row-1}]] $id] >= 0} {
3513 set arrow
[lindex
{none first last both
} [expr {$arrowhigh + 2*$arrowlow}]]
3514 for {set y
$le} {[incr y
-1] > $row} {} {
3516 set xp
[lindex
$cols [expr {$y - 1 - $row}]]
3517 set ndir
[expr {$xp - $x}]
3518 if {$dir != $ndir ||
$xp < 0} {
3519 lappend coords
[xc
$y $x] [yc
$y]
3525 # join parent line to first child
3526 set ch
[lindex
$displayorder $row]
3527 set xc
[lsearch
-exact [lindex
$rowidlist $row] $ch]
3529 puts
"oops: drawlineseg: child $ch not on row $row"
3530 } elseif
{$xc != $x} {
3531 if {($arrowhigh && $le == $row + 1) ||
$dir == 0} {
3532 set d
[expr {int
(0.5 * $linespc)}]
3535 set x2
[expr {$x1 - $d}]
3537 set x2
[expr {$x1 + $d}]
3540 set y1
[expr {$y2 + $d}]
3541 lappend coords
$x1 $y1 $x2 $y2
3542 } elseif
{$xc < $x - 1} {
3543 lappend coords
[xc
$row [expr {$x-1}]] [yc
$row]
3544 } elseif
{$xc > $x + 1} {
3545 lappend coords
[xc
$row [expr {$x+1}]] [yc
$row]
3549 lappend coords
[xc
$row $x] [yc
$row]
3551 set xn
[xc
$row $xp]
3553 lappend coords
$xn $yn
3557 set t
[$canv create line
$coords -width [linewidth
$id] \
3558 -fill $colormap($id) -tags lines.
$id -arrow $arrow]
3561 set lines
[linsert
$lines $i [list
$row $le $t]]
3563 $canv coords
$ith $coords
3564 if {$arrow ne
$ah} {
3565 $canv itemconf
$ith -arrow $arrow
3567 lset lines
$i 0 $row
3570 set xo
[lsearch
-exact [lindex
$rowidlist [expr {$row - 1}]] $id]
3571 set ndir
[expr {$xo - $xp}]
3572 set clow
[$canv coords
$itl]
3573 if {$dir == $ndir} {
3574 set clow
[lrange
$clow 2 end
]
3576 set coords
[concat
$coords $clow]
3578 lset lines
[expr {$i-1}] 1 $le
3580 # coalesce two pieces
3582 set b
[lindex
$lines [expr {$i-1}] 0]
3583 set e
[lindex
$lines $i 1]
3584 set lines
[lreplace
$lines [expr {$i-1}] $i [list
$b $e $itl]]
3586 $canv coords
$itl $coords
3587 if {$arrow ne
$al} {
3588 $canv itemconf
$itl -arrow $arrow
3592 set linesegs
($id) $lines
3596 proc drawparentlinks
{id row
} {
3597 global rowidlist canv colormap curview parentlist
3598 global idpos linespc
3600 set rowids
[lindex
$rowidlist $row]
3601 set col [lsearch
-exact $rowids $id]
3602 if {$col < 0} return
3603 set olds
[lindex
$parentlist $row]
3604 set row2
[expr {$row + 1}]
3605 set x
[xc
$row $col]
3608 set d
[expr {int
(0.5 * $linespc)}]
3609 set ymid
[expr {$y + $d}]
3610 set ids
[lindex
$rowidlist $row2]
3611 # rmx = right-most X coord used
3614 set i
[lsearch
-exact $ids $p]
3616 puts
"oops, parent $p of $id not in list"
3619 set x2
[xc
$row2 $i]
3623 set j
[lsearch
-exact $rowids $p]
3625 # drawlineseg will do this one for us
3629 # should handle duplicated parents here...
3630 set coords
[list
$x $y]
3632 # if attaching to a vertical segment, draw a smaller
3633 # slant for visual distinctness
3636 lappend coords
[expr {$x2 + $d}] $y $x2 $ymid
3638 lappend coords
[expr {$x2 - $d}] $y $x2 $ymid
3640 } elseif
{$i < $col && $i < $j} {
3641 # segment slants towards us already
3642 lappend coords
[xc
$row $j] $y
3644 if {$i < $col - 1} {
3645 lappend coords
[expr {$x2 + $linespc}] $y
3646 } elseif
{$i > $col + 1} {
3647 lappend coords
[expr {$x2 - $linespc}] $y
3649 lappend coords
$x2 $y2
3652 lappend coords
$x2 $y2
3654 set t
[$canv create line
$coords -width [linewidth
$p] \
3655 -fill $colormap($p) -tags lines.
$p]
3659 if {$rmx > [lindex
$idpos($id) 1]} {
3660 lset idpos
($id) 1 $rmx
3665 proc drawlines
{id
} {
3668 $canv itemconf lines.
$id -width [linewidth
$id]
3671 proc drawcmittext
{id row
col} {
3672 global linespc canv canv2 canv3 canvy0 fgcolor curview
3673 global commitlisted commitinfo rowidlist parentlist
3674 global rowtextx idpos idtags idheads idotherrefs
3675 global linehtag linentag linedtag selectedline
3676 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3678 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3679 set listed
[lindex
$commitlisted $row]
3680 if {$id eq
$nullid} {
3682 } elseif
{$id eq
$nullid2} {
3685 set ofill
[expr {$listed != 0 ?
$listed == 2 ?
"gray" : "blue" : "white"}]
3687 set x
[xc
$row $col]
3689 set orad
[expr {$linespc / 3}]
3691 set t
[$canv create oval
[expr {$x - $orad}] [expr {$y - $orad}] \
3692 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3693 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3694 } elseif
{$listed == 3} {
3695 # triangle pointing left for left-side commits
3696 set t
[$canv create polygon \
3697 [expr {$x - $orad}] $y \
3698 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3699 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3700 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3702 # triangle pointing right for right-side commits
3703 set t
[$canv create polygon \
3704 [expr {$x + $orad - 1}] $y \
3705 [expr {$x - $orad}] [expr {$y - $orad}] \
3706 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3707 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3710 $canv bind $t <1> {selcanvline
{} %x
%y
}
3711 set rmx
[llength
[lindex
$rowidlist $row]]
3712 set olds
[lindex
$parentlist $row]
3714 set nextids
[lindex
$rowidlist [expr {$row + 1}]]
3716 set i
[lsearch
-exact $nextids $p]
3722 set xt
[xc
$row $rmx]
3723 set rowtextx
($row) $xt
3724 set idpos
($id) [list
$x $xt $y]
3725 if {[info exists idtags
($id)] ||
[info exists idheads
($id)]
3726 ||
[info exists idotherrefs
($id)]} {
3727 set xt
[drawtags
$id $x $xt $y]
3729 set headline
[lindex
$commitinfo($id) 0]
3730 set name
[lindex
$commitinfo($id) 1]
3731 set date [lindex
$commitinfo($id) 2]
3732 set date [formatdate
$date]
3735 set isbold
[ishighlighted
$row]
3737 lappend boldrows
$row
3738 set font mainfontbold
3740 lappend boldnamerows
$row
3741 set nfont mainfontbold
3744 set linehtag
($row) [$canv create text
$xt $y -anchor w
-fill $fgcolor \
3745 -text $headline -font $font -tags text
]
3746 $canv bind $linehtag($row) <Button-3
> "rowmenu %X %Y $id"
3747 set linentag
($row) [$canv2 create text
3 $y -anchor w
-fill $fgcolor \
3748 -text $name -font $nfont -tags text
]
3749 set linedtag
($row) [$canv3 create text
3 $y -anchor w
-fill $fgcolor \
3750 -text $date -font mainfont
-tags text
]
3751 if {[info exists selectedline
] && $selectedline == $row} {
3754 set xr
[expr {$xt + [font measure
$font $headline]}]
3755 if {$xr > $canvxmax} {
3761 proc drawcmitrow
{row
} {
3762 global displayorder rowidlist nrows_drawn
3763 global iddrawn markingmatches
3764 global commitinfo parentlist numcommits
3765 global filehighlight fhighlights findpattern nhighlights
3766 global hlview vhighlights
3767 global highlight_related rhighlights
3769 if {$row >= $numcommits} return
3771 set id
[lindex
$displayorder $row]
3772 if {[info exists hlview
] && ![info exists vhighlights
($row)]} {
3773 askvhighlight
$row $id
3775 if {[info exists filehighlight
] && ![info exists fhighlights
($row)]} {
3776 askfilehighlight
$row $id
3778 if {$findpattern ne
{} && ![info exists nhighlights
($row)]} {
3779 askfindhighlight
$row $id
3781 if {$highlight_related ne
[mc
"None"] && ![info exists rhighlights
($row)]} {
3782 askrelhighlight
$row $id
3784 if {![info exists iddrawn
($id)]} {
3785 set col [lsearch
-exact [lindex
$rowidlist $row] $id]
3787 puts
"oops, row $row id $id not in list"
3790 if {![info exists commitinfo
($id)]} {
3794 drawcmittext
$id $row $col
3798 if {$markingmatches} {
3799 markrowmatches
$row $id
3803 proc drawcommits
{row
{endrow
{}}} {
3804 global numcommits iddrawn displayorder curview need_redisplay
3805 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3810 if {$endrow eq
{}} {
3813 if {$endrow >= $numcommits} {
3814 set endrow
[expr {$numcommits - 1}]
3817 set rl1
[expr {$row - $downarrowlen - 3}]
3821 set ro1
[expr {$row - 3}]
3825 set r2
[expr {$endrow + $uparrowlen + 3}]
3826 if {$r2 > $numcommits} {
3829 for {set r
$rl1} {$r < $r2} {incr r
} {
3830 if {[lindex
$rowidlist $r] ne
{} && [lindex
$rowfinal $r]} {
3834 set rl1
[expr {$r + 1}]
3840 optimize_rows
$ro1 0 $r2
3841 if {$need_redisplay ||
$nrows_drawn > 2000} {
3846 # make the lines join to already-drawn rows either side
3847 set r
[expr {$row - 1}]
3848 if {$r < 0 ||
![info exists iddrawn
([lindex
$displayorder $r])]} {
3851 set er
[expr {$endrow + 1}]
3852 if {$er >= $numcommits ||
3853 ![info exists iddrawn
([lindex
$displayorder $er])]} {
3856 for {} {$r <= $er} {incr r
} {
3857 set id
[lindex
$displayorder $r]
3858 set wasdrawn
[info exists iddrawn
($id)]
3860 if {$r == $er} break
3861 set nextid
[lindex
$displayorder [expr {$r + 1}]]
3862 if {$wasdrawn && [info exists iddrawn
($nextid)]} continue
3863 drawparentlinks
$id $r
3865 set rowids
[lindex
$rowidlist $r]
3866 foreach lid
$rowids {
3867 if {$lid eq
{}} continue
3868 if {[info exists lineend
($lid)] && $lineend($lid) > $r} continue
3870 # see if this is the first child of any of its parents
3871 foreach p
[lindex
$parentlist $r] {
3872 if {[lsearch
-exact $rowids $p] < 0} {
3873 # make this line extend up to the child
3874 set lineend
($p) [drawlineseg
$p $r $er 0]
3878 set lineend
($lid) [drawlineseg
$lid $r $er 1]
3884 proc drawfrac
{f0 f1
} {
3887 set ymax
[lindex
[$canv cget
-scrollregion] 3]
3888 if {$ymax eq
{} ||
$ymax == 0} return
3889 set y0
[expr {int
($f0 * $ymax)}]
3890 set row
[expr {int
(($y0 - 3) / $linespc) - 1}]
3891 set y1
[expr {int
($f1 * $ymax)}]
3892 set endrow
[expr {int
(($y1 - 3) / $linespc) + 1}]
3893 drawcommits
$row $endrow
3896 proc drawvisible
{} {
3898 eval drawfrac
[$canv yview
]
3901 proc clear_display
{} {
3902 global iddrawn linesegs need_redisplay nrows_drawn
3903 global vhighlights fhighlights nhighlights rhighlights
3906 catch
{unset iddrawn
}
3907 catch
{unset linesegs
}
3908 catch
{unset vhighlights
}
3909 catch
{unset fhighlights
}
3910 catch
{unset nhighlights
}
3911 catch
{unset rhighlights
}
3912 set need_redisplay
0
3916 proc findcrossings
{id
} {
3917 global rowidlist parentlist numcommits displayorder
3921 foreach
{s e
} [rowranges
$id] {
3922 if {$e >= $numcommits} {
3923 set e
[expr {$numcommits - 1}]
3925 if {$e <= $s} continue
3926 for {set row
$e} {[incr row
-1] >= $s} {} {
3927 set x
[lsearch
-exact [lindex
$rowidlist $row] $id]
3929 set olds
[lindex
$parentlist $row]
3930 set kid
[lindex
$displayorder $row]
3931 set kidx
[lsearch
-exact [lindex
$rowidlist $row] $kid]
3932 if {$kidx < 0} continue
3933 set nextrow
[lindex
$rowidlist [expr {$row + 1}]]
3935 set px
[lsearch
-exact $nextrow $p]
3936 if {$px < 0} continue
3937 if {($kidx < $x && $x < $px) ||
($px < $x && $x < $kidx)} {
3938 if {[lsearch
-exact $ccross $p] >= 0} continue
3939 if {$x == $px + ($kidx < $px?
-1: 1)} {
3941 } elseif
{[lsearch
-exact $cross $p] < 0} {
3948 return [concat
$ccross {{}} $cross]
3951 proc assigncolor
{id
} {
3952 global colormap colors nextcolor
3953 global commitrow parentlist children children curview
3955 if {[info exists colormap
($id)]} return
3956 set ncolors
[llength
$colors]
3957 if {[info exists children
($curview,$id)]} {
3958 set kids
$children($curview,$id)
3962 if {[llength
$kids] == 1} {
3963 set child
[lindex
$kids 0]
3964 if {[info exists colormap
($child)]
3965 && [llength
[lindex
$parentlist $commitrow($curview,$child)]] == 1} {
3966 set colormap
($id) $colormap($child)
3972 foreach x
[findcrossings
$id] {
3974 # delimiter between corner crossings and other crossings
3975 if {[llength
$badcolors] >= $ncolors - 1} break
3976 set origbad
$badcolors
3978 if {[info exists colormap
($x)]
3979 && [lsearch
-exact $badcolors $colormap($x)] < 0} {
3980 lappend badcolors
$colormap($x)
3983 if {[llength
$badcolors] >= $ncolors} {
3984 set badcolors
$origbad
3986 set origbad
$badcolors
3987 if {[llength
$badcolors] < $ncolors - 1} {
3988 foreach child
$kids {
3989 if {[info exists colormap
($child)]
3990 && [lsearch
-exact $badcolors $colormap($child)] < 0} {
3991 lappend badcolors
$colormap($child)
3993 foreach p
[lindex
$parentlist $commitrow($curview,$child)] {
3994 if {[info exists colormap
($p)]
3995 && [lsearch
-exact $badcolors $colormap($p)] < 0} {
3996 lappend badcolors
$colormap($p)
4000 if {[llength
$badcolors] >= $ncolors} {
4001 set badcolors
$origbad
4004 for {set i
0} {$i <= $ncolors} {incr i
} {
4005 set c
[lindex
$colors $nextcolor]
4006 if {[incr nextcolor
] >= $ncolors} {
4009 if {[lsearch
-exact $badcolors $c]} break
4011 set colormap
($id) $c
4014 proc bindline
{t id
} {
4017 $canv bind $t <Enter
> "lineenter %x %y $id"
4018 $canv bind $t <Motion
> "linemotion %x %y $id"
4019 $canv bind $t <Leave
> "lineleave $id"
4020 $canv bind $t <Button-1
> "lineclick %x %y $id 1"
4023 proc drawtags
{id x xt y1
} {
4024 global idtags idheads idotherrefs mainhead
4025 global linespc lthickness
4026 global canv commitrow rowtextx curview fgcolor bgcolor
4031 if {[info exists idtags
($id)]} {
4032 set marks
$idtags($id)
4033 set ntags
[llength
$marks]
4035 if {[info exists idheads
($id)]} {
4036 set marks
[concat
$marks $idheads($id)]
4037 set nheads
[llength
$idheads($id)]
4039 if {[info exists idotherrefs
($id)]} {
4040 set marks
[concat
$marks $idotherrefs($id)]
4046 set delta
[expr {int
(0.5 * ($linespc - $lthickness))}]
4047 set yt
[expr {$y1 - 0.5 * $linespc}]
4048 set yb
[expr {$yt + $linespc - 1}]
4052 foreach tag
$marks {
4054 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq
$mainhead} {
4055 set wid
[font measure mainfontbold
$tag]
4057 set wid
[font measure mainfont
$tag]
4061 set xt
[expr {$xt + $delta + $wid + $lthickness + $linespc}]
4063 set t
[$canv create line
$x $y1 [lindex
$xvals end
] $y1 \
4064 -width $lthickness -fill black
-tags tag.
$id]
4066 foreach tag
$marks x
$xvals wid
$wvals {
4067 set xl
[expr {$x + $delta}]
4068 set xr
[expr {$x + $delta + $wid + $lthickness}]
4070 if {[incr ntags
-1] >= 0} {
4072 set t
[$canv create polygon
$x [expr {$yt + $delta}] $xl $yt \
4073 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4074 -width 1 -outline black
-fill yellow
-tags tag.
$id]
4075 $canv bind $t <1> [list showtag
$tag 1]
4076 set rowtextx
($commitrow($curview,$id)) [expr {$xr + $linespc}]
4078 # draw a head or other ref
4079 if {[incr nheads
-1] >= 0} {
4081 if {$tag eq
$mainhead} {
4082 set font mainfontbold
4087 set xl
[expr {$xl - $delta/2}]
4088 $canv create polygon
$x $yt $xr $yt $xr $yb $x $yb \
4089 -width 1 -outline black
-fill $col -tags tag.
$id
4090 if {[regexp
{^
(remotes
/.
*/|remotes
/)} $tag match remoteprefix
]} {
4091 set rwid
[font measure mainfont
$remoteprefix]
4092 set xi
[expr {$x + 1}]
4093 set yti
[expr {$yt + 1}]
4094 set xri
[expr {$x + $rwid}]
4095 $canv create polygon
$xi $yti $xri $yti $xri $yb $xi $yb \
4096 -width 0 -fill "#ffddaa" -tags tag.
$id
4099 set t
[$canv create text
$xl $y1 -anchor w
-text $tag -fill $fgcolor \
4100 -font $font -tags [list tag.
$id text
]]
4102 $canv bind $t <1> [list showtag
$tag 1]
4103 } elseif
{$nheads >= 0} {
4104 $canv bind $t <Button-3
> [list headmenu
%X
%Y
$id $tag]
4110 proc xcoord
{i level
ln} {
4111 global canvx0 xspc1 xspc2
4113 set x
[expr {$canvx0 + $i * $xspc1($ln)}]
4114 if {$i > 0 && $i == $level} {
4115 set x
[expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4116 } elseif
{$i > $level} {
4117 set x
[expr {$x + $xspc2 - $xspc1($ln)}]
4122 proc show_status
{msg
} {
4126 $canv create text
3 3 -anchor nw
-text $msg -font mainfont \
4127 -tags text
-fill $fgcolor
4130 # Insert a new commit as the child of the commit on row $row.
4131 # The new commit will be displayed on row $row and the commits
4132 # on that row and below will move down one row.
4133 proc insertrow
{row newcmit
} {
4134 global displayorder parentlist commitlisted children
4135 global commitrow curview rowidlist rowisopt rowfinal numcommits
4137 global selectedline commitidx ordertok
4139 if {$row >= $numcommits} {
4140 puts
"oops, inserting new row $row but only have $numcommits rows"
4143 set p
[lindex
$displayorder $row]
4144 set displayorder
[linsert
$displayorder $row $newcmit]
4145 set parentlist
[linsert
$parentlist $row $p]
4146 set kids
$children($curview,$p)
4147 lappend kids
$newcmit
4148 set children
($curview,$p) $kids
4149 set children
($curview,$newcmit) {}
4150 set commitlisted
[linsert
$commitlisted $row 1]
4151 set l
[llength
$displayorder]
4152 for {set r
$row} {$r < $l} {incr r
} {
4153 set id
[lindex
$displayorder $r]
4154 set commitrow
($curview,$id) $r
4156 incr commitidx
($curview)
4157 set ordertok
($curview,$newcmit) $ordertok($curview,$p)
4159 if {$row < [llength
$rowidlist]} {
4160 set idlist
[lindex
$rowidlist $row]
4161 if {$idlist ne
{}} {
4162 if {[llength
$kids] == 1} {
4163 set col [lsearch
-exact $idlist $p]
4164 lset idlist
$col $newcmit
4166 set col [llength
$idlist]
4167 lappend idlist
$newcmit
4170 set rowidlist
[linsert
$rowidlist $row $idlist]
4171 set rowisopt
[linsert
$rowisopt $row 0]
4172 set rowfinal
[linsert
$rowfinal $row [lindex
$rowfinal $row]]
4177 if {[info exists selectedline
] && $selectedline >= $row} {
4183 # Remove a commit that was inserted with insertrow on row $row.
4184 proc removerow
{row
} {
4185 global displayorder parentlist commitlisted children
4186 global commitrow curview rowidlist rowisopt rowfinal numcommits
4188 global linesegends selectedline commitidx
4190 if {$row >= $numcommits} {
4191 puts
"oops, removing row $row but only have $numcommits rows"
4194 set rp1
[expr {$row + 1}]
4195 set id
[lindex
$displayorder $row]
4196 set p
[lindex
$parentlist $row]
4197 set displayorder
[lreplace
$displayorder $row $row]
4198 set parentlist
[lreplace
$parentlist $row $row]
4199 set commitlisted
[lreplace
$commitlisted $row $row]
4200 set kids
$children($curview,$p)
4201 set i
[lsearch
-exact $kids $id]
4203 set kids
[lreplace
$kids $i $i]
4204 set children
($curview,$p) $kids
4206 set l
[llength
$displayorder]
4207 for {set r
$row} {$r < $l} {incr r
} {
4208 set id
[lindex
$displayorder $r]
4209 set commitrow
($curview,$id) $r
4211 incr commitidx
($curview) -1
4213 if {$row < [llength
$rowidlist]} {
4214 set rowidlist
[lreplace
$rowidlist $row $row]
4215 set rowisopt
[lreplace
$rowisopt $row $row]
4216 set rowfinal
[lreplace
$rowfinal $row $row]
4221 if {[info exists selectedline
] && $selectedline > $row} {
4222 incr selectedline
-1
4227 # Don't change the text pane cursor if it is currently the hand cursor,
4228 # showing that we are over a sha1 ID link.
4229 proc settextcursor
{c
} {
4230 global ctext curtextcursor
4232 if {[$ctext cget
-cursor] == $curtextcursor} {
4233 $ctext config
-cursor $c
4235 set curtextcursor
$c
4238 proc nowbusy
{what
{name
{}}} {
4239 global isbusy busyname statusw
4241 if {[array names isbusy
] eq
{}} {
4242 . config
-cursor watch
4246 set busyname
($what) $name
4248 $statusw conf
-text $name
4252 proc notbusy
{what
} {
4253 global isbusy maincursor textcursor busyname statusw
4257 if {$busyname($what) ne
{} &&
4258 [$statusw cget
-text] eq
$busyname($what)} {
4259 $statusw conf
-text {}
4262 if {[array names isbusy
] eq
{}} {
4263 . config
-cursor $maincursor
4264 settextcursor
$textcursor
4268 proc findmatches
{f
} {
4269 global findtype findstring
4270 if {$findtype == [mc
"Regexp"]} {
4271 set matches
[regexp
-indices -all -inline $findstring $f]
4274 if {$findtype == [mc
"IgnCase"]} {
4275 set f
[string tolower
$f]
4276 set fs
[string tolower
$fs]
4280 set l
[string length
$fs]
4281 while {[set j
[string first
$fs $f $i]] >= 0} {
4282 lappend matches
[list
$j [expr {$j+$l-1}]]
4283 set i
[expr {$j + $l}]
4289 proc dofind
{{dirn
1} {wrap
1}} {
4290 global findstring findstartline findcurline selectedline numcommits
4291 global gdttype filehighlight fh_serial find_dirn findallowwrap
4293 if {[info exists find_dirn
]} {
4294 if {$find_dirn == $dirn} return
4298 if {$findstring eq
{} ||
$numcommits == 0} return
4299 if {![info exists selectedline
]} {
4300 set findstartline
[lindex
[visiblerows
] [expr {$dirn < 0}]]
4302 set findstartline
$selectedline
4304 set findcurline
$findstartline
4305 nowbusy finding
[mc
"Searching"]
4306 if {$gdttype ne
[mc
"containing:"] && ![info exists filehighlight
]} {
4307 after cancel do_file_hl
$fh_serial
4308 do_file_hl
$fh_serial
4311 set findallowwrap
$wrap
4315 proc stopfinding
{} {
4316 global find_dirn findcurline fprogcoord
4318 if {[info exists find_dirn
]} {
4328 global commitdata commitinfo numcommits findpattern findloc
4329 global findstartline findcurline displayorder
4330 global find_dirn gdttype fhighlights fprogcoord
4331 global findallowwrap
4333 if {![info exists find_dirn
]} {
4336 set fldtypes
[list
[mc
"Headline"] [mc
"Author"] [mc
"Date"] [mc
"Committer"] [mc
"CDate"] [mc
"Comments"]]
4339 if {$find_dirn > 0} {
4341 if {$l >= $numcommits} {
4344 if {$l <= $findstartline} {
4345 set lim
[expr {$findstartline + 1}]
4348 set moretodo
$findallowwrap
4355 if {$l >= $findstartline} {
4356 set lim
[expr {$findstartline - 1}]
4359 set moretodo
$findallowwrap
4362 set n
[expr {($lim - $l) * $find_dirn}]
4369 if {$gdttype eq
[mc
"containing:"]} {
4370 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4371 set id
[lindex
$displayorder $l]
4372 # shouldn't happen unless git log doesn't give all the commits...
4373 if {![info exists commitdata
($id)]} continue
4374 if {![doesmatch
$commitdata($id)]} continue
4375 if {![info exists commitinfo
($id)]} {
4378 set info
$commitinfo($id)
4379 foreach f
$info ty
$fldtypes {
4380 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
4389 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4390 set id
[lindex
$displayorder $l]
4391 if {![info exists fhighlights
($l)]} {
4392 askfilehighlight
$l $id
4395 set findcurline
[expr {$l - $find_dirn}]
4397 } elseif
{$fhighlights($l)} {
4403 if {$found ||
($domore && !$moretodo)} {
4419 set findcurline
[expr {$l - $find_dirn}]
4421 set n
[expr {($findcurline - $findstartline) * $find_dirn - 1}]
4425 set fprogcoord
[expr {$n * 1.0 / $numcommits}]
4430 proc findselectline
{l
} {
4431 global findloc commentend ctext findcurline markingmatches gdttype
4433 set markingmatches
1
4436 if {$findloc == [mc
"All fields"] ||
$findloc == [mc
"Comments"]} {
4437 # highlight the matches in the comments
4438 set f
[$ctext get
1.0 $commentend]
4439 set matches
[findmatches
$f]
4440 foreach match
$matches {
4441 set start
[lindex
$match 0]
4442 set end
[expr {[lindex
$match 1] + 1}]
4443 $ctext tag add found
"1.0 + $start c" "1.0 + $end c"
4449 # mark the bits of a headline or author that match a find string
4450 proc markmatches
{canv l str tag matches font row
} {
4453 set bbox
[$canv bbox
$tag]
4454 set x0
[lindex
$bbox 0]
4455 set y0
[lindex
$bbox 1]
4456 set y1
[lindex
$bbox 3]
4457 foreach match
$matches {
4458 set start
[lindex
$match 0]
4459 set end
[lindex
$match 1]
4460 if {$start > $end} continue
4461 set xoff
[font measure
$font [string range
$str 0 [expr {$start-1}]]]
4462 set xlen
[font measure
$font [string range
$str 0 [expr {$end}]]]
4463 set t
[$canv create rect
[expr {$x0+$xoff}] $y0 \
4464 [expr {$x0+$xlen+2}] $y1 \
4465 -outline {} -tags [list match
$l matches
] -fill yellow
]
4467 if {[info exists selectedline
] && $row == $selectedline} {
4468 $canv raise
$t secsel
4473 proc unmarkmatches
{} {
4474 global markingmatches
4476 allcanvs delete matches
4477 set markingmatches
0
4481 proc selcanvline
{w x y
} {
4482 global canv canvy0 ctext linespc
4484 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4485 if {$ymax == {}} return
4486 set yfrac
[lindex
[$canv yview
] 0]
4487 set y
[expr {$y + $yfrac * $ymax}]
4488 set l
[expr {int
(($y - $canvy0) / $linespc + 0.5)}]
4493 if {![info exists rowtextx
($l)] ||
$x < $rowtextx($l)} return
4499 proc commit_descriptor
{p
} {
4501 if {![info exists commitinfo
($p)]} {
4505 if {[llength
$commitinfo($p)] > 1} {
4506 set l
[lindex
$commitinfo($p) 0]
4511 # append some text to the ctext widget, and make any SHA1 ID
4512 # that we know about be a clickable link.
4513 proc appendwithlinks
{text tags
} {
4514 global ctext commitrow linknum curview pendinglinks
4516 set start
[$ctext index
"end - 1c"]
4517 $ctext insert end
$text $tags
4518 set links
[regexp
-indices -all -inline {[0-9a-f]{40}} $text]
4522 set linkid
[string range
$text $s $e]
4524 $ctext tag delete link
$linknum
4525 $ctext tag add link
$linknum "$start + $s c" "$start + $e c"
4526 setlink
$linkid link
$linknum
4531 proc setlink
{id lk
} {
4532 global curview commitrow ctext pendinglinks commitinterest
4534 if {[info exists commitrow
($curview,$id)]} {
4535 $ctext tag conf
$lk -foreground blue
-underline 1
4536 $ctext tag
bind $lk <1> [list selectline
$commitrow($curview,$id) 1]
4537 $ctext tag
bind $lk <Enter
> {linkcursor
%W
1}
4538 $ctext tag
bind $lk <Leave
> {linkcursor
%W
-1}
4540 lappend pendinglinks
($id) $lk
4541 lappend commitinterest
($id) {makelink
%I
}
4545 proc makelink
{id
} {
4548 if {![info exists pendinglinks
($id)]} return
4549 foreach lk
$pendinglinks($id) {
4552 unset pendinglinks
($id)
4555 proc linkcursor
{w inc
} {
4556 global linkentercount curtextcursor
4558 if {[incr linkentercount
$inc] > 0} {
4559 $w configure
-cursor hand2
4561 $w configure
-cursor $curtextcursor
4562 if {$linkentercount < 0} {
4563 set linkentercount
0
4568 proc viewnextline
{dir
} {
4572 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4573 set wnow
[$canv yview
]
4574 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4575 set newtop
[expr {$wtop + $dir * $linespc}]
4578 } elseif
{$newtop > $ymax} {
4581 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4584 # add a list of tag or branch names at position pos
4585 # returns the number of names inserted
4586 proc appendrefs
{pos ids var
} {
4587 global ctext commitrow linknum curview
$var maxrefs
4589 if {[catch
{$ctext index
$pos}]} {
4592 $ctext conf
-state normal
4593 $ctext delete
$pos "$pos lineend"
4596 foreach tag
[set $var\
($id\
)] {
4597 lappend tags
[list
$tag $id]
4600 if {[llength
$tags] > $maxrefs} {
4601 $ctext insert
$pos "many ([llength $tags])"
4603 set tags
[lsort
-index 0 -decreasing $tags]
4606 set id
[lindex
$ti 1]
4609 $ctext tag delete
$lk
4610 $ctext insert
$pos $sep
4611 $ctext insert
$pos [lindex
$ti 0] $lk
4616 $ctext conf
-state disabled
4617 return [llength
$tags]
4620 # called when we have finished computing the nearby tags
4621 proc dispneartags
{delay
} {
4622 global selectedline currentid showneartags tagphase
4624 if {![info exists selectedline
] ||
!$showneartags} return
4625 after cancel dispnexttag
4627 after
200 dispnexttag
4630 after idle dispnexttag
4635 proc dispnexttag
{} {
4636 global selectedline currentid showneartags tagphase ctext
4638 if {![info exists selectedline
] ||
!$showneartags} return
4639 switch
-- $tagphase {
4641 set dtags
[desctags
$currentid]
4643 appendrefs precedes
$dtags idtags
4647 set atags
[anctags
$currentid]
4649 appendrefs follows
$atags idtags
4653 set dheads
[descheads
$currentid]
4654 if {$dheads ne
{}} {
4655 if {[appendrefs branch
$dheads idheads
] > 1
4656 && [$ctext get
"branch -3c"] eq
"h"} {
4657 # turn "Branch" into "Branches"
4658 $ctext conf
-state normal
4659 $ctext insert
"branch -2c" "es"
4660 $ctext conf
-state disabled
4665 if {[incr tagphase
] <= 2} {
4666 after idle dispnexttag
4670 proc make_secsel
{l
} {
4671 global linehtag linentag linedtag canv canv2 canv3
4673 if {![info exists linehtag
($l)]} return
4675 set t
[eval $canv create rect
[$canv bbox
$linehtag($l)] -outline {{}} \
4676 -tags secsel
-fill [$canv cget
-selectbackground]]
4678 $canv2 delete secsel
4679 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($l)] -outline {{}} \
4680 -tags secsel
-fill [$canv2 cget
-selectbackground]]
4682 $canv3 delete secsel
4683 set t
[eval $canv3 create rect
[$canv3 bbox
$linedtag($l)] -outline {{}} \
4684 -tags secsel
-fill [$canv3 cget
-selectbackground]]
4688 proc selectline
{l isnew
} {
4689 global canv ctext commitinfo selectedline
4691 global canvy0 linespc parentlist children curview
4692 global currentid sha1entry
4693 global commentend idtags linknum
4694 global mergemax numcommits pending_select
4695 global cmitmode showneartags allcommits
4698 catch
{unset pending_select
}
4703 if {$l < 0 ||
$l >= $numcommits} return
4704 set y
[expr {$canvy0 + $l * $linespc}]
4705 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4706 set ytop
[expr {$y - $linespc - 1}]
4707 set ybot
[expr {$y + $linespc + 1}]
4708 set wnow
[$canv yview
]
4709 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4710 set wbot
[expr {[lindex
$wnow 1] * $ymax}]
4711 set wh
[expr {$wbot - $wtop}]
4713 if {$ytop < $wtop} {
4714 if {$ybot < $wtop} {
4715 set newtop
[expr {$y - $wh / 2.0}]
4718 if {$newtop > $wtop - $linespc} {
4719 set newtop
[expr {$wtop - $linespc}]
4722 } elseif
{$ybot > $wbot} {
4723 if {$ytop > $wbot} {
4724 set newtop
[expr {$y - $wh / 2.0}]
4726 set newtop
[expr {$ybot - $wh}]
4727 if {$newtop < $wtop + $linespc} {
4728 set newtop
[expr {$wtop + $linespc}]
4732 if {$newtop != $wtop} {
4736 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4743 addtohistory
[list selectline
$l 0]
4748 set id
[lindex
$displayorder $l]
4750 $sha1entry delete
0 end
4751 $sha1entry insert
0 $id
4753 $sha1entry selection from
0
4754 $sha1entry selection to end
4758 $ctext conf
-state normal
4761 set info
$commitinfo($id)
4762 set date [formatdate
[lindex
$info 2]]
4763 $ctext insert end
"[mc "Author
"]: [lindex $info 1] $date\n"
4764 set date [formatdate
[lindex
$info 4]]
4765 $ctext insert end
"[mc "Committer
"]: [lindex $info 3] $date\n"
4766 if {[info exists idtags
($id)]} {
4767 $ctext insert end
[mc
"Tags:"]
4768 foreach tag
$idtags($id) {
4769 $ctext insert end
" $tag"
4771 $ctext insert end
"\n"
4775 set olds
[lindex
$parentlist $l]
4776 if {[llength
$olds] > 1} {
4779 if {$np >= $mergemax} {
4784 $ctext insert end
"[mc "Parent
"]: " $tag
4785 appendwithlinks
[commit_descriptor
$p] {}
4790 append headers
"[mc "Parent
"]: [commit_descriptor $p]"
4794 foreach c
$children($curview,$id) {
4795 append headers
"[mc "Child
"]: [commit_descriptor $c]"
4798 # make anything that looks like a SHA1 ID be a clickable link
4799 appendwithlinks
$headers {}
4800 if {$showneartags} {
4801 if {![info exists allcommits
]} {
4804 $ctext insert end
"[mc "Branch
"]: "
4805 $ctext mark
set branch
"end -1c"
4806 $ctext mark gravity branch left
4807 $ctext insert end
"\n[mc "Follows
"]: "
4808 $ctext mark
set follows
"end -1c"
4809 $ctext mark gravity follows left
4810 $ctext insert end
"\n[mc "Precedes
"]: "
4811 $ctext mark
set precedes
"end -1c"
4812 $ctext mark gravity precedes left
4813 $ctext insert end
"\n"
4816 $ctext insert end
"\n"
4817 set comment
[lindex
$info 5]
4818 if {[string first
"\r" $comment] >= 0} {
4819 set comment
[string map
{"\r" "\n "} $comment]
4821 appendwithlinks
$comment {comment
}
4823 $ctext tag remove found
1.0 end
4824 $ctext conf
-state disabled
4825 set commentend
[$ctext index
"end - 1c"]
4827 init_flist
[mc
"Comments"]
4828 if {$cmitmode eq
"tree"} {
4830 } elseif
{[llength
$olds] <= 1} {
4837 proc selfirstline
{} {
4842 proc sellastline
{} {
4845 set l
[expr {$numcommits - 1}]
4849 proc selnextline
{dir
} {
4852 if {![info exists selectedline
]} return
4853 set l
[expr {$selectedline + $dir}]
4858 proc selnextpage
{dir
} {
4859 global canv linespc selectedline numcommits
4861 set lpp
[expr {([winfo height
$canv] - 2) / $linespc}]
4865 allcanvs yview scroll
[expr {$dir * $lpp}] units
4867 if {![info exists selectedline
]} return
4868 set l
[expr {$selectedline + $dir * $lpp}]
4871 } elseif
{$l >= $numcommits} {
4872 set l
[expr $numcommits - 1]
4878 proc unselectline
{} {
4879 global selectedline currentid
4881 catch
{unset selectedline
}
4882 catch
{unset currentid
}
4883 allcanvs delete secsel
4887 proc reselectline
{} {
4890 if {[info exists selectedline
]} {
4891 selectline
$selectedline 0
4895 proc addtohistory
{cmd
} {
4896 global
history historyindex curview
4898 set elt
[list
$curview $cmd]
4899 if {$historyindex > 0
4900 && [lindex
$history [expr {$historyindex - 1}]] == $elt} {
4904 if {$historyindex < [llength
$history]} {
4905 set history [lreplace
$history $historyindex end
$elt]
4907 lappend
history $elt
4910 if {$historyindex > 1} {
4911 .tf.bar.leftbut conf
-state normal
4913 .tf.bar.leftbut conf
-state disabled
4915 .tf.bar.rightbut conf
-state disabled
4921 set view
[lindex
$elt 0]
4922 set cmd
[lindex
$elt 1]
4923 if {$curview != $view} {
4930 global
history historyindex
4933 if {$historyindex > 1} {
4934 incr historyindex
-1
4935 godo
[lindex
$history [expr {$historyindex - 1}]]
4936 .tf.bar.rightbut conf
-state normal
4938 if {$historyindex <= 1} {
4939 .tf.bar.leftbut conf
-state disabled
4944 global
history historyindex
4947 if {$historyindex < [llength
$history]} {
4948 set cmd
[lindex
$history $historyindex]
4951 .tf.bar.leftbut conf
-state normal
4953 if {$historyindex >= [llength
$history]} {
4954 .tf.bar.rightbut conf
-state disabled
4959 global treefilelist treeidlist diffids diffmergeid treepending
4960 global nullid nullid2
4963 catch
{unset diffmergeid
}
4964 if {![info exists treefilelist
($id)]} {
4965 if {![info exists treepending
]} {
4966 if {$id eq
$nullid} {
4967 set cmd
[list | git ls-files
]
4968 } elseif
{$id eq
$nullid2} {
4969 set cmd
[list | git ls-files
--stage -t]
4971 set cmd
[list | git ls-tree
-r $id]
4973 if {[catch
{set gtf
[open
$cmd r
]}]} {
4977 set treefilelist
($id) {}
4978 set treeidlist
($id) {}
4979 fconfigure
$gtf -blocking 0
4980 filerun
$gtf [list gettreeline
$gtf $id]
4987 proc gettreeline
{gtf id
} {
4988 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4991 while {[incr
nl] <= 1000 && [gets
$gtf line
] >= 0} {
4992 if {$diffids eq
$nullid} {
4995 set i
[string first
"\t" $line]
4996 if {$i < 0} continue
4997 set fname
[string range
$line [expr {$i+1}] end
]
4998 set line
[string range
$line 0 [expr {$i-1}]]
4999 if {$diffids ne
$nullid2 && [lindex
$line 1] ne
"blob"} continue
5000 set sha1
[lindex
$line 2]
5001 if {[string index
$fname 0] eq
"\""} {
5002 set fname
[lindex
$fname 0]
5004 lappend treeidlist
($id) $sha1
5006 lappend treefilelist
($id) $fname
5009 return [expr {$nl >= 1000?
2: 1}]
5013 if {$cmitmode ne
"tree"} {
5014 if {![info exists diffmergeid
]} {
5015 gettreediffs
$diffids
5017 } elseif
{$id ne
$diffids} {
5026 global treefilelist treeidlist diffids nullid nullid2
5027 global ctext commentend
5029 set i
[lsearch
-exact $treefilelist($diffids) $f]
5031 puts
"oops, $f not in list for id $diffids"
5034 if {$diffids eq
$nullid} {
5035 if {[catch
{set bf
[open
$f r
]} err
]} {
5036 puts
"oops, can't read $f: $err"
5040 set blob
[lindex
$treeidlist($diffids) $i]
5041 if {[catch
{set bf
[open
[concat | git cat-file blob
$blob] r
]} err
]} {
5042 puts
"oops, error reading blob $blob: $err"
5046 fconfigure
$bf -blocking 0
5047 filerun
$bf [list getblobline
$bf $diffids]
5048 $ctext config
-state normal
5049 clear_ctext
$commentend
5050 $ctext insert end
"\n"
5051 $ctext insert end
"$f\n" filesep
5052 $ctext config
-state disabled
5053 $ctext yview
$commentend
5057 proc getblobline
{bf id
} {
5058 global diffids cmitmode ctext
5060 if {$id ne
$diffids ||
$cmitmode ne
"tree"} {
5064 $ctext config
-state normal
5066 while {[incr
nl] <= 1000 && [gets
$bf line
] >= 0} {
5067 $ctext insert end
"$line\n"
5070 # delete last newline
5071 $ctext delete
"end - 2c" "end - 1c"
5075 $ctext config
-state disabled
5076 return [expr {$nl >= 1000?
2: 1}]
5079 proc mergediff
{id l
} {
5080 global diffmergeid mdifffd
5084 global limitdiffs viewfiles curview
5088 # this doesn't seem to actually affect anything...
5089 set cmd
[concat | git diff-tree
--no-commit-id --cc -U$diffcontext $id]
5090 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5091 set cmd
[concat
$cmd -- $viewfiles($curview)]
5093 if {[catch
{set mdf
[open
$cmd r
]} err
]} {
5094 error_popup
"[mc "Error getting merge diffs
:"] $err"
5097 fconfigure
$mdf -blocking 0
5098 set mdifffd
($id) $mdf
5099 set np
[llength
[lindex
$parentlist $l]]
5101 filerun
$mdf [list getmergediffline
$mdf $id $np]
5104 proc getmergediffline
{mdf id np
} {
5105 global diffmergeid ctext cflist mergemax
5106 global difffilestart mdifffd
5108 $ctext conf
-state normal
5110 while {[incr nr
] <= 1000 && [gets
$mdf line
] >= 0} {
5111 if {![info exists diffmergeid
] ||
$id != $diffmergeid
5112 ||
$mdf != $mdifffd($id)} {
5116 if {[regexp
{^
diff --cc (.
*)} $line match fname
]} {
5117 # start of a new file
5118 $ctext insert end
"\n"
5119 set here
[$ctext index
"end - 1c"]
5120 lappend difffilestart
$here
5121 add_flist
[list
$fname]
5122 set l
[expr {(78 - [string length
$fname]) / 2}]
5123 set pad
[string range
"----------------------------------------" 1 $l]
5124 $ctext insert end
"$pad $fname $pad\n" filesep
5125 } elseif
{[regexp
{^@@
} $line]} {
5126 $ctext insert end
"$line\n" hunksep
5127 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $line] ||
[regexp
{^index
} $line]} {
5130 # parse the prefix - one ' ', '-' or '+' for each parent
5135 for {set j
0} {$j < $np} {incr j
} {
5136 set c
[string range
$line $j $j]
5139 } elseif
{$c == "-"} {
5141 } elseif
{$c == "+"} {
5150 if {!$isbad && $minuses ne
{} && $pluses eq
{}} {
5151 # line doesn't appear in result, parents in $minuses have the line
5152 set num
[lindex
$minuses 0]
5153 } elseif
{!$isbad && $pluses ne
{} && $minuses eq
{}} {
5154 # line appears in result, parents in $pluses don't have the line
5155 lappend tags mresult
5156 set num
[lindex
$spaces 0]
5159 if {$num >= $mergemax} {
5164 $ctext insert end
"$line\n" $tags
5167 $ctext conf
-state disabled
5172 return [expr {$nr >= 1000?
2: 1}]
5175 proc startdiff
{ids
} {
5176 global treediffs diffids treepending diffmergeid nullid nullid2
5180 catch
{unset diffmergeid
}
5181 if {![info exists treediffs
($ids)] ||
5182 [lsearch
-exact $ids $nullid] >= 0 ||
5183 [lsearch
-exact $ids $nullid2] >= 0} {
5184 if {![info exists treepending
]} {
5192 proc path_filter
{filter name
} {
5194 set l
[string length
$p]
5195 if {[string index
$p end
] eq
"/"} {
5196 if {[string compare
-length $l $p $name] == 0} {
5200 if {[string compare
-length $l $p $name] == 0 &&
5201 ([string length
$name] == $l ||
5202 [string index
$name $l] eq
"/")} {
5210 proc addtocflist
{ids
} {
5213 add_flist
$treediffs($ids)
5217 proc diffcmd
{ids flags
} {
5218 global nullid nullid2
5220 set i
[lsearch
-exact $ids $nullid]
5221 set j
[lsearch
-exact $ids $nullid2]
5223 if {[llength
$ids] > 1 && $j < 0} {
5224 # comparing working directory with some specific revision
5225 set cmd
[concat | git diff-index
$flags]
5227 lappend cmd
-R [lindex
$ids 1]
5229 lappend cmd
[lindex
$ids 0]
5232 # comparing working directory with index
5233 set cmd
[concat | git diff-files
$flags]
5238 } elseif
{$j >= 0} {
5239 set cmd
[concat | git diff-index
--cached $flags]
5240 if {[llength
$ids] > 1} {
5241 # comparing index with specific revision
5243 lappend cmd
-R [lindex
$ids 1]
5245 lappend cmd
[lindex
$ids 0]
5248 # comparing index with HEAD
5252 set cmd
[concat | git diff-tree
-r $flags $ids]
5257 proc gettreediffs
{ids
} {
5258 global treediff treepending
5260 set treepending
$ids
5262 if {[catch
{set gdtf
[open
[diffcmd
$ids {--no-commit-id}] r
]}]} return
5263 fconfigure
$gdtf -blocking 0
5264 filerun
$gdtf [list gettreediffline
$gdtf $ids]
5267 proc gettreediffline
{gdtf ids
} {
5268 global treediff treediffs treepending diffids diffmergeid
5269 global cmitmode viewfiles curview limitdiffs
5272 while {[incr nr
] <= 1000 && [gets
$gdtf line
] >= 0} {
5273 set i
[string first
"\t" $line]
5275 set file [string range
$line [expr {$i+1}] end
]
5276 if {[string index
$file 0] eq
"\""} {
5277 set file [lindex
$file 0]
5279 lappend treediff
$file
5283 return [expr {$nr >= 1000?
2: 1}]
5286 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5288 foreach f
$treediff {
5289 if {[path_filter
$viewfiles($curview) $f]} {
5293 set treediffs
($ids) $flist
5295 set treediffs
($ids) $treediff
5298 if {$cmitmode eq
"tree"} {
5300 } elseif
{$ids != $diffids} {
5301 if {![info exists diffmergeid
]} {
5302 gettreediffs
$diffids
5310 # empty string or positive integer
5311 proc diffcontextvalidate
{v
} {
5312 return [regexp
{^
(|
[1-9][0-9]*)$
} $v]
5315 proc diffcontextchange
{n1 n2 op
} {
5316 global diffcontextstring diffcontext
5318 if {[string is integer
-strict $diffcontextstring]} {
5319 if {$diffcontextstring > 0} {
5320 set diffcontext
$diffcontextstring
5326 proc changeignorespace
{} {
5330 proc getblobdiffs
{ids
} {
5331 global blobdifffd diffids env
5332 global diffinhdr treediffs
5335 global limitdiffs viewfiles curview
5337 set cmd
[diffcmd
$ids "-p -C --no-commit-id -U$diffcontext"]
5341 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5342 set cmd
[concat
$cmd -- $viewfiles($curview)]
5344 if {[catch
{set bdf
[open
$cmd r
]} err
]} {
5345 puts
"error getting diffs: $err"
5349 fconfigure
$bdf -blocking 0
5350 set blobdifffd
($ids) $bdf
5351 filerun
$bdf [list getblobdiffline
$bdf $diffids]
5354 proc setinlist
{var i val
} {
5357 while {[llength
[set $var]] < $i} {
5360 if {[llength
[set $var]] == $i} {
5367 proc makediffhdr
{fname ids
} {
5368 global ctext curdiffstart treediffs
5370 set i
[lsearch
-exact $treediffs($ids) $fname]
5372 setinlist difffilestart
$i $curdiffstart
5374 set l
[expr {(78 - [string length
$fname]) / 2}]
5375 set pad
[string range
"----------------------------------------" 1 $l]
5376 $ctext insert
$curdiffstart "$pad $fname $pad" filesep
5379 proc getblobdiffline
{bdf ids
} {
5380 global diffids blobdifffd ctext curdiffstart
5381 global diffnexthead diffnextnote difffilestart
5382 global diffinhdr treediffs
5385 $ctext conf
-state normal
5386 while {[incr nr
] <= 1000 && [gets
$bdf line
] >= 0} {
5387 if {$ids != $diffids ||
$bdf != $blobdifffd($ids)} {
5391 if {![string compare
-length 11 "diff --git " $line]} {
5392 # trim off "diff --git "
5393 set line
[string range
$line 11 end
]
5395 # start of a new file
5396 $ctext insert end
"\n"
5397 set curdiffstart
[$ctext index
"end - 1c"]
5398 $ctext insert end
"\n" filesep
5399 # If the name hasn't changed the length will be odd,
5400 # the middle char will be a space, and the two bits either
5401 # side will be a/name and b/name, or "a/name" and "b/name".
5402 # If the name has changed we'll get "rename from" and
5403 # "rename to" or "copy from" and "copy to" lines following this,
5404 # and we'll use them to get the filenames.
5405 # This complexity is necessary because spaces in the filename(s)
5406 # don't get escaped.
5407 set l
[string length
$line]
5408 set i
[expr {$l / 2}]
5409 if {!(($l & 1) && [string index
$line $i] eq
" " &&
5410 [string range
$line 2 [expr {$i - 1}]] eq \
5411 [string range
$line [expr {$i + 3}] end
])} {
5414 # unescape if quoted and chop off the a/ from the front
5415 if {[string index
$line 0] eq
"\""} {
5416 set fname
[string range
[lindex
$line 0] 2 end
]
5418 set fname
[string range
$line 2 [expr {$i - 1}]]
5420 makediffhdr
$fname $ids
5422 } elseif
{[regexp
{^@@
-([0-9]+)(,[0-9]+)? \
+([0-9]+)(,[0-9]+)? @@
(.
*)} \
5423 $line match f1l f1c f2l f2c rest
]} {
5424 $ctext insert end
"$line\n" hunksep
5427 } elseif
{$diffinhdr} {
5428 if {![string compare
-length 12 "rename from " $line]} {
5429 set fname
[string range
$line [expr 6 + [string first
" from " $line] ] end
]
5430 if {[string index
$fname 0] eq
"\""} {
5431 set fname
[lindex
$fname 0]
5433 set i
[lsearch
-exact $treediffs($ids) $fname]
5435 setinlist difffilestart
$i $curdiffstart
5437 } elseif
{![string compare
-length 10 $line "rename to "] ||
5438 ![string compare
-length 8 $line "copy to "]} {
5439 set fname
[string range
$line [expr 4 + [string first
" to " $line] ] end
]
5440 if {[string index
$fname 0] eq
"\""} {
5441 set fname
[lindex
$fname 0]
5443 makediffhdr
$fname $ids
5444 } elseif
{[string compare
-length 3 $line "---"] == 0} {
5447 } elseif
{[string compare
-length 3 $line "+++"] == 0} {
5451 $ctext insert end
"$line\n" filesep
5454 set x
[string range
$line 0 0]
5455 if {$x == "-" ||
$x == "+"} {
5456 set tag
[expr {$x == "+"}]
5457 $ctext insert end
"$line\n" d
$tag
5458 } elseif
{$x == " "} {
5459 $ctext insert end
"$line\n"
5461 # "\ No newline at end of file",
5462 # or something else we don't recognize
5463 $ctext insert end
"$line\n" hunksep
5467 $ctext conf
-state disabled
5472 return [expr {$nr >= 1000?
2: 1}]
5475 proc changediffdisp
{} {
5476 global ctext diffelide
5478 $ctext tag conf d0
-elide [lindex
$diffelide 0]
5479 $ctext tag conf d1
-elide [lindex
$diffelide 1]
5482 proc highlightfile
{loc cline
} {
5483 global ctext cflist cflist_top
5486 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
5487 $cflist tag add highlight
$cline.0 "$cline.0 lineend"
5488 $cflist see
$cline.0
5489 set cflist_top
$cline
5493 global difffilestart ctext cmitmode
5495 if {$cmitmode eq
"tree"} return
5498 set here
[$ctext index @
0,0]
5499 foreach loc
$difffilestart {
5500 if {[$ctext compare
$loc >= $here]} {
5501 highlightfile
$prev $prevline
5507 highlightfile
$prev $prevline
5511 global difffilestart ctext cmitmode
5513 if {$cmitmode eq
"tree"} return
5514 set here
[$ctext index @
0,0]
5516 foreach loc
$difffilestart {
5518 if {[$ctext compare
$loc > $here]} {
5519 highlightfile
$loc $line
5525 proc clear_ctext
{{first
1.0}} {
5526 global ctext smarktop smarkbot
5529 set l
[lindex
[split $first .
] 0]
5530 if {![info exists smarktop
] ||
[$ctext compare
$first < $smarktop.0]} {
5533 if {![info exists smarkbot
] ||
[$ctext compare
$first < $smarkbot.0]} {
5536 $ctext delete
$first end
5537 if {$first eq
"1.0"} {
5538 catch
{unset pendinglinks
}
5542 proc settabs
{{firstab
{}}} {
5543 global firsttabstop tabstop ctext have_tk85
5545 if {$firstab ne
{} && $have_tk85} {
5546 set firsttabstop
$firstab
5548 set w
[font measure textfont
"0"]
5549 if {$firsttabstop != 0} {
5550 $ctext conf
-tabs [list
[expr {($firsttabstop + $tabstop) * $w}] \
5551 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5552 } elseif
{$have_tk85 ||
$tabstop != 8} {
5553 $ctext conf
-tabs [expr {$tabstop * $w}]
5555 $ctext conf
-tabs {}
5559 proc incrsearch
{name ix op
} {
5560 global ctext searchstring searchdirn
5562 $ctext tag remove found
1.0 end
5563 if {[catch
{$ctext index anchor
}]} {
5564 # no anchor set, use start of selection, or of visible area
5565 set sel
[$ctext tag ranges sel
]
5567 $ctext mark
set anchor
[lindex
$sel 0]
5568 } elseif
{$searchdirn eq
"-forwards"} {
5569 $ctext mark
set anchor @
0,0
5571 $ctext mark
set anchor @
0,[winfo height
$ctext]
5574 if {$searchstring ne
{}} {
5575 set here
[$ctext search
$searchdirn -- $searchstring anchor
]
5584 global sstring ctext searchstring searchdirn
5587 $sstring icursor end
5588 set searchdirn
-forwards
5589 if {$searchstring ne
{}} {
5590 set sel
[$ctext tag ranges sel
]
5592 set start
"[lindex $sel 0] + 1c"
5593 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5596 set match
[$ctext search
-count mlen
-- $searchstring $start]
5597 $ctext tag remove sel
1.0 end
5603 set mend
"$match + $mlen c"
5604 $ctext tag add sel
$match $mend
5605 $ctext mark
unset anchor
5609 proc dosearchback
{} {
5610 global sstring ctext searchstring searchdirn
5613 $sstring icursor end
5614 set searchdirn
-backwards
5615 if {$searchstring ne
{}} {
5616 set sel
[$ctext tag ranges sel
]
5618 set start
[lindex
$sel 0]
5619 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5620 set start @
0,[winfo height
$ctext]
5622 set match
[$ctext search
-backwards -count ml
-- $searchstring $start]
5623 $ctext tag remove sel
1.0 end
5629 set mend
"$match + $ml c"
5630 $ctext tag add sel
$match $mend
5631 $ctext mark
unset anchor
5635 proc searchmark
{first last
} {
5636 global ctext searchstring
5640 set match
[$ctext search
-count mlen
-- $searchstring $mend $last.end
]
5641 if {$match eq
{}} break
5642 set mend
"$match + $mlen c"
5643 $ctext tag add found
$match $mend
5647 proc searchmarkvisible
{doall
} {
5648 global ctext smarktop smarkbot
5650 set topline
[lindex
[split [$ctext index @
0,0] .
] 0]
5651 set botline
[lindex
[split [$ctext index @
0,[winfo height
$ctext]] .
] 0]
5652 if {$doall ||
$botline < $smarktop ||
$topline > $smarkbot} {
5653 # no overlap with previous
5654 searchmark
$topline $botline
5655 set smarktop
$topline
5656 set smarkbot
$botline
5658 if {$topline < $smarktop} {
5659 searchmark
$topline [expr {$smarktop-1}]
5660 set smarktop
$topline
5662 if {$botline > $smarkbot} {
5663 searchmark
[expr {$smarkbot+1}] $botline
5664 set smarkbot
$botline
5669 proc scrolltext
{f0 f1
} {
5672 .bleft.bottom.sb
set $f0 $f1
5673 if {$searchstring ne
{}} {
5679 global linespc charspc canvx0 canvy0
5680 global xspc1 xspc2 lthickness
5682 set linespc
[font metrics mainfont
-linespace]
5683 set charspc
[font measure mainfont
"m"]
5684 set canvy0
[expr {int
(3 + 0.5 * $linespc)}]
5685 set canvx0
[expr {int
(3 + 0.5 * $linespc)}]
5686 set lthickness
[expr {int
($linespc / 9) + 1}]
5687 set xspc1
(0) $linespc
5695 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5696 if {$ymax eq
{} ||
$ymax == 0} return
5697 set span
[$canv yview
]
5700 allcanvs yview moveto
[lindex
$span 0]
5702 if {[info exists selectedline
]} {
5703 selectline
$selectedline 0
5704 allcanvs yview moveto
[lindex
$span 0]
5708 proc parsefont
{f n
} {
5711 set fontattr
($f,family
) [lindex
$n 0]
5713 if {$s eq
{} ||
$s == 0} {
5716 set s
[expr {int
(-$s / [winfo fpixels .
1p
] + 0.5)}]
5718 set fontattr
($f,size
) $s
5719 set fontattr
($f,weight
) normal
5720 set fontattr
($f,slant
) roman
5721 foreach style
[lrange
$n 2 end
] {
5724 "bold" {set fontattr
($f,weight
) $style}
5726 "italic" {set fontattr
($f,slant
) $style}
5731 proc fontflags
{f
{isbold
0}} {
5734 return [list
-family $fontattr($f,family
) -size $fontattr($f,size
) \
5735 -weight [expr {$isbold?
"bold": $fontattr($f,weight
)}] \
5736 -slant $fontattr($f,slant
)]
5742 set n
[list
$fontattr($f,family
) $fontattr($f,size
)]
5743 if {$fontattr($f,weight
) eq
"bold"} {
5746 if {$fontattr($f,slant
) eq
"italic"} {
5752 proc incrfont
{inc
} {
5753 global mainfont textfont ctext canv phase cflist showrefstop
5754 global stopped entries fontattr
5757 set s
$fontattr(mainfont
,size
)
5762 set fontattr
(mainfont
,size
) $s
5763 font config mainfont
-size $s
5764 font config mainfontbold
-size $s
5765 set mainfont
[fontname mainfont
]
5766 set s
$fontattr(textfont
,size
)
5771 set fontattr
(textfont
,size
) $s
5772 font config textfont
-size $s
5773 font config textfontbold
-size $s
5774 set textfont
[fontname textfont
]
5781 global sha1entry sha1string
5782 if {[string length
$sha1string] == 40} {
5783 $sha1entry delete
0 end
5787 proc sha1change
{n1 n2 op
} {
5788 global sha1string currentid sha1but
5789 if {$sha1string == {}
5790 ||
([info exists currentid
] && $sha1string == $currentid)} {
5795 if {[$sha1but cget
-state] == $state} return
5796 if {$state == "normal"} {
5797 $sha1but conf
-state normal
-relief raised
-text "[mc "Goto
:"] "
5799 $sha1but conf
-state disabled
-relief flat
-text "[mc "SHA1 ID
:"] "
5803 proc gotocommit
{} {
5804 global sha1string currentid commitrow tagids headids
5805 global displayorder numcommits curview
5807 if {$sha1string == {}
5808 ||
([info exists currentid
] && $sha1string == $currentid)} return
5809 if {[info exists tagids
($sha1string)]} {
5810 set id
$tagids($sha1string)
5811 } elseif
{[info exists headids
($sha1string)]} {
5812 set id
$headids($sha1string)
5814 set id
[string tolower
$sha1string]
5815 if {[regexp
{^
[0-9a-f]{4,39}$
} $id]} {
5817 foreach i
$displayorder {
5818 if {[string match
$id* $i]} {
5822 if {$matches ne
{}} {
5823 if {[llength
$matches] > 1} {
5824 error_popup
[mc
"Short SHA1 id %s is ambiguous" $id]
5827 set id
[lindex
$matches 0]
5831 if {[info exists commitrow
($curview,$id)]} {
5832 selectline
$commitrow($curview,$id) 1
5835 if {[regexp
{^
[0-9a-fA-F]{4,}$
} $sha1string]} {
5836 set msg
[mc
"SHA1 id %s is not known" $sha1string]
5838 set msg
[mc
"Tag/Head %s is not known" $sha1string]
5843 proc lineenter
{x y id
} {
5844 global hoverx hovery hoverid hovertimer
5845 global commitinfo canv
5847 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5851 if {[info exists hovertimer
]} {
5852 after cancel
$hovertimer
5854 set hovertimer
[after
500 linehover
]
5858 proc linemotion
{x y id
} {
5859 global hoverx hovery hoverid hovertimer
5861 if {[info exists hoverid
] && $id == $hoverid} {
5864 if {[info exists hovertimer
]} {
5865 after cancel
$hovertimer
5867 set hovertimer
[after
500 linehover
]
5871 proc lineleave
{id
} {
5872 global hoverid hovertimer canv
5874 if {[info exists hoverid
] && $id == $hoverid} {
5876 if {[info exists hovertimer
]} {
5877 after cancel
$hovertimer
5885 global hoverx hovery hoverid hovertimer
5886 global canv linespc lthickness
5889 set text
[lindex
$commitinfo($hoverid) 0]
5890 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5891 if {$ymax == {}} return
5892 set yfrac
[lindex
[$canv yview
] 0]
5893 set x
[expr {$hoverx + 2 * $linespc}]
5894 set y
[expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5895 set x0
[expr {$x - 2 * $lthickness}]
5896 set y0
[expr {$y - 2 * $lthickness}]
5897 set x1
[expr {$x + [font measure mainfont
$text] + 2 * $lthickness}]
5898 set y1
[expr {$y + $linespc + 2 * $lthickness}]
5899 set t
[$canv create rectangle
$x0 $y0 $x1 $y1 \
5900 -fill \
#ffff80 -outline black -width 1 -tags hover]
5902 set t
[$canv create text
$x $y -anchor nw
-text $text -tags hover \
5907 proc clickisonarrow
{id y
} {
5910 set ranges
[rowranges
$id]
5911 set thresh
[expr {2 * $lthickness + 6}]
5912 set n
[expr {[llength
$ranges] - 1}]
5913 for {set i
1} {$i < $n} {incr i
} {
5914 set row
[lindex
$ranges $i]
5915 if {abs
([yc
$row] - $y) < $thresh} {
5922 proc arrowjump
{id n y
} {
5925 # 1 <-> 2, 3 <-> 4, etc...
5926 set n
[expr {(($n - 1) ^
1) + 1}]
5927 set row
[lindex
[rowranges
$id] $n]
5929 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5930 if {$ymax eq
{} ||
$ymax <= 0} return
5931 set view
[$canv yview
]
5932 set yspan
[expr {[lindex
$view 1] - [lindex
$view 0]}]
5933 set yfrac
[expr {$yt / $ymax - $yspan / 2}]
5937 allcanvs yview moveto
$yfrac
5940 proc lineclick
{x y id isnew
} {
5941 global ctext commitinfo children canv thickerline curview commitrow
5943 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5948 # draw this line thicker than normal
5952 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5953 if {$ymax eq
{}} return
5954 set yfrac
[lindex
[$canv yview
] 0]
5955 set y
[expr {$y + $yfrac * $ymax}]
5957 set dirn
[clickisonarrow
$id $y]
5959 arrowjump
$id $dirn $y
5964 addtohistory
[list lineclick
$x $y $id 0]
5966 # fill the details pane with info about this line
5967 $ctext conf
-state normal
5970 $ctext insert end
"[mc "Parent
"]:\t"
5971 $ctext insert end
$id link0
5973 set info
$commitinfo($id)
5974 $ctext insert end
"\n\t[lindex $info 0]\n"
5975 $ctext insert end
"\t[mc "Author
"]:\t[lindex $info 1]\n"
5976 set date [formatdate
[lindex
$info 2]]
5977 $ctext insert end
"\t[mc "Date
"]:\t$date\n"
5978 set kids
$children($curview,$id)
5980 $ctext insert end
"\n[mc "Children
"]:"
5982 foreach child
$kids {
5984 if {![info exists commitinfo
($child)] && ![getcommit
$child]} continue
5985 set info
$commitinfo($child)
5986 $ctext insert end
"\n\t"
5987 $ctext insert end
$child link
$i
5988 setlink
$child link
$i
5989 $ctext insert end
"\n\t[lindex $info 0]"
5990 $ctext insert end
"\n\t[mc "Author
"]:\t[lindex $info 1]"
5991 set date [formatdate
[lindex
$info 2]]
5992 $ctext insert end
"\n\t[mc "Date
"]:\t$date\n"
5995 $ctext conf
-state disabled
5999 proc normalline
{} {
6001 if {[info exists thickerline
]} {
6009 global commitrow curview
6010 if {[info exists commitrow
($curview,$id)]} {
6011 selectline
$commitrow($curview,$id) 1
6017 if {![info exists startmstime
]} {
6018 set startmstime
[clock clicks
-milliseconds]
6020 return [format
"%.3f" [expr {([clock click
-milliseconds] - $startmstime) / 1000.0}]]
6023 proc rowmenu
{x y id
} {
6024 global rowctxmenu commitrow selectedline rowmenuid curview
6025 global nullid nullid2 fakerowmenu mainhead
6029 if {![info exists selectedline
]
6030 ||
$commitrow($curview,$id) eq
$selectedline} {
6035 if {$id ne
$nullid && $id ne
$nullid2} {
6036 set menu
$rowctxmenu
6037 if {$mainhead ne
{}} {
6038 $menu entryconfigure
7 -label [mc
"Reset %s branch to here" $mainhead]
6040 $menu entryconfigure
7 -label [mc
"Detached head: can't reset" $mainhead] -state disabled
6043 set menu
$fakerowmenu
6045 $menu entryconfigure
[mc
"Diff this -> selected"] -state $state
6046 $menu entryconfigure
[mc
"Diff selected -> this"] -state $state
6047 $menu entryconfigure
[mc
"Make patch"] -state $state
6048 tk_popup
$menu $x $y
6051 proc diffvssel
{dirn
} {
6052 global rowmenuid selectedline displayorder
6054 if {![info exists selectedline
]} return
6056 set oldid
[lindex
$displayorder $selectedline]
6057 set newid
$rowmenuid
6059 set oldid
$rowmenuid
6060 set newid
[lindex
$displayorder $selectedline]
6062 addtohistory
[list doseldiff
$oldid $newid]
6063 doseldiff
$oldid $newid
6066 proc doseldiff
{oldid newid
} {
6070 $ctext conf
-state normal
6072 init_flist
[mc
"Top"]
6073 $ctext insert end
"[mc "From
"] "
6074 $ctext insert end
$oldid link0
6075 setlink
$oldid link0
6076 $ctext insert end
"\n "
6077 $ctext insert end
[lindex
$commitinfo($oldid) 0]
6078 $ctext insert end
"\n\n[mc "To
"] "
6079 $ctext insert end
$newid link1
6080 setlink
$newid link1
6081 $ctext insert end
"\n "
6082 $ctext insert end
[lindex
$commitinfo($newid) 0]
6083 $ctext insert end
"\n"
6084 $ctext conf
-state disabled
6085 $ctext tag remove found
1.0 end
6086 startdiff
[list
$oldid $newid]
6090 global rowmenuid currentid commitinfo patchtop patchnum
6092 if {![info exists currentid
]} return
6093 set oldid
$currentid
6094 set oldhead
[lindex
$commitinfo($oldid) 0]
6095 set newid
$rowmenuid
6096 set newhead
[lindex
$commitinfo($newid) 0]
6099 catch
{destroy
$top}
6101 label
$top.title
-text [mc
"Generate patch"]
6102 grid
$top.title
- -pady 10
6103 label
$top.from
-text [mc
"From:"]
6104 entry
$top.fromsha1
-width 40 -relief flat
6105 $top.fromsha1 insert
0 $oldid
6106 $top.fromsha1 conf
-state readonly
6107 grid
$top.from
$top.fromsha1
-sticky w
6108 entry
$top.fromhead
-width 60 -relief flat
6109 $top.fromhead insert
0 $oldhead
6110 $top.fromhead conf
-state readonly
6111 grid x
$top.fromhead
-sticky w
6112 label
$top.to
-text [mc
"To:"]
6113 entry
$top.tosha1
-width 40 -relief flat
6114 $top.tosha1 insert
0 $newid
6115 $top.tosha1 conf
-state readonly
6116 grid
$top.to
$top.tosha1
-sticky w
6117 entry
$top.tohead
-width 60 -relief flat
6118 $top.tohead insert
0 $newhead
6119 $top.tohead conf
-state readonly
6120 grid x
$top.tohead
-sticky w
6121 button
$top.
rev -text [mc
"Reverse"] -command mkpatchrev
-padx 5
6122 grid
$top.
rev x
-pady 10
6123 label
$top.flab
-text [mc
"Output file:"]
6124 entry
$top.fname
-width 60
6125 $top.fname insert
0 [file normalize
"patch$patchnum.patch"]
6127 grid
$top.flab
$top.fname
-sticky w
6129 button
$top.buts.gen
-text [mc
"Generate"] -command mkpatchgo
6130 button
$top.buts.can
-text [mc
"Cancel"] -command mkpatchcan
6131 grid
$top.buts.gen
$top.buts.can
6132 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6133 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6134 grid
$top.buts
- -pady 10 -sticky ew
6138 proc mkpatchrev
{} {
6141 set oldid
[$patchtop.fromsha1 get
]
6142 set oldhead
[$patchtop.fromhead get
]
6143 set newid
[$patchtop.tosha1 get
]
6144 set newhead
[$patchtop.tohead get
]
6145 foreach e
[list fromsha1 fromhead tosha1 tohead
] \
6146 v
[list
$newid $newhead $oldid $oldhead] {
6147 $patchtop.
$e conf
-state normal
6148 $patchtop.
$e delete
0 end
6149 $patchtop.
$e insert
0 $v
6150 $patchtop.
$e conf
-state readonly
6155 global patchtop nullid nullid2
6157 set oldid
[$patchtop.fromsha1 get
]
6158 set newid
[$patchtop.tosha1 get
]
6159 set fname
[$patchtop.fname get
]
6160 set cmd
[diffcmd
[list
$oldid $newid] -p]
6161 # trim off the initial "|"
6162 set cmd
[lrange
$cmd 1 end
]
6163 lappend cmd
>$fname &
6164 if {[catch
{eval exec $cmd} err
]} {
6165 error_popup
"[mc "Error creating
patch:"] $err"
6167 catch
{destroy
$patchtop}
6171 proc mkpatchcan
{} {
6174 catch
{destroy
$patchtop}
6179 global rowmenuid mktagtop commitinfo
6183 catch
{destroy
$top}
6185 label
$top.title
-text [mc
"Create tag"]
6186 grid
$top.title
- -pady 10
6187 label
$top.id
-text [mc
"ID:"]
6188 entry
$top.sha1
-width 40 -relief flat
6189 $top.sha1 insert
0 $rowmenuid
6190 $top.sha1 conf
-state readonly
6191 grid
$top.id
$top.sha1
-sticky w
6192 entry
$top.
head -width 60 -relief flat
6193 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6194 $top.
head conf
-state readonly
6195 grid x
$top.
head -sticky w
6196 label
$top.tlab
-text [mc
"Tag name:"]
6197 entry
$top.tag
-width 60
6198 grid
$top.tlab
$top.tag
-sticky w
6200 button
$top.buts.gen
-text [mc
"Create"] -command mktaggo
6201 button
$top.buts.can
-text [mc
"Cancel"] -command mktagcan
6202 grid
$top.buts.gen
$top.buts.can
6203 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6204 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6205 grid
$top.buts
- -pady 10 -sticky ew
6210 global mktagtop env tagids idtags
6212 set id
[$mktagtop.sha1 get
]
6213 set tag
[$mktagtop.tag get
]
6215 error_popup
[mc
"No tag name specified"]
6218 if {[info exists tagids
($tag)]} {
6219 error_popup
[mc
"Tag \"%s\" already exists" $tag]
6223 exec git tag
$tag $id
6225 error_popup
"[mc "Error creating tag
:"] $err"
6229 set tagids
($tag) $id
6230 lappend idtags
($id) $tag
6237 proc redrawtags
{id
} {
6238 global canv linehtag commitrow idpos selectedline curview
6239 global canvxmax iddrawn
6241 if {![info exists commitrow
($curview,$id)]} return
6242 if {![info exists iddrawn
($id)]} return
6243 drawcommits
$commitrow($curview,$id)
6244 $canv delete tag.
$id
6245 set xt
[eval drawtags
$id $idpos($id)]
6246 $canv coords
$linehtag($commitrow($curview,$id)) $xt [lindex
$idpos($id) 2]
6247 set text
[$canv itemcget
$linehtag($commitrow($curview,$id)) -text]
6248 set xr
[expr {$xt + [font measure mainfont
$text]}]
6249 if {$xr > $canvxmax} {
6253 if {[info exists selectedline
]
6254 && $selectedline == $commitrow($curview,$id)} {
6255 selectline
$selectedline 0
6262 catch
{destroy
$mktagtop}
6271 proc writecommit
{} {
6272 global rowmenuid wrcomtop commitinfo wrcomcmd
6274 set top .writecommit
6276 catch
{destroy
$top}
6278 label
$top.title
-text [mc
"Write commit to file"]
6279 grid
$top.title
- -pady 10
6280 label
$top.id
-text [mc
"ID:"]
6281 entry
$top.sha1
-width 40 -relief flat
6282 $top.sha1 insert
0 $rowmenuid
6283 $top.sha1 conf
-state readonly
6284 grid
$top.id
$top.sha1
-sticky w
6285 entry
$top.
head -width 60 -relief flat
6286 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6287 $top.
head conf
-state readonly
6288 grid x
$top.
head -sticky w
6289 label
$top.clab
-text [mc
"Command:"]
6290 entry
$top.cmd
-width 60 -textvariable wrcomcmd
6291 grid
$top.clab
$top.cmd
-sticky w
-pady 10
6292 label
$top.flab
-text [mc
"Output file:"]
6293 entry
$top.fname
-width 60
6294 $top.fname insert
0 [file normalize
"commit-[string range $rowmenuid 0 6]"]
6295 grid
$top.flab
$top.fname
-sticky w
6297 button
$top.buts.gen
-text [mc
"Write"] -command wrcomgo
6298 button
$top.buts.can
-text [mc
"Cancel"] -command wrcomcan
6299 grid
$top.buts.gen
$top.buts.can
6300 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6301 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6302 grid
$top.buts
- -pady 10 -sticky ew
6309 set id
[$wrcomtop.sha1 get
]
6310 set cmd
"echo $id | [$wrcomtop.cmd get]"
6311 set fname
[$wrcomtop.fname get
]
6312 if {[catch
{exec sh
-c $cmd >$fname &} err
]} {
6313 error_popup
"[mc "Error writing commit
:"] $err"
6315 catch
{destroy
$wrcomtop}
6322 catch
{destroy
$wrcomtop}
6327 global rowmenuid mkbrtop
6330 catch
{destroy
$top}
6332 label
$top.title
-text [mc
"Create new branch"]
6333 grid
$top.title
- -pady 10
6334 label
$top.id
-text [mc
"ID:"]
6335 entry
$top.sha1
-width 40 -relief flat
6336 $top.sha1 insert
0 $rowmenuid
6337 $top.sha1 conf
-state readonly
6338 grid
$top.id
$top.sha1
-sticky w
6339 label
$top.nlab
-text [mc
"Name:"]
6340 entry
$top.name
-width 40
6341 grid
$top.nlab
$top.name
-sticky w
6343 button
$top.buts.go
-text [mc
"Create"] -command [list mkbrgo
$top]
6344 button
$top.buts.can
-text [mc
"Cancel"] -command "catch {destroy $top}"
6345 grid
$top.buts.go
$top.buts.can
6346 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6347 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6348 grid
$top.buts
- -pady 10 -sticky ew
6353 global headids idheads
6355 set name
[$top.name get
]
6356 set id
[$top.sha1 get
]
6358 error_popup
[mc
"Please specify a name for the new branch"]
6361 catch
{destroy
$top}
6365 exec git branch
$name $id
6370 set headids
($name) $id
6371 lappend idheads
($id) $name
6380 proc cherrypick
{} {
6381 global rowmenuid curview commitrow
6384 set oldhead
[exec git rev-parse HEAD
]
6385 set dheads
[descheads
$rowmenuid]
6386 if {$dheads ne
{} && [lsearch
-exact $dheads $oldhead] >= 0} {
6387 set ok
[confirm_popup
[mc
"Commit %s is already\
6388 included in branch %s -- really re-apply it?" \
6389 [string range
$rowmenuid 0 7] $mainhead]]
6392 nowbusy cherrypick
[mc
"Cherry-picking"]
6394 # Unfortunately git-cherry-pick writes stuff to stderr even when
6395 # no error occurs, and exec takes that as an indication of error...
6396 if {[catch
{exec sh
-c "git cherry-pick -r $rowmenuid 2>&1"} err
]} {
6401 set newhead
[exec git rev-parse HEAD
]
6402 if {$newhead eq
$oldhead} {
6404 error_popup
[mc
"No changes committed"]
6407 addnewchild
$newhead $oldhead
6408 if {[info exists commitrow
($curview,$oldhead)]} {
6409 insertrow
$commitrow($curview,$oldhead) $newhead
6410 if {$mainhead ne
{}} {
6411 movehead
$newhead $mainhead
6412 movedhead
$newhead $mainhead
6421 global mainheadid mainhead rowmenuid confirm_ok resettype
6424 set w
".confirmreset"
6427 wm title
$w [mc
"Confirm reset"]
6428 message
$w.m
-text \
6429 [mc
"Reset branch %s to %s?" $mainhead [string range
$rowmenuid 0 7]] \
6430 -justify center
-aspect 1000
6431 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
6432 frame
$w.f
-relief sunken
-border 2
6433 message
$w.f.rt
-text [mc
"Reset type:"] -aspect 1000
6434 grid
$w.f.rt
-sticky w
6436 radiobutton
$w.f.soft
-value soft
-variable resettype
-justify left \
6437 -text [mc
"Soft: Leave working tree and index untouched"]
6438 grid
$w.f.soft
-sticky w
6439 radiobutton
$w.f.mixed
-value mixed
-variable resettype
-justify left \
6440 -text [mc
"Mixed: Leave working tree untouched, reset index"]
6441 grid
$w.f.mixed
-sticky w
6442 radiobutton
$w.f.hard
-value hard
-variable resettype
-justify left \
6443 -text [mc
"Hard: Reset working tree and index\n(discard ALL local changes)"]
6444 grid
$w.f.hard
-sticky w
6445 pack
$w.f
-side top
-fill x
6446 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
6447 pack
$w.ok
-side left
-fill x
-padx 20 -pady 20
6448 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
6449 pack
$w.cancel
-side right
-fill x
-padx 20 -pady 20
6450 bind $w <Visibility
> "grab $w; focus $w"
6452 if {!$confirm_ok} return
6453 if {[catch
{set fd
[open \
6454 [list | sh
-c "git reset --$resettype $rowmenuid 2>&1"] r
]} err
]} {
6458 filerun
$fd [list readresetstat
$fd]
6459 nowbusy
reset [mc
"Resetting"]
6463 proc readresetstat
{fd
} {
6464 global mainhead mainheadid showlocalchanges rprogcoord
6466 if {[gets
$fd line
] >= 0} {
6467 if {[regexp
{([0-9]+)% \
(([0-9]+)/([0-9]+)\
)} $line match p m n
]} {
6468 set rprogcoord
[expr {1.0 * $m / $n}]
6476 if {[catch
{close
$fd} err
]} {
6479 set oldhead
$mainheadid
6480 set newhead
[exec git rev-parse HEAD
]
6481 if {$newhead ne
$oldhead} {
6482 movehead
$newhead $mainhead
6483 movedhead
$newhead $mainhead
6484 set mainheadid
$newhead
6488 if {$showlocalchanges} {
6494 # context menu for a head
6495 proc headmenu
{x y id
head} {
6496 global headmenuid headmenuhead headctxmenu mainhead
6500 set headmenuhead
$head
6502 if {$head eq
$mainhead} {
6505 $headctxmenu entryconfigure
0 -state $state
6506 $headctxmenu entryconfigure
1 -state $state
6507 tk_popup
$headctxmenu $x $y
6511 global headmenuid headmenuhead mainhead headids
6512 global showlocalchanges mainheadid
6514 # check the tree is clean first??
6515 set oldmainhead
$mainhead
6516 nowbusy checkout
[mc
"Checking out"]
6520 exec git checkout
-q $headmenuhead
6526 set mainhead
$headmenuhead
6527 set mainheadid
$headmenuid
6528 if {[info exists headids
($oldmainhead)]} {
6529 redrawtags
$headids($oldmainhead)
6531 redrawtags
$headmenuid
6533 if {$showlocalchanges} {
6539 global headmenuid headmenuhead mainhead
6542 set head $headmenuhead
6544 # this check shouldn't be needed any more...
6545 if {$head eq
$mainhead} {
6546 error_popup
[mc
"Cannot delete the currently checked-out branch"]
6549 set dheads
[descheads
$id]
6550 if {[llength
$dheads] == 1 && $idheads($dheads) eq
$head} {
6551 # the stuff on this branch isn't on any other branch
6552 if {![confirm_popup
[mc
"The commits on branch %s aren't on any other\
6553 branch.\nReally delete branch %s?" $head $head]]} return
6557 if {[catch
{exec git branch
-D $head} err
]} {
6562 removehead
$id $head
6563 removedhead
$id $head
6570 # Display a list of tags and heads
6572 global showrefstop bgcolor fgcolor selectbgcolor
6573 global bglist fglist reflistfilter reflist maincursor
6576 set showrefstop
$top
6577 if {[winfo exists
$top]} {
6583 wm title
$top [mc
"Tags and heads: %s" [file tail [pwd]]]
6584 text
$top.list
-background $bgcolor -foreground $fgcolor \
6585 -selectbackground $selectbgcolor -font mainfont \
6586 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6587 -width 30 -height 20 -cursor $maincursor \
6588 -spacing1 1 -spacing3 1 -state disabled
6589 $top.list tag configure highlight
-background $selectbgcolor
6590 lappend bglist
$top.list
6591 lappend fglist
$top.list
6592 scrollbar
$top.ysb
-command "$top.list yview" -orient vertical
6593 scrollbar
$top.xsb
-command "$top.list xview" -orient horizontal
6594 grid
$top.list
$top.ysb
-sticky nsew
6595 grid
$top.xsb x
-sticky ew
6597 label
$top.f.l
-text "[mc "Filter
"]: "
6598 entry
$top.f.e
-width 20 -textvariable reflistfilter
6599 set reflistfilter
"*"
6600 trace add variable reflistfilter
write reflistfilter_change
6601 pack
$top.f.e
-side right
-fill x
-expand 1
6602 pack
$top.f.l
-side left
6603 grid
$top.f
- -sticky ew
-pady 2
6604 button
$top.close
-command [list destroy
$top] -text [mc
"Close"]
6606 grid columnconfigure
$top 0 -weight 1
6607 grid rowconfigure
$top 0 -weight 1
6608 bind $top.list
<1> {break}
6609 bind $top.list
<B1-Motion
> {break}
6610 bind $top.list
<ButtonRelease-1
> {sel_reflist
%W
%x
%y
; break}
6615 proc sel_reflist
{w x y
} {
6616 global showrefstop reflist headids tagids otherrefids
6618 if {![winfo exists
$showrefstop]} return
6619 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
6620 set ref
[lindex
$reflist [expr {$l-1}]]
6621 set n
[lindex
$ref 0]
6622 switch
-- [lindex
$ref 1] {
6623 "H" {selbyid
$headids($n)}
6624 "T" {selbyid
$tagids($n)}
6625 "o" {selbyid
$otherrefids($n)}
6627 $showrefstop.list tag add highlight
$l.0 "$l.0 lineend"
6630 proc unsel_reflist
{} {
6633 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6634 $showrefstop.list tag remove highlight
0.0 end
6637 proc reflistfilter_change
{n1 n2 op
} {
6638 global reflistfilter
6640 after cancel refill_reflist
6641 after
200 refill_reflist
6644 proc refill_reflist
{} {
6645 global reflist reflistfilter showrefstop headids tagids otherrefids
6646 global commitrow curview commitinterest
6648 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6650 foreach n
[array names headids
] {
6651 if {[string match
$reflistfilter $n]} {
6652 if {[info exists commitrow
($curview,$headids($n))]} {
6653 lappend refs
[list
$n H
]
6655 set commitinterest
($headids($n)) {run refill_reflist
}
6659 foreach n
[array names tagids
] {
6660 if {[string match
$reflistfilter $n]} {
6661 if {[info exists commitrow
($curview,$tagids($n))]} {
6662 lappend refs
[list
$n T
]
6664 set commitinterest
($tagids($n)) {run refill_reflist
}
6668 foreach n
[array names otherrefids
] {
6669 if {[string match
$reflistfilter $n]} {
6670 if {[info exists commitrow
($curview,$otherrefids($n))]} {
6671 lappend refs
[list
$n o
]
6673 set commitinterest
($otherrefids($n)) {run refill_reflist
}
6677 set refs
[lsort
-index 0 $refs]
6678 if {$refs eq
$reflist} return
6680 # Update the contents of $showrefstop.list according to the
6681 # differences between $reflist (old) and $refs (new)
6682 $showrefstop.list conf
-state normal
6683 $showrefstop.list insert end
"\n"
6686 while {$i < [llength
$reflist] ||
$j < [llength
$refs]} {
6687 if {$i < [llength
$reflist]} {
6688 if {$j < [llength
$refs]} {
6689 set cmp [string compare
[lindex
$reflist $i 0] \
6690 [lindex
$refs $j 0]]
6692 set cmp [string compare
[lindex
$reflist $i 1] \
6693 [lindex
$refs $j 1]]
6703 $showrefstop.list delete
"[expr {$j+1}].0" "[expr {$j+2}].0"
6711 set l
[expr {$j + 1}]
6712 $showrefstop.list image create
$l.0 -align baseline \
6713 -image reficon-
[lindex
$refs $j 1] -padx 2
6714 $showrefstop.list insert
$l.1 "[lindex $refs $j 0]\n"
6720 # delete last newline
6721 $showrefstop.list delete end-2c end-1c
6722 $showrefstop.list conf
-state disabled
6725 # Stuff for finding nearby tags
6726 proc getallcommits
{} {
6727 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6728 global idheads idtags idotherrefs allparents tagobjid
6730 if {![info exists allcommits
]} {
6736 set allccache
[file join [gitdir
] "gitk.cache"]
6738 set f
[open
$allccache r
]
6747 set cmd
[list | git rev-list
--parents]
6748 set allcupdate
[expr {$seeds ne
{}}]
6752 set refs
[concat
[array names idheads
] [array names idtags
] \
6753 [array names idotherrefs
]]
6756 foreach name
[array names tagobjid
] {
6757 lappend tagobjs
$tagobjid($name)
6759 foreach id
[lsort
-unique $refs] {
6760 if {![info exists allparents
($id)] &&
6761 [lsearch
-exact $tagobjs $id] < 0} {
6772 set fd
[open
[concat
$cmd $ids] r
]
6773 fconfigure
$fd -blocking 0
6776 filerun
$fd [list getallclines
$fd]
6782 # Since most commits have 1 parent and 1 child, we group strings of
6783 # such commits into "arcs" joining branch/merge points (BMPs), which
6784 # are commits that either don't have 1 parent or don't have 1 child.
6786 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6787 # arcout(id) - outgoing arcs for BMP
6788 # arcids(a) - list of IDs on arc including end but not start
6789 # arcstart(a) - BMP ID at start of arc
6790 # arcend(a) - BMP ID at end of arc
6791 # growing(a) - arc a is still growing
6792 # arctags(a) - IDs out of arcids (excluding end) that have tags
6793 # archeads(a) - IDs out of arcids (excluding end) that have heads
6794 # The start of an arc is at the descendent end, so "incoming" means
6795 # coming from descendents, and "outgoing" means going towards ancestors.
6797 proc getallclines
{fd
} {
6798 global allparents allchildren idtags idheads nextarc
6799 global arcnos arcids arctags arcout arcend arcstart archeads growing
6800 global seeds allcommits cachedarcs allcupdate
6803 while {[incr nid
] <= 1000 && [gets
$fd line
] >= 0} {
6804 set id
[lindex
$line 0]
6805 if {[info exists allparents
($id)]} {
6810 set olds
[lrange
$line 1 end
]
6811 set allparents
($id) $olds
6812 if {![info exists allchildren
($id)]} {
6813 set allchildren
($id) {}
6818 if {[llength
$olds] == 1 && [llength
$a] == 1} {
6819 lappend arcids
($a) $id
6820 if {[info exists idtags
($id)]} {
6821 lappend arctags
($a) $id
6823 if {[info exists idheads
($id)]} {
6824 lappend archeads
($a) $id
6826 if {[info exists allparents
($olds)]} {
6827 # seen parent already
6828 if {![info exists arcout
($olds)]} {
6831 lappend arcids
($a) $olds
6832 set arcend
($a) $olds
6835 lappend allchildren
($olds) $id
6836 lappend arcnos
($olds) $a
6840 foreach a
$arcnos($id) {
6841 lappend arcids
($a) $id
6848 lappend allchildren
($p) $id
6849 set a
[incr nextarc
]
6850 set arcstart
($a) $id
6857 if {[info exists allparents
($p)]} {
6858 # seen it already, may need to make a new branch
6859 if {![info exists arcout
($p)]} {
6862 lappend arcids
($a) $p
6866 lappend arcnos
($p) $a
6871 global cached_dheads cached_dtags cached_atags
6872 catch
{unset cached_dheads
}
6873 catch
{unset cached_dtags
}
6874 catch
{unset cached_atags
}
6877 return [expr {$nid >= 1000?
2: 1}]
6881 fconfigure
$fd -blocking 1
6884 # got an error reading the list of commits
6885 # if we were updating, try rereading the whole thing again
6891 error_popup
"[mc "Error reading commit topology information
;\
6892 branch and preceding
/following tag information\
6893 will be incomplete.
"]\n($err)"
6896 if {[incr allcommits
-1] == 0} {
6906 proc recalcarc
{a
} {
6907 global arctags archeads arcids idtags idheads
6911 foreach id
[lrange
$arcids($a) 0 end-1
] {
6912 if {[info exists idtags
($id)]} {
6915 if {[info exists idheads
($id)]} {
6920 set archeads
($a) $ah
6924 global arcnos arcids nextarc arctags archeads idtags idheads
6925 global arcstart arcend arcout allparents growing
6928 if {[llength
$a] != 1} {
6929 puts
"oops splitarc called but [llength $a] arcs already"
6933 set i
[lsearch
-exact $arcids($a) $p]
6935 puts
"oops splitarc $p not in arc $a"
6938 set na
[incr nextarc
]
6939 if {[info exists arcend
($a)]} {
6940 set arcend
($na) $arcend($a)
6942 set l
[lindex
$allparents([lindex
$arcids($a) end
]) 0]
6943 set j
[lsearch
-exact $arcnos($l) $a]
6944 set arcnos
($l) [lreplace
$arcnos($l) $j $j $na]
6946 set tail [lrange
$arcids($a) [expr {$i+1}] end
]
6947 set arcids
($a) [lrange
$arcids($a) 0 $i]
6949 set arcstart
($na) $p
6951 set arcids
($na) $tail
6952 if {[info exists growing
($a)]} {
6958 if {[llength
$arcnos($id)] == 1} {
6961 set j
[lsearch
-exact $arcnos($id) $a]
6962 set arcnos
($id) [lreplace
$arcnos($id) $j $j $na]
6966 # reconstruct tags and heads lists
6967 if {$arctags($a) ne
{} ||
$archeads($a) ne
{}} {
6972 set archeads
($na) {}
6976 # Update things for a new commit added that is a child of one
6977 # existing commit. Used when cherry-picking.
6978 proc addnewchild
{id p
} {
6979 global allparents allchildren idtags nextarc
6980 global arcnos arcids arctags arcout arcend arcstart archeads growing
6981 global seeds allcommits
6983 if {![info exists allcommits
] ||
![info exists arcnos
($p)]} return
6984 set allparents
($id) [list
$p]
6985 set allchildren
($id) {}
6988 lappend allchildren
($p) $id
6989 set a
[incr nextarc
]
6990 set arcstart
($a) $id
6993 set arcids
($a) [list
$p]
6995 if {![info exists arcout
($p)]} {
6998 lappend arcnos
($p) $a
6999 set arcout
($id) [list
$a]
7002 # This implements a cache for the topology information.
7003 # The cache saves, for each arc, the start and end of the arc,
7004 # the ids on the arc, and the outgoing arcs from the end.
7005 proc readcache
{f
} {
7006 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7007 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7012 if {$lim - $a > 500} {
7013 set lim
[expr {$a + 500}]
7017 # finish reading the cache and setting up arctags, etc.
7019 if {$line ne
"1"} {error
"bad final version"}
7021 foreach id
[array names idtags
] {
7022 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
7023 [llength
$allparents($id)] == 1} {
7024 set a
[lindex
$arcnos($id) 0]
7025 if {$arctags($a) eq
{}} {
7030 foreach id
[array names idheads
] {
7031 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
7032 [llength
$allparents($id)] == 1} {
7033 set a
[lindex
$arcnos($id) 0]
7034 if {$archeads($a) eq
{}} {
7039 foreach id
[lsort
-unique $possible_seeds] {
7040 if {$arcnos($id) eq
{}} {
7046 while {[incr a
] <= $lim} {
7048 if {[llength
$line] != 3} {error
"bad line"}
7049 set s
[lindex
$line 0]
7051 lappend arcout
($s) $a
7052 if {![info exists arcnos
($s)]} {
7053 lappend possible_seeds
$s
7056 set e
[lindex
$line 1]
7061 if {![info exists arcout
($e)]} {
7065 set arcids
($a) [lindex
$line 2]
7066 foreach id
$arcids($a) {
7067 lappend allparents
($s) $id
7069 lappend arcnos
($id) $a
7071 if {![info exists allparents
($s)]} {
7072 set allparents
($s) {}
7077 set nextarc
[expr {$a - 1}]
7090 global nextarc cachedarcs possible_seeds
7094 if {[llength
$line] != 2 ||
[lindex
$line 0] ne
"1"} {error
"bad version"}
7095 # make sure it's an integer
7096 set cachedarcs
[expr {int
([lindex
$line 1])}]
7097 if {$cachedarcs < 0} {error
"bad number of arcs"}
7099 set possible_seeds
{}
7107 proc dropcache
{err
} {
7108 global allcwait nextarc cachedarcs seeds
7110 #puts "dropping cache ($err)"
7111 foreach v
{arcnos arcout arcids arcstart arcend growing \
7112 arctags archeads allparents allchildren
} {
7123 proc writecache
{f
} {
7124 global cachearc cachedarcs allccache
7125 global arcstart arcend arcnos arcids arcout
7129 if {$lim - $a > 1000} {
7130 set lim
[expr {$a + 1000}]
7133 while {[incr a
] <= $lim} {
7134 if {[info exists arcend
($a)]} {
7135 puts
$f [list
$arcstart($a) $arcend($a) $arcids($a)]
7137 puts
$f [list
$arcstart($a) {} $arcids($a)]
7142 catch
{file delete
$allccache}
7143 #puts "writing cache failed ($err)"
7146 set cachearc
[expr {$a - 1}]
7147 if {$a > $cachedarcs} {
7156 global nextarc cachedarcs cachearc allccache
7158 if {$nextarc == $cachedarcs} return
7160 set cachedarcs
$nextarc
7162 set f
[open
$allccache w
]
7163 puts
$f [list
1 $cachedarcs]
7168 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7169 # or 0 if neither is true.
7170 proc anc_or_desc
{a b
} {
7171 global arcout arcstart arcend arcnos cached_isanc
7173 if {$arcnos($a) eq
$arcnos($b)} {
7174 # Both are on the same arc(s); either both are the same BMP,
7175 # or if one is not a BMP, the other is also not a BMP or is
7176 # the BMP at end of the arc (and it only has 1 incoming arc).
7177 # Or both can be BMPs with no incoming arcs.
7178 if {$a eq
$b ||
$arcnos($a) eq
{}} {
7181 # assert {[llength $arcnos($a)] == 1}
7182 set arc
[lindex
$arcnos($a) 0]
7183 set i
[lsearch
-exact $arcids($arc) $a]
7184 set j
[lsearch
-exact $arcids($arc) $b]
7185 if {$i < 0 ||
$i > $j} {
7192 if {![info exists arcout
($a)]} {
7193 set arc
[lindex
$arcnos($a) 0]
7194 if {[info exists arcend
($arc)]} {
7195 set aend
$arcend($arc)
7199 set a
$arcstart($arc)
7203 if {![info exists arcout
($b)]} {
7204 set arc
[lindex
$arcnos($b) 0]
7205 if {[info exists arcend
($arc)]} {
7206 set bend
$arcend($arc)
7210 set b
$arcstart($arc)
7220 if {[info exists cached_isanc
($a,$bend)]} {
7221 if {$cached_isanc($a,$bend)} {
7225 if {[info exists cached_isanc
($b,$aend)]} {
7226 if {$cached_isanc($b,$aend)} {
7229 if {[info exists cached_isanc
($a,$bend)]} {
7234 set todo
[list
$a $b]
7237 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7238 set x
[lindex
$todo $i]
7239 if {$anc($x) eq
{}} {
7242 foreach arc
$arcnos($x) {
7243 set xd
$arcstart($arc)
7245 set cached_isanc
($a,$bend) 1
7246 set cached_isanc
($b,$aend) 0
7248 } elseif
{$xd eq
$aend} {
7249 set cached_isanc
($b,$aend) 1
7250 set cached_isanc
($a,$bend) 0
7253 if {![info exists anc
($xd)]} {
7254 set anc
($xd) $anc($x)
7256 } elseif
{$anc($xd) ne
$anc($x)} {
7261 set cached_isanc
($a,$bend) 0
7262 set cached_isanc
($b,$aend) 0
7266 # This identifies whether $desc has an ancestor that is
7267 # a growing tip of the graph and which is not an ancestor of $anc
7268 # and returns 0 if so and 1 if not.
7269 # If we subsequently discover a tag on such a growing tip, and that
7270 # turns out to be a descendent of $anc (which it could, since we
7271 # don't necessarily see children before parents), then $desc
7272 # isn't a good choice to display as a descendent tag of
7273 # $anc (since it is the descendent of another tag which is
7274 # a descendent of $anc). Similarly, $anc isn't a good choice to
7275 # display as a ancestor tag of $desc.
7277 proc is_certain
{desc anc
} {
7278 global arcnos arcout arcstart arcend growing problems
7281 if {[llength
$arcnos($anc)] == 1} {
7282 # tags on the same arc are certain
7283 if {$arcnos($desc) eq
$arcnos($anc)} {
7286 if {![info exists arcout
($anc)]} {
7287 # if $anc is partway along an arc, use the start of the arc instead
7288 set a
[lindex
$arcnos($anc) 0]
7289 set anc
$arcstart($a)
7292 if {[llength
$arcnos($desc)] > 1 ||
[info exists arcout
($desc)]} {
7295 set a
[lindex
$arcnos($desc) 0]
7301 set anclist
[list
$x]
7305 for {set i
0} {$i < [llength
$anclist] && ($nnh > 0 ||
$ngrowanc > 0)} {incr i
} {
7306 set x
[lindex
$anclist $i]
7311 foreach a
$arcout($x) {
7312 if {[info exists growing
($a)]} {
7313 if {![info exists growanc
($x)] && $dl($x)} {
7319 if {[info exists dl
($y)]} {
7323 if {![info exists
done($y)]} {
7326 if {[info exists growanc
($x)]} {
7330 for {set k
0} {$k < [llength
$xl]} {incr k
} {
7331 set z
[lindex
$xl $k]
7332 foreach c
$arcout($z) {
7333 if {[info exists arcend
($c)]} {
7335 if {[info exists dl
($v)] && $dl($v)} {
7337 if {![info exists
done($v)]} {
7340 if {[info exists growanc
($v)]} {
7350 } elseif
{$y eq
$anc ||
!$dl($x)} {
7361 foreach x
[array names growanc
] {
7370 proc validate_arctags
{a
} {
7371 global arctags idtags
7375 foreach id
$arctags($a) {
7377 if {![info exists idtags
($id)]} {
7378 set na
[lreplace
$na $i $i]
7385 proc validate_archeads
{a
} {
7386 global archeads idheads
7389 set na
$archeads($a)
7390 foreach id
$archeads($a) {
7392 if {![info exists idheads
($id)]} {
7393 set na
[lreplace
$na $i $i]
7397 set archeads
($a) $na
7400 # Return the list of IDs that have tags that are descendents of id,
7401 # ignoring IDs that are descendents of IDs already reported.
7402 proc desctags
{id
} {
7403 global arcnos arcstart arcids arctags idtags allparents
7404 global growing cached_dtags
7406 if {![info exists allparents
($id)]} {
7409 set t1
[clock clicks
-milliseconds]
7411 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7412 # part-way along an arc; check that arc first
7413 set a
[lindex
$arcnos($id) 0]
7414 if {$arctags($a) ne
{}} {
7416 set i
[lsearch
-exact $arcids($a) $id]
7418 foreach t
$arctags($a) {
7419 set j
[lsearch
-exact $arcids($a) $t]
7427 set id
$arcstart($a)
7428 if {[info exists idtags
($id)]} {
7432 if {[info exists cached_dtags
($id)]} {
7433 return $cached_dtags($id)
7440 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7441 set id
[lindex
$todo $i]
7443 set ta
[info exists hastaggedancestor
($id)]
7447 # ignore tags on starting node
7448 if {!$ta && $i > 0} {
7449 if {[info exists idtags
($id)]} {
7452 } elseif
{[info exists cached_dtags
($id)]} {
7453 set tagloc
($id) $cached_dtags($id)
7457 foreach a
$arcnos($id) {
7459 if {!$ta && $arctags($a) ne
{}} {
7461 if {$arctags($a) ne
{}} {
7462 lappend tagloc
($id) [lindex
$arctags($a) end
]
7465 if {$ta ||
$arctags($a) ne
{}} {
7466 set tomark
[list
$d]
7467 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7468 set dd [lindex
$tomark $j]
7469 if {![info exists hastaggedancestor
($dd)]} {
7470 if {[info exists
done($dd)]} {
7471 foreach b
$arcnos($dd) {
7472 lappend tomark
$arcstart($b)
7474 if {[info exists tagloc
($dd)]} {
7477 } elseif
{[info exists queued
($dd)]} {
7480 set hastaggedancestor
($dd) 1
7484 if {![info exists queued
($d)]} {
7487 if {![info exists hastaggedancestor
($d)]} {
7494 foreach id
[array names tagloc
] {
7495 if {![info exists hastaggedancestor
($id)]} {
7496 foreach t
$tagloc($id) {
7497 if {[lsearch
-exact $tags $t] < 0} {
7503 set t2
[clock clicks
-milliseconds]
7506 # remove tags that are descendents of other tags
7507 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7508 set a
[lindex
$tags $i]
7509 for {set j
0} {$j < $i} {incr j
} {
7510 set b
[lindex
$tags $j]
7511 set r
[anc_or_desc
$a $b]
7513 set tags
[lreplace
$tags $j $j]
7516 } elseif
{$r == -1} {
7517 set tags
[lreplace
$tags $i $i]
7524 if {[array names growing
] ne
{}} {
7525 # graph isn't finished, need to check if any tag could get
7526 # eclipsed by another tag coming later. Simply ignore any
7527 # tags that could later get eclipsed.
7530 if {[is_certain
$t $origid]} {
7534 if {$tags eq
$ctags} {
7535 set cached_dtags
($origid) $tags
7540 set cached_dtags
($origid) $tags
7542 set t3
[clock clicks
-milliseconds]
7543 if {0 && $t3 - $t1 >= 100} {
7544 puts
"iterating descendents ($loopix/[llength $todo] nodes) took\
7545 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7551 global arcnos arcids arcout arcend arctags idtags allparents
7552 global growing cached_atags
7554 if {![info exists allparents
($id)]} {
7557 set t1
[clock clicks
-milliseconds]
7559 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7560 # part-way along an arc; check that arc first
7561 set a
[lindex
$arcnos($id) 0]
7562 if {$arctags($a) ne
{}} {
7564 set i
[lsearch
-exact $arcids($a) $id]
7565 foreach t
$arctags($a) {
7566 set j
[lsearch
-exact $arcids($a) $t]
7572 if {![info exists arcend
($a)]} {
7576 if {[info exists idtags
($id)]} {
7580 if {[info exists cached_atags
($id)]} {
7581 return $cached_atags($id)
7589 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7590 set id
[lindex
$todo $i]
7592 set td
[info exists hastaggeddescendent
($id)]
7596 # ignore tags on starting node
7597 if {!$td && $i > 0} {
7598 if {[info exists idtags
($id)]} {
7601 } elseif
{[info exists cached_atags
($id)]} {
7602 set tagloc
($id) $cached_atags($id)
7606 foreach a
$arcout($id) {
7607 if {!$td && $arctags($a) ne
{}} {
7609 if {$arctags($a) ne
{}} {
7610 lappend tagloc
($id) [lindex
$arctags($a) 0]
7613 if {![info exists arcend
($a)]} continue
7615 if {$td ||
$arctags($a) ne
{}} {
7616 set tomark
[list
$d]
7617 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7618 set dd [lindex
$tomark $j]
7619 if {![info exists hastaggeddescendent
($dd)]} {
7620 if {[info exists
done($dd)]} {
7621 foreach b
$arcout($dd) {
7622 if {[info exists arcend
($b)]} {
7623 lappend tomark
$arcend($b)
7626 if {[info exists tagloc
($dd)]} {
7629 } elseif
{[info exists queued
($dd)]} {
7632 set hastaggeddescendent
($dd) 1
7636 if {![info exists queued
($d)]} {
7639 if {![info exists hastaggeddescendent
($d)]} {
7645 set t2
[clock clicks
-milliseconds]
7648 foreach id
[array names tagloc
] {
7649 if {![info exists hastaggeddescendent
($id)]} {
7650 foreach t
$tagloc($id) {
7651 if {[lsearch
-exact $tags $t] < 0} {
7658 # remove tags that are ancestors of other tags
7659 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7660 set a
[lindex
$tags $i]
7661 for {set j
0} {$j < $i} {incr j
} {
7662 set b
[lindex
$tags $j]
7663 set r
[anc_or_desc
$a $b]
7665 set tags
[lreplace
$tags $j $j]
7668 } elseif
{$r == 1} {
7669 set tags
[lreplace
$tags $i $i]
7676 if {[array names growing
] ne
{}} {
7677 # graph isn't finished, need to check if any tag could get
7678 # eclipsed by another tag coming later. Simply ignore any
7679 # tags that could later get eclipsed.
7682 if {[is_certain
$origid $t]} {
7686 if {$tags eq
$ctags} {
7687 set cached_atags
($origid) $tags
7692 set cached_atags
($origid) $tags
7694 set t3
[clock clicks
-milliseconds]
7695 if {0 && $t3 - $t1 >= 100} {
7696 puts
"iterating ancestors ($loopix/[llength $todo] nodes) took\
7697 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7702 # Return the list of IDs that have heads that are descendents of id,
7703 # including id itself if it has a head.
7704 proc descheads
{id
} {
7705 global arcnos arcstart arcids archeads idheads cached_dheads
7708 if {![info exists allparents
($id)]} {
7712 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7713 # part-way along an arc; check it first
7714 set a
[lindex
$arcnos($id) 0]
7715 if {$archeads($a) ne
{}} {
7716 validate_archeads
$a
7717 set i
[lsearch
-exact $arcids($a) $id]
7718 foreach t
$archeads($a) {
7719 set j
[lsearch
-exact $arcids($a) $t]
7724 set id
$arcstart($a)
7730 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7731 set id
[lindex
$todo $i]
7732 if {[info exists cached_dheads
($id)]} {
7733 set ret
[concat
$ret $cached_dheads($id)]
7735 if {[info exists idheads
($id)]} {
7738 foreach a
$arcnos($id) {
7739 if {$archeads($a) ne
{}} {
7740 validate_archeads
$a
7741 if {$archeads($a) ne
{}} {
7742 set ret
[concat
$ret $archeads($a)]
7746 if {![info exists seen
($d)]} {
7753 set ret
[lsort
-unique $ret]
7754 set cached_dheads
($origid) $ret
7755 return [concat
$ret $aret]
7758 proc addedtag
{id
} {
7759 global arcnos arcout cached_dtags cached_atags
7761 if {![info exists arcnos
($id)]} return
7762 if {![info exists arcout
($id)]} {
7763 recalcarc
[lindex
$arcnos($id) 0]
7765 catch
{unset cached_dtags
}
7766 catch
{unset cached_atags
}
7769 proc addedhead
{hid
head} {
7770 global arcnos arcout cached_dheads
7772 if {![info exists arcnos
($hid)]} return
7773 if {![info exists arcout
($hid)]} {
7774 recalcarc
[lindex
$arcnos($hid) 0]
7776 catch
{unset cached_dheads
}
7779 proc removedhead
{hid
head} {
7780 global cached_dheads
7782 catch
{unset cached_dheads
}
7785 proc movedhead
{hid
head} {
7786 global arcnos arcout cached_dheads
7788 if {![info exists arcnos
($hid)]} return
7789 if {![info exists arcout
($hid)]} {
7790 recalcarc
[lindex
$arcnos($hid) 0]
7792 catch
{unset cached_dheads
}
7795 proc changedrefs
{} {
7796 global cached_dheads cached_dtags cached_atags
7797 global arctags archeads arcnos arcout idheads idtags
7799 foreach id
[concat
[array names idheads
] [array names idtags
]] {
7800 if {[info exists arcnos
($id)] && ![info exists arcout
($id)]} {
7801 set a
[lindex
$arcnos($id) 0]
7802 if {![info exists donearc
($a)]} {
7808 catch
{unset cached_dtags
}
7809 catch
{unset cached_atags
}
7810 catch
{unset cached_dheads
}
7813 proc rereadrefs
{} {
7814 global idtags idheads idotherrefs mainhead
7816 set refids
[concat
[array names idtags
] \
7817 [array names idheads
] [array names idotherrefs
]]
7818 foreach id
$refids {
7819 if {![info exists ref
($id)]} {
7820 set ref
($id) [listrefs
$id]
7823 set oldmainhead
$mainhead
7826 set refids
[lsort
-unique [concat
$refids [array names idtags
] \
7827 [array names idheads
] [array names idotherrefs
]]]
7828 foreach id
$refids {
7829 set v
[listrefs
$id]
7830 if {![info exists ref
($id)] ||
$ref($id) != $v ||
7831 ($id eq
$oldmainhead && $id ne
$mainhead) ||
7832 ($id eq
$mainhead && $id ne
$oldmainhead)} {
7839 proc listrefs
{id
} {
7840 global idtags idheads idotherrefs
7843 if {[info exists idtags
($id)]} {
7847 if {[info exists idheads
($id)]} {
7851 if {[info exists idotherrefs
($id)]} {
7852 set z
$idotherrefs($id)
7854 return [list
$x $y $z]
7857 proc showtag
{tag isnew
} {
7858 global ctext tagcontents tagids linknum tagobjid
7861 addtohistory
[list showtag
$tag 0]
7863 $ctext conf
-state normal
7867 if {![info exists tagcontents
($tag)]} {
7869 set tagcontents
($tag) [exec git cat-file tag
$tagobjid($tag)]
7872 if {[info exists tagcontents
($tag)]} {
7873 set text
$tagcontents($tag)
7875 set text
"[mc "Tag
"]: $tag\n[mc "Id
"]: $tagids($tag)"
7877 appendwithlinks
$text {}
7878 $ctext conf
-state disabled
7889 proc mkfontdisp
{font top
which} {
7890 global fontattr fontpref
$font
7892 set fontpref
($font) [set $font]
7893 button
$top.
${font}but
-text $which -font optionfont \
7894 -command [list choosefont
$font $which]
7895 label
$top.
$font -relief flat
-font $font \
7896 -text $fontattr($font,family
) -justify left
7897 grid x
$top.
${font}but
$top.
$font -sticky w
7900 proc choosefont
{font
which} {
7901 global fontparam fontlist fonttop fontattr
7903 set fontparam
(which) $which
7904 set fontparam
(font
) $font
7905 set fontparam
(family
) [font actual
$font -family]
7906 set fontparam
(size
) $fontattr($font,size
)
7907 set fontparam
(weight
) $fontattr($font,weight
)
7908 set fontparam
(slant
) $fontattr($font,slant
)
7911 if {![winfo exists
$top]} {
7913 eval font config sample
[font actual
$font]
7915 wm title
$top [mc
"Gitk font chooser"]
7916 label
$top.l
-textvariable fontparam
(which)
7917 pack
$top.l
-side top
7918 set fontlist
[lsort
[font families
]]
7920 listbox
$top.f.fam
-listvariable fontlist \
7921 -yscrollcommand [list
$top.f.sb
set]
7922 bind $top.f.fam
<<ListboxSelect>> selfontfam
7923 scrollbar $top.f.sb -command [list $top.f.fam yview]
7924 pack $top.f.sb -side right -fill y
7925 pack $top.f.fam -side left -fill both -expand 1
7926 pack $top.f -side top -fill both -expand 1
7928 spinbox $top.g.size -from 4 -to 40 -width 4 \
7929 -textvariable fontparam(size) \
7930 -validatecommand {string is integer -strict %s}
7931 checkbutton $top.g.bold -padx 5 \
7932 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7933 -variable fontparam(weight) -onvalue bold -offvalue normal
7934 checkbutton $top.g.ital -padx 5 \
7935 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7936 -variable fontparam(slant) -onvalue italic -offvalue roman
7937 pack $top.g.size $top.g.bold $top.g.ital -side left
7938 pack $top.g -side top
7939 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7941 $top.c create text 100 25 -anchor center -text $which -font sample \
7942 -fill black -tags text
7943 bind $top.c <Configure> [list centertext $top.c]
7944 pack $top.c -side top -fill x
7946 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7947 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7948 grid $top.buts.ok $top.buts.can
7949 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7950 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7951 pack $top.buts -side bottom -fill x
7952 trace add variable fontparam write chg_fontparam
7955 $top.c itemconf text -text $which
7957 set i [lsearch -exact $fontlist $fontparam(family)]
7959 $top.f.fam selection set $i
7964 proc centertext {w} {
7965 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7969 global fontparam fontpref prefstop
7971 set f $fontparam(font)
7972 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7973 if {$fontparam(weight) eq "bold"} {
7974 lappend fontpref($f) "bold"
7976 if {$fontparam(slant) eq "italic"} {
7977 lappend fontpref($f) "italic"
7980 $w conf -text $fontparam(family) -font $fontpref($f)
7986 global fonttop fontparam
7988 if {[info exists fonttop]} {
7989 catch {destroy $fonttop}
7990 catch {font delete sample}
7996 proc selfontfam {} {
7997 global fonttop fontparam
7999 set i [$fonttop.f.fam curselection]
8001 set fontparam(family) [$fonttop.f.fam get $i]
8005 proc chg_fontparam {v sub op} {
8008 font config sample -$sub $fontparam($sub)
8012 global maxwidth maxgraphpct
8013 global oldprefs prefstop showneartags showlocalchanges
8014 global bgcolor fgcolor ctext diffcolors selectbgcolor
8015 global tabstop limitdiffs autoselect
8019 if {[winfo exists $top]} {
8023 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8024 limitdiffs tabstop} {
8025 set oldprefs($v) [set $v]
8028 wm title $top [mc "Gitk preferences"]
8029 label $top.ldisp -text [mc "Commit list display options"]
8030 grid $top.ldisp - -sticky w -pady 10
8031 label $top.spacer -text " "
8032 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8034 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8035 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8036 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8038 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8039 grid x $top.maxpctl $top.maxpct -sticky w
8040 frame $top.showlocal
8041 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8042 checkbutton $top.showlocal.b -variable showlocalchanges
8043 pack $top.showlocal.b $top.showlocal.l -side left
8044 grid x $top.showlocal -sticky w
8045 frame $top.autoselect
8046 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
8047 checkbutton $top.autoselect.b -variable autoselect
8048 pack $top.autoselect.b $top.autoselect.l -side left
8049 grid x $top.autoselect -sticky w
8051 label $top.ddisp -text [mc "Diff display options"]
8052 grid $top.ddisp - -sticky w -pady 10
8053 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8054 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8055 grid x $top.tabstopl $top.tabstop -sticky w
8057 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8058 checkbutton $top.ntag.b -variable showneartags
8059 pack $top.ntag.b $top.ntag.l -side left
8060 grid x $top.ntag -sticky w
8062 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8063 checkbutton $top.ldiff.b -variable limitdiffs
8064 pack $top.ldiff.b $top.ldiff.l -side left
8065 grid x $top.ldiff -sticky w
8067 label $top.cdisp -text [mc "Colors: press to choose"]
8068 grid $top.cdisp - -sticky w -pady 10
8069 label $top.bg -padx 40 -relief sunk -background $bgcolor
8070 button $top.bgbut -text [mc "Background"] -font optionfont \
8071 -command [list choosecolor bgcolor {} $top.bg background setbg]
8072 grid x $top.bgbut $top.bg -sticky w
8073 label $top.fg -padx 40 -relief sunk -background $fgcolor
8074 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8075 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
8076 grid x $top.fgbut $top.fg -sticky w
8077 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8078 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8079 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8080 [list $ctext tag conf d0 -foreground]]
8081 grid x $top.diffoldbut $top.diffold -sticky w
8082 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8083 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8084 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8085 [list $ctext tag conf d1 -foreground]]
8086 grid x $top.diffnewbut $top.diffnew -sticky w
8087 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8088 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8089 -command [list choosecolor diffcolors 2 $top.hunksep \
8090 "diff hunk header" \
8091 [list $ctext tag conf hunksep -foreground]]
8092 grid x $top.hunksepbut $top.hunksep -sticky w
8093 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8094 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8095 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
8096 grid x $top.selbgbut $top.selbgsep -sticky w
8098 label $top.cfont -text [mc "Fonts: press to choose"]
8099 grid $top.cfont - -sticky w -pady 10
8100 mkfontdisp mainfont $top [mc "Main font"]
8101 mkfontdisp textfont $top [mc "Diff display font"]
8102 mkfontdisp uifont $top [mc "User interface font"]
8105 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8106 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8107 grid $top.buts.ok $top.buts.can
8108 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8109 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8110 grid $top.buts - - -pady 10 -sticky ew
8111 bind $top <Visibility> "focus $top.buts.ok"
8114 proc choosecolor {v vi w x cmd} {
8117 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8118 -title [mc "Gitk: choose color for %s" $x]]
8119 if {$c eq {}} return
8120 $w conf -background $c
8126 global bglist cflist
8128 $w configure -selectbackground $c
8130 $cflist tag configure highlight \
8131 -background [$cflist cget -selectbackground]
8132 allcanvs itemconf secsel -fill $c
8139 $w conf -background $c
8147 $w conf -foreground $c
8149 allcanvs itemconf text -fill $c
8150 $canv itemconf circle -outline $c
8154 global oldprefs prefstop
8156 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8157 limitdiffs tabstop} {
8159 set $v $oldprefs($v)
8161 catch {destroy $prefstop}
8167 global maxwidth maxgraphpct
8168 global oldprefs prefstop showneartags showlocalchanges
8169 global fontpref mainfont textfont uifont
8170 global limitdiffs treediffs
8172 catch {destroy $prefstop}
8176 if {$mainfont ne $fontpref(mainfont)} {
8177 set mainfont $fontpref(mainfont)
8178 parsefont mainfont $mainfont
8179 eval font configure mainfont [fontflags mainfont]
8180 eval font configure mainfontbold [fontflags mainfont 1]
8184 if {$textfont ne $fontpref(textfont)} {
8185 set textfont $fontpref(textfont)
8186 parsefont textfont $textfont
8187 eval font configure textfont [fontflags textfont]
8188 eval font configure textfontbold [fontflags textfont 1]
8190 if {$uifont ne $fontpref(uifont)} {
8191 set uifont $fontpref(uifont)
8192 parsefont uifont $uifont
8193 eval font configure uifont [fontflags uifont]
8196 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8197 if {$showlocalchanges} {
8203 if {$limitdiffs != $oldprefs(limitdiffs)} {
8204 # treediffs elements are limited by path
8205 catch {unset treediffs}
8207 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8208 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8210 } elseif {$showneartags != $oldprefs(showneartags) ||
8211 $limitdiffs != $oldprefs(limitdiffs)} {
8216 proc formatdate {d} {
8217 global datetimeformat
8219 set d [clock format $d -format $datetimeformat]
8224 # This list of encoding names and aliases is distilled from
8225 # http://www.iana.org/assignments/character-sets.
8226 # Not all of them are supported by Tcl.
8227 set encoding_aliases {
8228 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8229 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8230 { ISO-10646-UTF-1 csISO10646UTF1 }
8231 { ISO_646.basic:1983 ref csISO646basic1983 }
8232 { INVARIANT csINVARIANT }
8233 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8234 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8235 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8236 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8237 { NATS-DANO iso-ir-9-1 csNATSDANO }
8238 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8239 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8240 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8241 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8242 { ISO-2022-KR csISO2022KR }
8244 { ISO-2022-JP csISO2022JP }
8245 { ISO-2022-JP-2 csISO2022JP2 }
8246 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8248 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8249 { IT iso-ir-15 ISO646-IT csISO15Italian }
8250 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8251 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8252 { greek7-old iso-ir-18 csISO18Greek7Old }
8253 { latin-greek iso-ir-19 csISO19LatinGreek }
8254 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8255 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8256 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8257 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8258 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8259 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8260 { INIS iso-ir-49 csISO49INIS }
8261 { INIS-8 iso-ir-50 csISO50INIS8 }
8262 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8263 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8264 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8265 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8266 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8267 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8269 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8270 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8271 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8272 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8273 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8274 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8275 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8276 { greek7 iso-ir-88 csISO88Greek7 }
8277 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8278 { iso-ir-90 csISO90 }
8279 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8280 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8281 csISO92JISC62991984b }
8282 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8283 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8284 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8285 csISO95JIS62291984handadd }
8286 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8287 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8288 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8289 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8291 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8292 { T.61-7bit iso-ir-102 csISO102T617bit }
8293 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8294 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8295 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8296 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8297 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8298 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8299 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8300 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8301 arabic csISOLatinArabic }
8302 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8303 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8304 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8305 greek greek8 csISOLatinGreek }
8306 { T.101-G2 iso-ir-128 csISO128T101G2 }
8307 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8309 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8310 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8311 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8312 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8313 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8314 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8315 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8316 csISOLatinCyrillic }
8317 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8318 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8319 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8320 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8321 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8322 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8323 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8324 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8325 { ISO_10367-box iso-ir-155 csISO10367Box }
8326 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8327 { latin-lap lap iso-ir-158 csISO158Lap }
8328 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8329 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8332 { JIS_X0201 X0201 csHalfWidthKatakana }
8333 { KSC5636 ISO646-KR csKSC5636 }
8334 { ISO-10646-UCS-2 csUnicode }
8335 { ISO-10646-UCS-4 csUCS4 }
8336 { DEC-MCS dec csDECMCS }
8337 { hp-roman8 roman8 r8 csHPRoman8 }
8338 { macintosh mac csMacintosh }
8339 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8341 { IBM038 EBCDIC-INT cp038 csIBM038 }
8342 { IBM273 CP273 csIBM273 }
8343 { IBM274 EBCDIC-BE CP274 csIBM274 }
8344 { IBM275 EBCDIC-BR cp275 csIBM275 }
8345 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8346 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8347 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8348 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8349 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8350 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8351 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8352 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8353 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8354 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8355 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8356 { IBM437 cp437 437 csPC8CodePage437 }
8357 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8358 { IBM775 cp775 csPC775Baltic }
8359 { IBM850 cp850 850 csPC850Multilingual }
8360 { IBM851 cp851 851 csIBM851 }
8361 { IBM852 cp852 852 csPCp852 }
8362 { IBM855 cp855 855 csIBM855 }
8363 { IBM857 cp857 857 csIBM857 }
8364 { IBM860 cp860 860 csIBM860 }
8365 { IBM861 cp861 861 cp-is csIBM861 }
8366 { IBM862 cp862 862 csPC862LatinHebrew }
8367 { IBM863 cp863 863 csIBM863 }
8368 { IBM864 cp864 csIBM864 }
8369 { IBM865 cp865 865 csIBM865 }
8370 { IBM866 cp866 866 csIBM866 }
8371 { IBM868 CP868 cp-ar csIBM868 }
8372 { IBM869 cp869 869 cp-gr csIBM869 }
8373 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8374 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8375 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8376 { IBM891 cp891 csIBM891 }
8377 { IBM903 cp903 csIBM903 }
8378 { IBM904 cp904 904 csIBBM904 }
8379 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8380 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8381 { IBM1026 CP1026 csIBM1026 }
8382 { EBCDIC-AT-DE csIBMEBCDICATDE }
8383 { EBCDIC-AT-DE-A csEBCDICATDEA }
8384 { EBCDIC-CA-FR csEBCDICCAFR }
8385 { EBCDIC-DK-NO csEBCDICDKNO }
8386 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8387 { EBCDIC-FI-SE csEBCDICFISE }
8388 { EBCDIC-FI-SE-A csEBCDICFISEA }
8389 { EBCDIC-FR csEBCDICFR }
8390 { EBCDIC-IT csEBCDICIT }
8391 { EBCDIC-PT csEBCDICPT }
8392 { EBCDIC-ES csEBCDICES }
8393 { EBCDIC-ES-A csEBCDICESA }
8394 { EBCDIC-ES-S csEBCDICESS }
8395 { EBCDIC-UK csEBCDICUK }
8396 { EBCDIC-US csEBCDICUS }
8397 { UNKNOWN-8BIT csUnknown8BiT }
8398 { MNEMONIC csMnemonic }
8403 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8404 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8405 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8406 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8407 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8408 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8409 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8410 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8411 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8412 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8413 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8414 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8415 { IBM1047 IBM-1047 }
8416 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8417 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8418 { UNICODE-1-1 csUnicode11 }
8421 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8422 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8424 { ISO-8859-15 ISO_8859-15 Latin-9 }
8425 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8426 { GBK CP936 MS936 windows-936 }
8427 { JIS_Encoding csJISEncoding }
8428 { Shift_JIS MS_Kanji csShiftJIS }
8429 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8431 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8432 { ISO-10646-UCS-Basic csUnicodeASCII }
8433 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8434 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8435 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8436 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8437 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8438 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8439 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8440 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8441 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8442 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8443 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8444 { Ventura-US csVenturaUS }
8445 { Ventura-International csVenturaInternational }
8446 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8447 { PC8-Turkish csPC8Turkish }
8448 { IBM-Symbols csIBMSymbols }
8449 { IBM-Thai csIBMThai }
8450 { HP-Legal csHPLegal }
8451 { HP-Pi-font csHPPiFont }
8452 { HP-Math8 csHPMath8 }
8453 { Adobe-Symbol-Encoding csHPPSMath }
8454 { HP-DeskTop csHPDesktop }
8455 { Ventura-Math csVenturaMath }
8456 { Microsoft-Publishing csMicrosoftPublishing }
8457 { Windows-31J csWindows31J }
8462 proc tcl_encoding {enc} {
8463 global encoding_aliases
8464 set names [encoding names]
8465 set lcnames [string tolower $names]
8466 set enc [string tolower $enc]
8467 set i [lsearch -exact $lcnames $enc]
8469 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8470 if {[regsub {^iso[-_]} $enc iso encx]} {
8471 set i [lsearch -exact $lcnames $encx]
8475 foreach l $encoding_aliases {
8476 set ll [string tolower $l]
8477 if {[lsearch -exact $ll $enc] < 0} continue
8478 # look through the aliases for one that tcl knows about
8480 set i [lsearch -exact $lcnames $e]
8482 if {[regsub {^iso[-_]} $e iso ex]} {
8483 set i [lsearch -exact $lcnames $ex]
8492 return [lindex $names $i]
8497 # First check that Tcl/Tk is recent enough
8498 if {[catch {package require Tk 8.4} err]} {
8499 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8500 Gitk requires at least Tcl/Tk 8.4."]
8506 set wrcomcmd "git diff-tree --stdin -p --pretty"
8510 set gitencoding [exec git config --get i18n.commitencoding]
8512 if {$gitencoding == ""} {
8513 set gitencoding "utf-8"
8515 set tclencoding [tcl_encoding $gitencoding]
8516 if {$tclencoding == {}} {
8517 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8520 set mainfont {Helvetica 9}
8521 set textfont {Courier 9}
8522 set uifont {Helvetica 9 bold}
8524 set findmergefiles 0
8532 set cmitmode "patch"
8533 set wrapcomment "none"
8537 set showlocalchanges 1
8539 set datetimeformat "%Y-%m-%d %H:%M:%S"
8542 set colors {green red blue magenta darkgrey brown orange}
8545 set diffcolors {red "#00a000" blue}
8548 set selectbgcolor gray85
8550 ## For msgcat loading, first locate the installation location.
8551 if { [info exists ::env(GITK_MSGSDIR)] } {
8552 ## Msgsdir was manually set in the environment.
8553 set gitk_msgsdir $::env(GITK_MSGSDIR)
8555 ## Let's guess the prefix from argv0.
8556 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8557 set gitk_libdir [file join $gitk_prefix share gitk lib]
8558 set gitk_msgsdir [file join $gitk_libdir msgs]
8562 ## Internationalization (i18n) through msgcat and gettext. See
8563 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8564 package require msgcat
8565 namespace import ::msgcat::mc
8566 ## And eventually load the actual message catalog
8567 ::msgcat::mcload $gitk_msgsdir
8569 catch {source ~/.gitk}
8571 font create optionfont -family sans-serif -size -12
8573 parsefont mainfont $mainfont
8574 eval font create mainfont [fontflags mainfont]
8575 eval font create mainfontbold [fontflags mainfont 1]
8577 parsefont textfont $textfont
8578 eval font create textfont [fontflags textfont]
8579 eval font create textfontbold [fontflags textfont 1]
8581 parsefont uifont $uifont
8582 eval font create uifont [fontflags uifont]
8586 # check that we can find a .git directory somewhere...
8587 if {[catch {set gitdir [gitdir]}]} {
8588 show_error {} . [mc "Cannot find a git repository here."]
8591 if {![file isdirectory $gitdir]} {
8592 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8598 set cmdline_files {}
8600 set revtreeargscmd {}
8602 switch -glob -- $arg {
8604 "-d" { set datemode 1 }
8607 lappend revtreeargs $arg
8610 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8614 set revtreeargscmd [string range $arg 10 end]
8617 lappend revtreeargs $arg
8623 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8624 # no -- on command line, but some arguments (other than -d)
8626 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8627 set cmdline_files [split $f "\n"]
8628 set n [llength $cmdline_files]
8629 set revtreeargs [lrange $revtreeargs 0 end-$n]
8630 # Unfortunately git rev-parse doesn't produce an error when
8631 # something is both a revision and a filename. To be consistent
8632 # with git log and git rev-list, check revtreeargs for filenames.
8633 foreach arg $revtreeargs {
8634 if {[file exists $arg]} {
8635 show_error {} . [mc "Ambiguous argument '%s': both revision\
8641 # unfortunately we get both stdout and stderr in $err,
8642 # so look for "fatal:".
8643 set i [string first "fatal:" $err]
8645 set err [string range $err [expr {$i + 6}] end]
8647 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8653 # find the list of unmerged files
8657 set fd [open "| git ls-files -u" r]
8659 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8662 while {[gets $fd line] >= 0} {
8663 set i [string first "\t" $line]
8664 if {$i < 0} continue
8665 set fname [string range $line [expr {$i+1}] end]
8666 if {[lsearch -exact $mlist $fname] >= 0} continue
8668 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8669 lappend mlist $fname
8674 if {$nr_unmerged == 0} {
8675 show_error {} . [mc "No files selected: --merge specified but\
8676 no files are unmerged."]
8678 show_error {} . [mc "No files selected: --merge specified but\
8679 no unmerged files are within file limit."]
8683 set cmdline_files $mlist
8686 set nullid "0000000000000000000000000000000000000000"
8687 set nullid2 "0000000000000000000000000000000000000001"
8689 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8696 set highlight_paths {}
8698 set searchdirn -forwards
8702 set markingmatches 0
8703 set linkentercount 0
8704 set need_redisplay 0
8711 set selectedhlview [mc "None"]
8712 set highlight_related [mc "None"]
8713 set highlight_files {}
8717 set viewargscmd(0) {}
8726 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
8729 # wait for the window to become visible
8731 wm title . "[file tail $argv0]: [file tail [pwd]]"
8734 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
8735 # create a view for the files/dirs specified on the command line
8739 set viewname(1) [mc "Command line"]
8740 set viewfiles(1) $cmdline_files
8741 set viewargs(1) $revtreeargs
8742 set viewargscmd(1) $revtreeargscmd
8745 .bar.view entryconf [mc "Edit view..."] -state normal
8746 .bar.view entryconf [mc "Delete view"] -state normal
8749 if {[info exists permviews]} {
8750 foreach v $permviews {
8753 set viewname($n) [lindex $v 0]
8754 set viewfiles($n) [lindex $v 1]
8755 set viewargs($n) [lindex $v 2]
8756 set viewargscmd($n) [lindex $v 3]