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 viewfiles commitidx viewcomplete vnextroot
86 global showlocalchanges commitinterest mainheadid
87 global progressdirn progresscoords proglastnc curview
89 set startmsecs
[clock clicks
-milliseconds]
90 set commitidx
($view) 0
91 set viewcomplete
($view) 0
92 set vnextroot
($view) 0
93 set order
"--topo-order"
95 set order
"--date-order"
98 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$order --parents \
99 --boundary $viewargs($view) "--" $viewfiles($view)] r
]
101 error_popup
"[mc "Error executing git rev-list
:"] $err"
104 set commfd
($view) $fd
105 set leftover
($view) {}
106 if {$showlocalchanges} {
107 lappend commitinterest
($mainheadid) {dodiffindex
}
109 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
110 if {$tclencoding != {}} {
111 fconfigure
$fd -encoding $tclencoding
113 filerun
$fd [list getcommitlines
$fd $view]
114 nowbusy
$view [mc
"Reading"]
115 if {$view == $curview} {
117 set progresscoords
{0 0}
122 proc stop_rev_list
{} {
123 global commfd curview
125 if {![info exists commfd
($curview)]} return
126 set fd
$commfd($curview)
132 unset commfd
($curview)
136 global phase canv curview
140 start_rev_list
$curview
141 show_status
[mc
"Reading commits..."]
144 # This makes a string representation of a positive integer which
145 # sorts as a string in numerical order
148 return [format
"%x" $n]
149 } elseif
{$n < 256} {
150 return [format
"x%.2x" $n]
151 } elseif
{$n < 65536} {
152 return [format
"y%.4x" $n]
154 return [format
"z%.8x" $n]
157 proc getcommitlines
{fd view
} {
158 global commitlisted commitinterest
159 global leftover commfd
160 global displayorder commitidx viewcomplete commitrow commitdata
161 global parentlist children curview hlview
162 global vparentlist vdisporder vcmitlisted
163 global ordertok vnextroot idpending
165 set stuff
[read $fd 500000]
166 # git log doesn't terminate the last commit with a null...
167 if {$stuff == {} && $leftover($view) ne
{} && [eof
$fd]} {
174 # Check if we have seen any ids listed as parents that haven't
175 # appeared in the list
176 foreach vid
[array names idpending
"$view,*"] {
177 # should only get here if git log is buggy
178 set id
[lindex
[split $vid ","] 1]
179 set commitrow
($vid) $commitidx($view)
180 incr commitidx
($view)
181 if {$view == $curview} {
182 lappend parentlist
{}
183 lappend displayorder
$id
184 lappend commitlisted
0
186 lappend vparentlist
($view) {}
187 lappend vdisporder
($view) $id
188 lappend vcmitlisted
($view) 0
191 set viewcomplete
($view) 1
192 global viewname progresscoords
195 set progresscoords
{0 0}
197 # set it blocking so we wait for the process to terminate
198 fconfigure
$fd -blocking 1
199 if {[catch
{close
$fd} err
]} {
201 if {$view != $curview} {
202 set fv
" for the \"$viewname($view)\" view"
204 if {[string range
$err 0 4] == "usage"} {
205 set err
"Gitk: error reading commits$fv:\
206 bad arguments to git rev-list."
207 if {$viewname($view) eq
"Command line"} {
209 " (Note: arguments to gitk are passed to git rev-list\
210 to allow selection of commits to be displayed.)"
213 set err
"Error reading commits$fv: $err"
217 if {$view == $curview} {
218 run chewcommits
$view
225 set i
[string first
"\0" $stuff $start]
227 append leftover
($view) [string range
$stuff $start end
]
231 set cmit
$leftover($view)
232 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
233 set leftover
($view) {}
235 set cmit
[string range
$stuff $start [expr {$i - 1}]]
237 set start
[expr {$i + 1}]
238 set j
[string first
"\n" $cmit]
241 if {$j >= 0 && [string match
"commit *" $cmit]} {
242 set ids
[string range
$cmit 7 [expr {$j - 1}]]
243 if {[string match
{[-^
<>]*} $ids]} {
244 switch
-- [string index
$ids 0] {
250 set ids
[string range
$ids 1 end
]
254 if {[string length
$id] != 40} {
262 if {[string length
$shortcmit] > 80} {
263 set shortcmit
"[string range $shortcmit 0 80]..."
265 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
268 set id [lindex $ids 0]
269 if {![info exists ordertok($view,$id)]} {
270 set otok "o[strrep $vnextroot($view)]"
271 incr vnextroot($view)
272 set ordertok($view,$id) $otok
274 set otok $ordertok($view,$id)
275 unset idpending($view,$id)
278 set olds [lrange $ids 1 end]
279 if {[llength $olds] == 1} {
280 set p [lindex $olds 0]
281 lappend children($view,$p) $id
282 if {![info exists ordertok($view,$p)]} {
283 set ordertok($view,$p) $ordertok($view,$id)
284 set idpending($view,$p) 1
289 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
290 lappend children($view,$p) $id
292 if {![info exists ordertok($view,$p)]} {
293 set ordertok($view,$p) "$otok[strrep $i]]"
294 set idpending($view,$p) 1
302 if {![info exists children($view,$id)]} {
303 set children($view,$id) {}
305 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
306 set commitrow($view,$id) $commitidx($view)
307 incr commitidx($view)
308 if {$view == $curview} {
309 lappend parentlist $olds
310 lappend displayorder $id
311 lappend commitlisted $listed
313 lappend vparentlist($view) $olds
314 lappend vdisporder($view) $id
315 lappend vcmitlisted($view) $listed
317 if {[info exists commitinterest($id)]} {
318 foreach script $commitinterest($id) {
319 eval [string map [list "%I" $id] $script]
321 unset commitinterest($id)
326 run chewcommits $view
327 if {$view == $curview} {
328 # update progress bar
329 global progressdirn progresscoords proglastnc
330 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
331 set proglastnc $commitidx($view)
332 set l [lindex $progresscoords 0]
333 set r [lindex $progresscoords 1]
335 set r [expr {$r + $inc}]
341 set l [expr {$r - 0.2}]
344 set l [expr {$l - $inc}]
349 set r [expr {$l + 0.2}]
351 set progresscoords [list $l $r]
358 proc chewcommits {view} {
359 global curview hlview viewcomplete
360 global selectedline pending_select
362 if {$view == $curview} {
364 if {$viewcomplete($view)} {
365 global displayorder commitidx phase
366 global numcommits startmsecs
368 if {[info exists pending_select]} {
369 set row [first_real_row]
372 if {$commitidx($curview) > 0} {
373 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
374 #puts "overall $ms ms for $numcommits commits"
376 show_status [mc "No commits selected"]
382 if {[info exists hlview] && $view == $hlview} {
388 proc readcommit {id} {
389 if {[catch {set contents [exec git cat-file commit $id]}]} return
390 parsecommit $id $contents 0
393 proc updatecommits {} {
394 global viewdata curview phase displayorder ordertok idpending
395 global children commitrow selectedline thickerline showneartags
402 foreach id $displayorder {
403 catch {unset children($n,$id)}
404 catch {unset commitrow($n,$id)}
405 catch {unset ordertok($n,$id)}
407 foreach vid [array names idpending "$n,*"] {
408 unset idpending($vid)
411 catch {unset selectedline}
412 catch {unset thickerline}
413 catch {unset viewdata($n)}
422 proc parsecommit {id contents listed} {
423 global commitinfo cdate
432 set hdrend [string first "\n\n" $contents]
434 # should never happen...
435 set hdrend [string length $contents]
437 set header [string range $contents 0 [expr {$hdrend - 1}]]
438 set comment [string range $contents [expr {$hdrend + 2}] end]
439 foreach line [split $header "\n"] {
440 set tag [lindex $line 0]
441 if {$tag == "author"} {
442 set audate [lindex $line end-1]
443 set auname [lrange $line 1 end-2]
444 } elseif {$tag == "committer"} {
445 set comdate [lindex $line end-1]
446 set comname [lrange $line 1 end-2]
450 # take the first non-blank line of the comment as the headline
451 set headline [string trimleft $comment]
452 set i [string first "\n" $headline]
454 set headline [string range $headline 0 $i]
456 set headline [string trimright $headline]
457 set i [string first "\r" $headline]
459 set headline [string trimright [string range $headline 0 $i]]
462 # git rev-list indents the comment by 4 spaces;
463 # if we got this via git cat-file, add the indentation
465 foreach line [split $comment "\n"] {
466 append newcomment " "
467 append newcomment $line
468 append newcomment "\n"
470 set comment $newcomment
472 if {$comdate != {}} {
473 set cdate($id) $comdate
475 set commitinfo($id) [list $headline $auname $audate \
476 $comname $comdate $comment]
479 proc getcommit {id} {
480 global commitdata commitinfo
482 if {[info exists commitdata($id)]} {
483 parsecommit $id $commitdata($id) 1
486 if {![info exists commitinfo($id)]} {
487 set commitinfo($id) [list [mc "No commit information available"]]
494 global tagids idtags headids idheads tagobjid
495 global otherrefids idotherrefs mainhead mainheadid
497 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
500 set refd [open [list | git show-ref -d] r]
501 while {[gets $refd line] >= 0} {
502 if {[string index $line 40] ne " "} continue
503 set id [string range $line 0 39]
504 set ref [string range $line 41 end]
505 if {![string match "refs/*" $ref]} continue
506 set name [string range $ref 5 end]
507 if {[string match "remotes/*" $name]} {
508 if {![string match "*/HEAD" $name]} {
509 set headids($name) $id
510 lappend idheads($id) $name
512 } elseif {[string match "heads/*" $name]} {
513 set name [string range $name 6 end]
514 set headids($name) $id
515 lappend idheads($id) $name
516 } elseif {[string match "tags/*" $name]} {
517 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
518 # which is what we want since the former is the commit ID
519 set name [string range $name 5 end]
520 if {[string match "*^{}" $name]} {
521 set name [string range $name 0 end-3]
523 set tagobjid($name) $id
525 set tagids($name) $id
526 lappend idtags($id) $name
528 set otherrefids($name) $id
529 lappend idotherrefs($id) $name
536 set thehead [exec git symbolic-ref HEAD]
537 if {[string match "refs/heads/*" $thehead]} {
538 set mainhead [string range $thehead 11 end]
539 if {[info exists headids($mainhead)]} {
540 set mainheadid $headids($mainhead)
546 # skip over fake commits
547 proc first_real_row {} {
548 global nullid nullid2 displayorder numcommits
550 for {set row 0} {$row < $numcommits} {incr row} {
551 set id [lindex $displayorder $row]
552 if {$id ne $nullid && $id ne $nullid2} {
559 # update things for a head moved to a child of its previous location
560 proc movehead {id name} {
561 global headids idheads
563 removehead $headids($name) $name
564 set headids($name) $id
565 lappend idheads($id) $name
568 # update things when a head has been removed
569 proc removehead {id name} {
570 global headids idheads
572 if {$idheads($id) eq $name} {
575 set i [lsearch -exact $idheads($id) $name]
577 set idheads($id) [lreplace $idheads($id) $i $i]
583 proc show_error {w top msg} {
584 message $w.m -text $msg -justify center -aspect 400
585 pack $w.m -side top -fill x -padx 20 -pady 20
586 button $w.ok -text [mc OK] -command "destroy $top"
587 pack $w.ok -side bottom -fill x
588 bind $top <Visibility> "grab $top; focus $top"
589 bind $top <Key-Return> "destroy $top"
593 proc error_popup msg {
597 show_error $w $w $msg
600 proc confirm_popup msg {
606 message $w.m -text $msg -justify center -aspect 400
607 pack $w.m -side top -fill x -padx 20 -pady 20
608 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
609 pack $w.ok -side left -fill x
610 button $w.cancel -text [mc Cancel] -command "destroy $w"
611 pack $w.cancel -side right -fill x
612 bind $w <Visibility> "grab $w; focus $w"
618 option add *Panedwindow.showHandle 1 startupFile
619 option add *Panedwindow.sashRelief raised startupFile
620 option add *Button.font uifont startupFile
621 option add *Checkbutton.font uifont startupFile
622 option add *Radiobutton.font uifont startupFile
623 option add *Menu.font uifont startupFile
624 option add *Menubutton.font uifont startupFile
625 option add *Label.font uifont startupFile
626 option add *Message.font uifont startupFile
627 option add *Entry.font uifont startupFile
631 global canv canv2 canv3 linespc charspc ctext cflist
633 global findtype findtypemenu findloc findstring fstring geometry
634 global entries sha1entry sha1string sha1but
635 global diffcontextstring diffcontext
637 global maincursor textcursor curtextcursor
638 global rowctxmenu fakerowmenu mergemax wrapcomment
639 global highlight_files gdttype
640 global searchstring sstring
641 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
642 global headctxmenu progresscanv progressitem progresscoords statusw
643 global fprogitem fprogcoord lastprogupdate progupdatepending
644 global rprogitem rprogcoord
648 .bar add cascade -label [mc "File"] -menu .bar.file
650 .bar.file add command -label [mc "Update"] -command updatecommits
651 .bar.file add command -label [mc "Reread references"] -command rereadrefs
652 .bar.file add command -label [mc "List references"] -command showrefs
653 .bar.file add command -label [mc "Quit"] -command doquit
655 .bar add cascade -label [mc "Edit"] -menu .bar.edit
656 .bar.edit add command -label [mc "Preferences"] -command doprefs
659 .bar add cascade -label [mc "View"] -menu .bar.view
660 .bar.view add command -label [mc "New view..."] -command {newview 0}
661 .bar.view add command -label [mc "Edit view..."] -command editview \
663 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
664 .bar.view add separator
665 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
666 -variable selectedview -value 0
669 .bar add cascade -label [mc "Help"] -menu .bar.help
670 .bar.help add command -label [mc "About gitk"] -command about
671 .bar.help add command -label [mc "Key bindings"] -command keys
673 . configure -menu .bar
675 # the gui has upper and lower half, parts of a paned window.
676 panedwindow .ctop -orient vertical
678 # possibly use assumed geometry
679 if {![info exists geometry(pwsash0)]} {
680 set geometry(topheight) [expr {15 * $linespc}]
681 set geometry(topwidth) [expr {80 * $charspc}]
682 set geometry(botheight) [expr {15 * $linespc}]
683 set geometry(botwidth) [expr {50 * $charspc}]
684 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
685 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
688 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
689 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
691 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
693 # create three canvases
694 set cscroll .tf.histframe.csb
695 set canv .tf.histframe.pwclist.canv
697 -selectbackground $selectbgcolor \
698 -background $bgcolor -bd 0 \
699 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
700 .tf.histframe.pwclist add $canv
701 set canv2 .tf.histframe.pwclist.canv2
703 -selectbackground $selectbgcolor \
704 -background $bgcolor -bd 0 -yscrollincr $linespc
705 .tf.histframe.pwclist add $canv2
706 set canv3 .tf.histframe.pwclist.canv3
708 -selectbackground $selectbgcolor \
709 -background $bgcolor -bd 0 -yscrollincr $linespc
710 .tf.histframe.pwclist add $canv3
711 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
712 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
714 # a scroll bar to rule them
715 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
716 pack $cscroll -side right -fill y
717 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
718 lappend bglist $canv $canv2 $canv3
719 pack .tf.histframe.pwclist -fill both -expand 1 -side left
721 # we have two button bars at bottom of top frame. Bar 1
723 frame .tf.lbar -height 15
725 set sha1entry .tf.bar.sha1
726 set entries $sha1entry
727 set sha1but .tf.bar.sha1label
728 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
729 -command gotocommit -width 8
730 $sha1but conf -disabledforeground [$sha1but cget -foreground]
731 pack .tf.bar.sha1label -side left
732 entry $sha1entry -width 40 -font textfont -textvariable sha1string
733 trace add variable sha1string write sha1change
734 pack $sha1entry -side left -pady 2
736 image create bitmap bm-left -data {
737 #define left_width 16
738 #define left_height 16
739 static unsigned char left_bits[] = {
740 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
741 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
742 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
744 image create bitmap bm-right -data {
745 #define right_width 16
746 #define right_height 16
747 static unsigned char right_bits[] = {
748 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
749 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
750 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
752 button .tf.bar.leftbut -image bm-left -command goback \
753 -state disabled -width 26
754 pack .tf.bar.leftbut -side left -fill y
755 button .tf.bar.rightbut -image bm-right -command goforw \
756 -state disabled -width 26
757 pack .tf.bar.rightbut -side left -fill y
759 # Status label and progress bar
760 set statusw .tf.bar.status
761 label $statusw -width 15 -relief sunken
762 pack $statusw -side left -padx 5
763 set h [expr {[font metrics uifont -linespace] + 2}]
764 set progresscanv .tf.bar.progress
765 canvas $progresscanv -relief sunken -height $h -borderwidth 2
766 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
767 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
768 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
769 pack $progresscanv -side right -expand 1 -fill x
770 set progresscoords {0 0}
773 bind $progresscanv <Configure> adjustprogress
774 set lastprogupdate [clock clicks -milliseconds]
775 set progupdatepending 0
777 # build up the bottom bar of upper window
778 label .tf.lbar.flabel -text "[mc "Find"] "
779 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
780 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
781 label .tf.lbar.flab2 -text " [mc "commit"] "
782 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
784 set gdttype [mc "containing:"]
785 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
787 [mc "touching paths:"] \
788 [mc "adding/removing string:"]]
789 trace add variable gdttype write gdttype_change
790 pack .tf.lbar.gdttype -side left -fill y
793 set fstring .tf.lbar.findstring
794 lappend entries $fstring
795 entry $fstring -width 30 -font textfont -textvariable findstring
796 trace add variable findstring write find_change
797 set findtype [mc "Exact"]
798 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
799 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
800 trace add variable findtype write findcom_change
801 set findloc [mc "All fields"]
802 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
803 [mc "Comments"] [mc "Author"] [mc "Committer"]
804 trace add variable findloc write find_change
805 pack .tf.lbar.findloc -side right
806 pack .tf.lbar.findtype -side right
807 pack $fstring -side left -expand 1 -fill x
809 # Finish putting the upper half of the viewer together
810 pack .tf.lbar -in .tf -side bottom -fill x
811 pack .tf.bar -in .tf -side bottom -fill x
812 pack .tf.histframe -fill both -side top -expand 1
814 .ctop paneconfigure .tf -height $geometry(topheight)
815 .ctop paneconfigure .tf -width $geometry(topwidth)
817 # now build up the bottom
818 panedwindow .pwbottom -orient horizontal
820 # lower left, a text box over search bar, scroll bar to the right
821 # if we know window height, then that will set the lower text height, otherwise
822 # we set lower text height which will drive window height
823 if {[info exists geometry(main)]} {
824 frame .bleft -width $geometry(botwidth)
826 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
831 button .bleft.top.search -text [mc "Search"] -command dosearch
832 pack .bleft.top.search -side left -padx 5
833 set sstring .bleft.top.sstring
834 entry $sstring -width 20 -font textfont -textvariable searchstring
835 lappend entries $sstring
836 trace add variable searchstring write incrsearch
837 pack $sstring -side left -expand 1 -fill x
838 radiobutton .bleft.mid.diff -text [mc "Diff"] \
839 -command changediffdisp -variable diffelide -value {0 0}
840 radiobutton .bleft.mid.old -text [mc "Old version"] \
841 -command changediffdisp -variable diffelide -value {0 1}
842 radiobutton .bleft.mid.new -text [mc "New version"] \
843 -command changediffdisp -variable diffelide -value {1 0}
844 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
845 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
846 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
847 -from 1 -increment 1 -to 10000000 \
848 -validate all -validatecommand "diffcontextvalidate %P" \
849 -textvariable diffcontextstring
850 .bleft.mid.diffcontext set $diffcontext
851 trace add variable diffcontextstring write diffcontextchange
852 lappend entries .bleft.mid.diffcontext
853 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
854 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
855 -command changeignorespace -variable ignorespace
856 pack .bleft.mid.ignspace -side left -padx 5
857 set ctext .bleft.ctext
858 text $ctext -background $bgcolor -foreground $fgcolor \
859 -state disabled -font textfont \
860 -yscrollcommand scrolltext -wrap none
862 $ctext conf -tabstyle wordprocessor
864 scrollbar .bleft.sb -command "$ctext yview"
865 pack .bleft.top -side top -fill x
866 pack .bleft.mid -side top -fill x
867 pack .bleft.sb -side right -fill y
868 pack $ctext -side left -fill both -expand 1
869 lappend bglist $ctext
870 lappend fglist $ctext
872 $ctext tag conf comment -wrap $wrapcomment
873 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
874 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
875 $ctext tag conf d0 -fore [lindex $diffcolors 0]
876 $ctext tag conf d1 -fore [lindex $diffcolors 1]
877 $ctext tag conf m0 -fore red
878 $ctext tag conf m1 -fore blue
879 $ctext tag conf m2 -fore green
880 $ctext tag conf m3 -fore purple
881 $ctext tag conf m4 -fore brown
882 $ctext tag conf m5 -fore "#009090"
883 $ctext tag conf m6 -fore magenta
884 $ctext tag conf m7 -fore "#808000"
885 $ctext tag conf m8 -fore "#009000"
886 $ctext tag conf m9 -fore "#ff0080"
887 $ctext tag conf m10 -fore cyan
888 $ctext tag conf m11 -fore "#b07070"
889 $ctext tag conf m12 -fore "#70b0f0"
890 $ctext tag conf m13 -fore "#70f0b0"
891 $ctext tag conf m14 -fore "#f0b070"
892 $ctext tag conf m15 -fore "#ff70b0"
893 $ctext tag conf mmax -fore darkgrey
895 $ctext tag conf mresult -font textfontbold
896 $ctext tag conf msep -font textfontbold
897 $ctext tag conf found -back yellow
900 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
905 radiobutton .bright.mode.patch -text [mc "Patch"] \
906 -command reselectline -variable cmitmode -value "patch"
907 radiobutton .bright.mode.tree -text [mc "Tree"] \
908 -command reselectline -variable cmitmode -value "tree"
909 grid .bright.mode.patch .bright.mode.tree -sticky ew
910 pack .bright.mode -side top -fill x
911 set cflist .bright.cfiles
912 set indent [font measure mainfont "nn"]
914 -selectbackground $selectbgcolor \
915 -background $bgcolor -foreground $fgcolor \
917 -tabs [list $indent [expr {2 * $indent}]] \
918 -yscrollcommand ".bright.sb set" \
919 -cursor [. cget -cursor] \
920 -spacing1 1 -spacing3 1
921 lappend bglist $cflist
922 lappend fglist $cflist
923 scrollbar .bright.sb -command "$cflist yview"
924 pack .bright.sb -side right -fill y
925 pack $cflist -side left -fill both -expand 1
926 $cflist tag configure highlight \
927 -background [$cflist cget -selectbackground]
928 $cflist tag configure bold -font mainfontbold
930 .pwbottom add .bright
933 # restore window width & height if known
934 if {[info exists geometry(main)]} {
935 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
936 if {$w > [winfo screenwidth .]} {
937 set w [winfo screenwidth .]
939 if {$h > [winfo screenheight .]} {
940 set h [winfo screenheight .]
942 wm geometry . "${w}x$h"
946 if {[tk windowingsystem] eq {aqua}} {
952 bind .pwbottom <Configure> {resizecdetpanes %W %w}
953 pack .ctop -fill both -expand 1
954 bindall <1> {selcanvline %W %x %y}
955 #bindall <B1-Motion> {selcanvline %W %x %y}
956 if {[tk windowingsystem] == "win32"} {
957 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
958 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
960 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
961 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
962 if {[tk windowingsystem] eq "aqua"} {
963 bindall <MouseWheel> {
964 set delta [expr {- (%D)}]
965 allcanvs yview scroll $delta units
969 bindall <2> "canvscan mark %W %x %y"
970 bindall <B2-Motion> "canvscan dragto %W %x %y"
971 bindkey <Home> selfirstline
972 bindkey <End> sellastline
973 bind . <Key-Up> "selnextline -1"
974 bind . <Key-Down> "selnextline 1"
975 bind . <Shift-Key-Up> "dofind -1 0"
976 bind . <Shift-Key-Down> "dofind 1 0"
977 bindkey <Key-Right> "goforw"
978 bindkey <Key-Left> "goback"
979 bind . <Key-Prior> "selnextpage -1"
980 bind . <Key-Next> "selnextpage 1"
981 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
982 bind . <$M1B-End> "allcanvs yview moveto 1.0"
983 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
984 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
985 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
986 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
987 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
988 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
989 bindkey <Key-space> "$ctext yview scroll 1 pages"
990 bindkey p "selnextline -1"
991 bindkey n "selnextline 1"
994 bindkey i "selnextline -1"
995 bindkey k "selnextline 1"
998 bindkey b "$ctext yview scroll -1 pages"
999 bindkey d "$ctext yview scroll 18 units"
1000 bindkey u "$ctext yview scroll -18 units"
1001 bindkey / {dofind 1 1}
1002 bindkey <Key-Return> {dofind 1 1}
1003 bindkey ? {dofind -1 1}
1005 bindkey <F5> updatecommits
1006 bind . <$M1B-q> doquit
1007 bind . <$M1B-f> {dofind 1 1}
1008 bind . <$M1B-g> {dofind 1 0}
1009 bind . <$M1B-r> dosearchback
1010 bind . <$M1B-s> dosearch
1011 bind . <$M1B-equal> {incrfont 1}
1012 bind . <$M1B-plus> {incrfont 1}
1013 bind . <$M1B-KP_Add> {incrfont 1}
1014 bind . <$M1B-minus> {incrfont -1}
1015 bind . <$M1B-KP_Subtract> {incrfont -1}
1016 wm protocol . WM_DELETE_WINDOW doquit
1017 bind . <Button-1> "click %W"
1018 bind $fstring <Key-Return> {dofind 1 1}
1019 bind $sha1entry <Key-Return> gotocommit
1020 bind $sha1entry <<PasteSelection>> clearsha1
1021 bind $cflist <1> {sel_flist %W %x %y; break}
1022 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1023 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1024 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1026 set maincursor [. cget -cursor]
1027 set textcursor [$ctext cget -cursor]
1028 set curtextcursor $textcursor
1030 set rowctxmenu .rowctxmenu
1031 menu $rowctxmenu -tearoff 0
1032 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1033 -command {diffvssel 0}
1034 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1035 -command {diffvssel 1}
1036 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1037 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1038 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1039 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1040 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1042 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1045 set fakerowmenu .fakerowmenu
1046 menu $fakerowmenu -tearoff 0
1047 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1048 -command {diffvssel 0}
1049 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1050 -command {diffvssel 1}
1051 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1052 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1053 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1054 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1056 set headctxmenu .headctxmenu
1057 menu $headctxmenu -tearoff 0
1058 $headctxmenu add command -label [mc "Check out this branch"] \
1060 $headctxmenu add command -label [mc "Remove this branch"] \
1064 set flist_menu .flistctxmenu
1065 menu $flist_menu -tearoff 0
1066 $flist_menu add command -label [mc "Highlight this too"] \
1067 -command {flist_hl 0}
1068 $flist_menu add command -label [mc "Highlight this only"] \
1069 -command {flist_hl 1}
1072 # Windows sends all mouse wheel events to the current focused window, not
1073 # the one where the mouse hovers, so bind those events here and redirect
1074 # to the correct window
1075 proc windows_mousewheel_redirector {W X Y D} {
1076 global canv canv2 canv3
1077 set w [winfo containing -displayof $W $X $Y]
1079 set u [expr {$D < 0 ? 5 : -5}]
1080 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1081 allcanvs yview scroll $u units
1084 $w yview scroll $u units
1090 # mouse-2 makes all windows scan vertically, but only the one
1091 # the cursor is in scans horizontally
1092 proc canvscan {op w x y} {
1093 global canv canv2 canv3
1094 foreach c [list $canv $canv2 $canv3] {
1103 proc scrollcanv {cscroll f0 f1} {
1104 $cscroll set $f0 $f1
1109 # when we make a key binding for the toplevel, make sure
1110 # it doesn't get triggered when that key is pressed
in the
1111 # find string entry widget.
1112 proc bindkey
{ev
script} {
1115 set escript
[bind Entry
$ev]
1116 if {$escript == {}} {
1117 set escript
[bind Entry
<Key
>]
1119 foreach e
$entries {
1120 bind $e $ev "$escript; break"
1124 # set the focus back to the toplevel for any click outside
1127 global ctext entries
1128 foreach e
[concat
$entries $ctext] {
1129 if {$w == $e} return
1134 # Adjust the progress bar for a change in requested extent or canvas size
1135 proc adjustprogress
{} {
1136 global progresscanv progressitem progresscoords
1137 global fprogitem fprogcoord lastprogupdate progupdatepending
1138 global rprogitem rprogcoord
1140 set w
[expr {[winfo width
$progresscanv] - 4}]
1141 set x0
[expr {$w * [lindex
$progresscoords 0]}]
1142 set x1
[expr {$w * [lindex
$progresscoords 1]}]
1143 set h
[winfo height
$progresscanv]
1144 $progresscanv coords
$progressitem $x0 0 $x1 $h
1145 $progresscanv coords
$fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1146 $progresscanv coords
$rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1147 set now
[clock clicks
-milliseconds]
1148 if {$now >= $lastprogupdate + 100} {
1149 set progupdatepending
0
1151 } elseif
{!$progupdatepending} {
1152 set progupdatepending
1
1153 after
[expr {$lastprogupdate + 100 - $now}] doprogupdate
1157 proc doprogupdate
{} {
1158 global lastprogupdate progupdatepending
1160 if {$progupdatepending} {
1161 set progupdatepending
0
1162 set lastprogupdate
[clock clicks
-milliseconds]
1167 proc savestuff
{w
} {
1168 global canv canv2 canv3 mainfont textfont uifont tabstop
1169 global stuffsaved findmergefiles maxgraphpct
1170 global maxwidth showneartags showlocalchanges
1171 global viewname viewfiles viewargs viewperm nextviewnum
1172 global cmitmode wrapcomment datetimeformat limitdiffs
1173 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1175 if {$stuffsaved} return
1176 if {![winfo viewable .
]} return
1178 set f
[open
"~/.gitk-new" w
]
1179 puts
$f [list
set mainfont
$mainfont]
1180 puts
$f [list
set textfont
$textfont]
1181 puts
$f [list
set uifont
$uifont]
1182 puts
$f [list
set tabstop
$tabstop]
1183 puts
$f [list
set findmergefiles
$findmergefiles]
1184 puts
$f [list
set maxgraphpct
$maxgraphpct]
1185 puts
$f [list
set maxwidth
$maxwidth]
1186 puts
$f [list
set cmitmode
$cmitmode]
1187 puts
$f [list
set wrapcomment
$wrapcomment]
1188 puts
$f [list
set showneartags
$showneartags]
1189 puts
$f [list
set showlocalchanges
$showlocalchanges]
1190 puts
$f [list
set datetimeformat
$datetimeformat]
1191 puts
$f [list
set limitdiffs
$limitdiffs]
1192 puts
$f [list
set bgcolor
$bgcolor]
1193 puts
$f [list
set fgcolor
$fgcolor]
1194 puts
$f [list
set colors
$colors]
1195 puts
$f [list
set diffcolors
$diffcolors]
1196 puts
$f [list
set diffcontext
$diffcontext]
1197 puts
$f [list
set selectbgcolor
$selectbgcolor]
1199 puts
$f "set geometry(main) [wm geometry .]"
1200 puts
$f "set geometry(topwidth) [winfo width .tf]"
1201 puts
$f "set geometry(topheight) [winfo height .tf]"
1202 puts
$f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1203 puts
$f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1204 puts
$f "set geometry(botwidth) [winfo width .bleft]"
1205 puts
$f "set geometry(botheight) [winfo height .bleft]"
1207 puts
-nonewline $f "set permviews {"
1208 for {set v
0} {$v < $nextviewnum} {incr v
} {
1209 if {$viewperm($v)} {
1210 puts
$f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1215 file rename
-force "~/.gitk-new" "~/.gitk"
1220 proc resizeclistpanes
{win w
} {
1222 if {[info exists oldwidth
($win)]} {
1223 set s0
[$win sash coord
0]
1224 set s1
[$win sash coord
1]
1226 set sash0
[expr {int
($w/2 - 2)}]
1227 set sash1
[expr {int
($w*5/6 - 2)}]
1229 set factor [expr {1.0 * $w / $oldwidth($win)}]
1230 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1231 set sash1
[expr {int
($factor * [lindex
$s1 0])}]
1235 if {$sash1 < $sash0 + 20} {
1236 set sash1
[expr {$sash0 + 20}]
1238 if {$sash1 > $w - 10} {
1239 set sash1
[expr {$w - 10}]
1240 if {$sash0 > $sash1 - 20} {
1241 set sash0
[expr {$sash1 - 20}]
1245 $win sash place
0 $sash0 [lindex
$s0 1]
1246 $win sash place
1 $sash1 [lindex
$s1 1]
1248 set oldwidth
($win) $w
1251 proc resizecdetpanes
{win w
} {
1253 if {[info exists oldwidth
($win)]} {
1254 set s0
[$win sash coord
0]
1256 set sash0
[expr {int
($w*3/4 - 2)}]
1258 set factor [expr {1.0 * $w / $oldwidth($win)}]
1259 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1263 if {$sash0 > $w - 15} {
1264 set sash0
[expr {$w - 15}]
1267 $win sash place
0 $sash0 [lindex
$s0 1]
1269 set oldwidth
($win) $w
1272 proc allcanvs args
{
1273 global canv canv2 canv3
1279 proc bindall
{event action
} {
1280 global canv canv2 canv3
1281 bind $canv $event $action
1282 bind $canv2 $event $action
1283 bind $canv3 $event $action
1289 if {[winfo exists
$w]} {
1294 wm title
$w [mc
"About gitk"]
1295 message
$w.m
-text [mc
"
1296 Gitk - a commit viewer for git
1298 Copyright © 2005-2006 Paul Mackerras
1300 Use and redistribute under the terms of the GNU General Public License"] \
1301 -justify center
-aspect 400 -border 2 -bg white
-relief groove
1302 pack
$w.m
-side top
-fill x
-padx 2 -pady 2
1303 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1304 pack
$w.ok
-side bottom
1305 bind $w <Visibility
> "focus $w.ok"
1306 bind $w <Key-Escape
> "destroy $w"
1307 bind $w <Key-Return
> "destroy $w"
1312 if {[winfo exists
$w]} {
1316 if {[tk windowingsystem
] eq
{aqua
}} {
1322 wm title
$w [mc
"Gitk key bindings"]
1323 message
$w.m
-text "
1324 [mc "Gitk key bindings
:"]
1326 [mc "<%s-Q
> Quit
" $M1T]
1327 [mc "<Home
> Move to first commit
"]
1328 [mc "<End
> Move to last commit
"]
1329 [mc "<Up
>, p
, i Move up one commit
"]
1330 [mc "<Down
>, n
, k Move down one commit
"]
1331 [mc "<Left
>, z
, j Go back
in history list
"]
1332 [mc "<Right
>, x
, l Go forward
in history list
"]
1333 [mc "<PageUp
> Move up one page
in commit list
"]
1334 [mc "<PageDown
> Move down one page
in commit list
"]
1335 [mc "<%s-Home
> Scroll to top of commit list
" $M1T]
1336 [mc "<%s-End
> Scroll to bottom of commit list
" $M1T]
1337 [mc "<%s-Up
> Scroll commit list up one line
" $M1T]
1338 [mc "<%s-Down
> Scroll commit list down one line
" $M1T]
1339 [mc "<%s-PageUp
> Scroll commit list up one page
" $M1T]
1340 [mc "<%s-PageDown
> Scroll commit list down one page
" $M1T]
1341 [mc "<Shift-Up
> Find backwards
(upwards
, later commits
)"]
1342 [mc "<Shift-Down
> Find forwards
(downwards
, earlier commits
)"]
1343 [mc "<Delete
>, b Scroll
diff view up one page
"]
1344 [mc "<Backspace
> Scroll
diff view up one page
"]
1345 [mc "<Space
> Scroll
diff view down one page
"]
1346 [mc "u Scroll
diff view up
18 lines
"]
1347 [mc "d Scroll
diff view down
18 lines
"]
1348 [mc "<%s-F
> Find
" $M1T]
1349 [mc "<%s-G
> Move to next
find hit
" $M1T]
1350 [mc "<Return
> Move to next
find hit
"]
1351 [mc "/ Move to next
find hit
, or redo
find"]
1352 [mc "? Move to previous
find hit
"]
1353 [mc "f Scroll
diff view to next
file"]
1354 [mc "<%s-S
> Search
for next hit
in diff view
" $M1T]
1355 [mc "<%s-R
> Search
for previous hit
in diff view
" $M1T]
1356 [mc "<%s-KP
+> Increase font size
" $M1T]
1357 [mc "<%s-plus
> Increase font size
" $M1T]
1358 [mc "<%s-KP-
> Decrease font size
" $M1T]
1359 [mc "<%s-minus
> Decrease font size
" $M1T]
1362 -justify left
-bg white
-border 2 -relief groove
1363 pack
$w.m
-side top
-fill both
-padx 2 -pady 2
1364 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1365 pack
$w.ok
-side bottom
1366 bind $w <Visibility
> "focus $w.ok"
1367 bind $w <Key-Escape
> "destroy $w"
1368 bind $w <Key-Return
> "destroy $w"
1371 # Procedures for manipulating the file list window at the
1372 # bottom right of the overall window.
1374 proc treeview
{w l openlevs
} {
1375 global treecontents treediropen treeheight treeparent treeindex
1385 set treecontents
() {}
1386 $w conf
-state normal
1388 while {[string range
$f 0 $prefixend] ne
$prefix} {
1389 if {$lev <= $openlevs} {
1390 $w mark
set e
:$treeindex($prefix) "end -1c"
1391 $w mark gravity e
:$treeindex($prefix) left
1393 set treeheight
($prefix) $ht
1394 incr ht
[lindex
$htstack end
]
1395 set htstack
[lreplace
$htstack end end
]
1396 set prefixend
[lindex
$prefendstack end
]
1397 set prefendstack
[lreplace
$prefendstack end end
]
1398 set prefix
[string range
$prefix 0 $prefixend]
1401 set tail [string range
$f [expr {$prefixend+1}] end
]
1402 while {[set slash
[string first
"/" $tail]] >= 0} {
1405 lappend prefendstack
$prefixend
1406 incr prefixend
[expr {$slash + 1}]
1407 set d
[string range
$tail 0 $slash]
1408 lappend treecontents
($prefix) $d
1409 set oldprefix
$prefix
1411 set treecontents
($prefix) {}
1412 set treeindex
($prefix) [incr ix
]
1413 set treeparent
($prefix) $oldprefix
1414 set tail [string range
$tail [expr {$slash+1}] end
]
1415 if {$lev <= $openlevs} {
1417 set treediropen
($prefix) [expr {$lev < $openlevs}]
1418 set bm
[expr {$lev == $openlevs?
"tri-rt": "tri-dn"}]
1419 $w mark
set d
:$ix "end -1c"
1420 $w mark gravity d
:$ix left
1422 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1424 $w image create end
-align center
-image $bm -padx 1 \
1426 $w insert end
$d [highlight_tag
$prefix]
1427 $w mark
set s
:$ix "end -1c"
1428 $w mark gravity s
:$ix left
1433 if {$lev <= $openlevs} {
1436 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1438 $w insert end
$tail [highlight_tag
$f]
1440 lappend treecontents
($prefix) $tail
1443 while {$htstack ne
{}} {
1444 set treeheight
($prefix) $ht
1445 incr ht
[lindex
$htstack end
]
1446 set htstack
[lreplace
$htstack end end
]
1447 set prefixend
[lindex
$prefendstack end
]
1448 set prefendstack
[lreplace
$prefendstack end end
]
1449 set prefix
[string range
$prefix 0 $prefixend]
1451 $w conf
-state disabled
1454 proc linetoelt
{l
} {
1455 global treeheight treecontents
1460 foreach e
$treecontents($prefix) {
1465 if {[string index
$e end
] eq
"/"} {
1466 set n
$treeheight($prefix$e)
1478 proc highlight_tree
{y prefix
} {
1479 global treeheight treecontents cflist
1481 foreach e
$treecontents($prefix) {
1483 if {[highlight_tag
$path] ne
{}} {
1484 $cflist tag add bold
$y.0 "$y.0 lineend"
1487 if {[string index
$e end
] eq
"/" && $treeheight($path) > 1} {
1488 set y
[highlight_tree
$y $path]
1494 proc treeclosedir
{w dir
} {
1495 global treediropen treeheight treeparent treeindex
1497 set ix
$treeindex($dir)
1498 $w conf
-state normal
1499 $w delete s
:$ix e
:$ix
1500 set treediropen
($dir) 0
1501 $w image configure a
:$ix -image tri-rt
1502 $w conf
-state disabled
1503 set n
[expr {1 - $treeheight($dir)}]
1504 while {$dir ne
{}} {
1505 incr treeheight
($dir) $n
1506 set dir
$treeparent($dir)
1510 proc treeopendir
{w dir
} {
1511 global treediropen treeheight treeparent treecontents treeindex
1513 set ix
$treeindex($dir)
1514 $w conf
-state normal
1515 $w image configure a
:$ix -image tri-dn
1516 $w mark
set e
:$ix s
:$ix
1517 $w mark gravity e
:$ix right
1520 set n
[llength
$treecontents($dir)]
1521 for {set x
$dir} {$x ne
{}} {set x
$treeparent($x)} {
1524 incr treeheight
($x) $n
1526 foreach e
$treecontents($dir) {
1528 if {[string index
$e end
] eq
"/"} {
1529 set iy
$treeindex($de)
1530 $w mark
set d
:$iy e
:$ix
1531 $w mark gravity d
:$iy left
1532 $w insert e
:$ix $str
1533 set treediropen
($de) 0
1534 $w image create e
:$ix -align center
-image tri-rt
-padx 1 \
1536 $w insert e
:$ix $e [highlight_tag
$de]
1537 $w mark
set s
:$iy e
:$ix
1538 $w mark gravity s
:$iy left
1539 set treeheight
($de) 1
1541 $w insert e
:$ix $str
1542 $w insert e
:$ix $e [highlight_tag
$de]
1545 $w mark gravity e
:$ix left
1546 $w conf
-state disabled
1547 set treediropen
($dir) 1
1548 set top
[lindex
[split [$w index @
0,0] .
] 0]
1549 set ht
[$w cget
-height]
1550 set l
[lindex
[split [$w index s
:$ix] .
] 0]
1553 } elseif
{$l + $n + 1 > $top + $ht} {
1554 set top
[expr {$l + $n + 2 - $ht}]
1562 proc treeclick
{w x y
} {
1563 global treediropen cmitmode ctext cflist cflist_top
1565 if {$cmitmode ne
"tree"} return
1566 if {![info exists cflist_top
]} return
1567 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1568 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1569 $cflist tag add highlight
$l.0 "$l.0 lineend"
1575 set e
[linetoelt
$l]
1576 if {[string index
$e end
] ne
"/"} {
1578 } elseif
{$treediropen($e)} {
1585 proc setfilelist
{id
} {
1586 global treefilelist cflist
1588 treeview
$cflist $treefilelist($id) 0
1591 image create bitmap tri-rt
-background black
-foreground blue
-data {
1592 #define tri-rt_width 13
1593 #define tri-rt_height 13
1594 static unsigned char tri-rt_bits
[] = {
1595 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1596 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1599 #define tri-rt-mask_width 13
1600 #define tri-rt-mask_height 13
1601 static unsigned char tri-rt-mask_bits
[] = {
1602 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1603 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1606 image create bitmap tri-dn
-background black
-foreground blue
-data {
1607 #define tri-dn_width 13
1608 #define tri-dn_height 13
1609 static unsigned char tri-dn_bits
[] = {
1610 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1611 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1614 #define tri-dn-mask_width 13
1615 #define tri-dn-mask_height 13
1616 static unsigned char tri-dn-mask_bits
[] = {
1617 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1618 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1622 image create bitmap reficon-T
-background black
-foreground yellow
-data {
1623 #define tagicon_width 13
1624 #define tagicon_height 9
1625 static unsigned char tagicon_bits
[] = {
1626 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1627 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1629 #define tagicon-mask_width 13
1630 #define tagicon-mask_height 9
1631 static unsigned char tagicon-mask_bits
[] = {
1632 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1633 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1636 #define headicon_width 13
1637 #define headicon_height 9
1638 static unsigned char headicon_bits
[] = {
1639 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1640 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1643 #define headicon-mask_width 13
1644 #define headicon-mask_height 9
1645 static unsigned char headicon-mask_bits
[] = {
1646 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1647 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1649 image create bitmap reficon-H
-background black
-foreground green \
1650 -data $rectdata -maskdata $rectmask
1651 image create bitmap reficon-o
-background black
-foreground "#ddddff" \
1652 -data $rectdata -maskdata $rectmask
1654 proc init_flist
{first
} {
1655 global cflist cflist_top selectedline difffilestart
1657 $cflist conf
-state normal
1658 $cflist delete
0.0 end
1660 $cflist insert end
$first
1662 $cflist tag add highlight
1.0 "1.0 lineend"
1664 catch
{unset cflist_top
}
1666 $cflist conf
-state disabled
1667 set difffilestart
{}
1670 proc highlight_tag
{f
} {
1671 global highlight_paths
1673 foreach p
$highlight_paths {
1674 if {[string match
$p $f]} {
1681 proc highlight_filelist
{} {
1682 global cmitmode cflist
1684 $cflist conf
-state normal
1685 if {$cmitmode ne
"tree"} {
1686 set end
[lindex
[split [$cflist index end
] .
] 0]
1687 for {set l
2} {$l < $end} {incr l
} {
1688 set line
[$cflist get
$l.0 "$l.0 lineend"]
1689 if {[highlight_tag
$line] ne
{}} {
1690 $cflist tag add bold
$l.0 "$l.0 lineend"
1696 $cflist conf
-state disabled
1699 proc unhighlight_filelist
{} {
1702 $cflist conf
-state normal
1703 $cflist tag remove bold
1.0 end
1704 $cflist conf
-state disabled
1707 proc add_flist
{fl
} {
1710 $cflist conf
-state normal
1712 $cflist insert end
"\n"
1713 $cflist insert end
$f [highlight_tag
$f]
1715 $cflist conf
-state disabled
1718 proc sel_flist
{w x y
} {
1719 global ctext difffilestart cflist cflist_top cmitmode
1721 if {$cmitmode eq
"tree"} return
1722 if {![info exists cflist_top
]} return
1723 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1724 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1725 $cflist tag add highlight
$l.0 "$l.0 lineend"
1730 catch
{$ctext yview
[lindex
$difffilestart [expr {$l - 2}]]}
1734 proc pop_flist_menu
{w X Y x y
} {
1735 global ctext cflist cmitmode flist_menu flist_menu_file
1736 global treediffs diffids
1739 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1741 if {$cmitmode eq
"tree"} {
1742 set e
[linetoelt
$l]
1743 if {[string index
$e end
] eq
"/"} return
1745 set e
[lindex
$treediffs($diffids) [expr {$l-2}]]
1747 set flist_menu_file
$e
1748 tk_popup
$flist_menu $X $Y
1751 proc flist_hl
{only
} {
1752 global flist_menu_file findstring gdttype
1754 set x
[shellquote
$flist_menu_file]
1755 if {$only ||
$findstring eq
{} ||
$gdttype ne
[mc
"touching paths:"]} {
1758 append findstring
" " $x
1760 set gdttype
[mc
"touching paths:"]
1763 # Functions for adding and removing shell-type quoting
1765 proc shellquote
{str
} {
1766 if {![string match
"*\['\"\\ \t]*" $str]} {
1769 if {![string match
"*\['\"\\]*" $str]} {
1772 if {![string match
"*'*" $str]} {
1775 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1778 proc shellarglist
{l
} {
1784 append str
[shellquote
$a]
1789 proc shelldequote
{str
} {
1794 if {![regexp
-start $used -indices "\['\"\\\\ \t]" $str first
]} {
1795 append ret
[string range
$str $used end
]
1796 set used
[string length
$str]
1799 set first
[lindex
$first 0]
1800 set ch
[string index
$str $first]
1801 if {$first > $used} {
1802 append ret
[string range
$str $used [expr {$first - 1}]]
1805 if {$ch eq
" " ||
$ch eq
"\t"} break
1808 set first
[string first
"'" $str $used]
1810 error
"unmatched single-quote"
1812 append ret
[string range
$str $used [expr {$first - 1}]]
1817 if {$used >= [string length
$str]} {
1818 error
"trailing backslash"
1820 append ret
[string index
$str $used]
1825 if {![regexp
-start $used -indices "\[\"\\\\]" $str first
]} {
1826 error
"unmatched double-quote"
1828 set first
[lindex
$first 0]
1829 set ch
[string index
$str $first]
1830 if {$first > $used} {
1831 append ret
[string range
$str $used [expr {$first - 1}]]
1834 if {$ch eq
"\""} break
1836 append ret
[string index
$str $used]
1840 return [list
$used $ret]
1843 proc shellsplit
{str
} {
1846 set str
[string trimleft
$str]
1847 if {$str eq
{}} break
1848 set dq
[shelldequote
$str]
1849 set n
[lindex
$dq 0]
1850 set word
[lindex
$dq 1]
1851 set str
[string range
$str $n end
]
1857 # Code to implement multiple views
1859 proc newview
{ishighlight
} {
1860 global nextviewnum newviewname newviewperm newishighlight
1861 global newviewargs revtreeargs
1863 set newishighlight
$ishighlight
1865 if {[winfo exists
$top]} {
1869 set newviewname
($nextviewnum) "View $nextviewnum"
1870 set newviewperm
($nextviewnum) 0
1871 set newviewargs
($nextviewnum) [shellarglist
$revtreeargs]
1872 vieweditor
$top $nextviewnum [mc
"Gitk view definition"]
1877 global viewname viewperm newviewname newviewperm
1878 global viewargs newviewargs
1880 set top .gitkvedit-
$curview
1881 if {[winfo exists
$top]} {
1885 set newviewname
($curview) $viewname($curview)
1886 set newviewperm
($curview) $viewperm($curview)
1887 set newviewargs
($curview) [shellarglist
$viewargs($curview)]
1888 vieweditor
$top $curview "Gitk: edit view $viewname($curview)"
1891 proc vieweditor
{top n title
} {
1892 global newviewname newviewperm viewfiles bgcolor
1895 wm title
$top $title
1896 label
$top.
nl -text [mc
"Name"]
1897 entry
$top.name
-width 20 -textvariable newviewname
($n)
1898 grid
$top.
nl $top.name
-sticky w
-pady 5
1899 checkbutton
$top.perm
-text [mc
"Remember this view"] \
1900 -variable newviewperm
($n)
1901 grid
$top.perm
- -pady 5 -sticky w
1902 message
$top.al
-aspect 1000 \
1903 -text [mc
"Commits to include (arguments to git rev-list):"]
1904 grid
$top.al
- -sticky w
-pady 5
1905 entry
$top.args
-width 50 -textvariable newviewargs
($n) \
1906 -background $bgcolor
1907 grid
$top.args
- -sticky ew
-padx 5
1908 message
$top.l
-aspect 1000 \
1909 -text [mc
"Enter files and directories to include, one per line:"]
1910 grid
$top.l
- -sticky w
1911 text
$top.t
-width 40 -height 10 -background $bgcolor -font uifont
1912 if {[info exists viewfiles
($n)]} {
1913 foreach f
$viewfiles($n) {
1914 $top.t insert end
$f
1915 $top.t insert end
"\n"
1917 $top.t delete
{end
- 1c
} end
1918 $top.t mark
set insert
0.0
1920 grid
$top.t
- -sticky ew
-padx 5
1922 button
$top.buts.ok
-text [mc
"OK"] -command [list newviewok
$top $n]
1923 button
$top.buts.can
-text [mc
"Cancel"] -command [list destroy
$top]
1924 grid
$top.buts.ok
$top.buts.can
1925 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
1926 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
1927 grid
$top.buts
- -pady 10 -sticky ew
1931 proc doviewmenu
{m first cmd op argv
} {
1932 set nmenu
[$m index end
]
1933 for {set i
$first} {$i <= $nmenu} {incr i
} {
1934 if {[$m entrycget
$i -command] eq
$cmd} {
1935 eval $m $op $i $argv
1941 proc allviewmenus
{n op args
} {
1944 doviewmenu .bar.view
5 [list showview
$n] $op $args
1945 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1948 proc newviewok
{top n
} {
1949 global nextviewnum newviewperm newviewname newishighlight
1950 global viewname viewfiles viewperm selectedview curview
1951 global viewargs newviewargs viewhlmenu
1954 set newargs
[shellsplit
$newviewargs($n)]
1956 error_popup
"[mc "Error
in commit selection arguments
:"] $err"
1962 foreach f
[split [$top.t get
0.0 end
] "\n"] {
1963 set ft
[string trim
$f]
1968 if {![info exists viewfiles
($n)]} {
1969 # creating a new view
1971 set viewname
($n) $newviewname($n)
1972 set viewperm
($n) $newviewperm($n)
1973 set viewfiles
($n) $files
1974 set viewargs
($n) $newargs
1976 if {!$newishighlight} {
1979 run addvhighlight
$n
1982 # editing an existing view
1983 set viewperm
($n) $newviewperm($n)
1984 if {$newviewname($n) ne
$viewname($n)} {
1985 set viewname
($n) $newviewname($n)
1986 doviewmenu .bar.view
5 [list showview
$n] \
1987 entryconf
[list
-label $viewname($n)]
1988 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1989 # entryconf [list -label $viewname($n) -value $viewname($n)]
1991 if {$files ne
$viewfiles($n) ||
$newargs ne
$viewargs($n)} {
1992 set viewfiles
($n) $files
1993 set viewargs
($n) $newargs
1994 if {$curview == $n} {
1999 catch
{destroy
$top}
2003 global curview viewdata viewperm hlview selectedhlview
2005 if {$curview == 0} return
2006 if {[info exists hlview
] && $hlview == $curview} {
2007 set selectedhlview
[mc
"None"]
2010 allviewmenus
$curview delete
2011 set viewdata
($curview) {}
2012 set viewperm
($curview) 0
2016 proc addviewmenu
{n
} {
2017 global viewname viewhlmenu
2019 .bar.view add radiobutton
-label $viewname($n) \
2020 -command [list showview
$n] -variable selectedview
-value $n
2021 #$viewhlmenu add radiobutton -label $viewname($n) \
2022 # -command [list addvhighlight $n] -variable selectedhlview
2025 proc flatten
{var
} {
2029 foreach i
[array names
$var] {
2030 lappend ret
$i [set $var\
($i\
)]
2035 proc unflatten
{var l
} {
2045 global curview viewdata viewfiles
2046 global displayorder parentlist rowidlist rowisopt rowfinal
2047 global colormap rowtextx commitrow nextcolor canvxmax
2048 global numcommits commitlisted
2049 global selectedline currentid canv canvy0
2051 global pending_select phase
2054 global selectedview selectfirst
2055 global vparentlist vdisporder vcmitlisted
2056 global hlview selectedhlview commitinterest
2058 if {$n == $curview} return
2060 if {[info exists selectedline
]} {
2061 set selid
$currentid
2062 set y
[yc
$selectedline]
2063 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2064 set span
[$canv yview
]
2065 set ytop
[expr {[lindex
$span 0] * $ymax}]
2066 set ybot
[expr {[lindex
$span 1] * $ymax}]
2067 if {$ytop < $y && $y < $ybot} {
2068 set yscreen
[expr {$y - $ytop}]
2070 set yscreen
[expr {($ybot - $ytop) / 2}]
2072 } elseif
{[info exists pending_select
]} {
2073 set selid
$pending_select
2074 unset pending_select
2078 if {$curview >= 0} {
2079 set vparentlist
($curview) $parentlist
2080 set vdisporder
($curview) $displayorder
2081 set vcmitlisted
($curview) $commitlisted
2083 ![info exists viewdata
($curview)] ||
2084 [lindex
$viewdata($curview) 0] ne
{}} {
2085 set viewdata
($curview) \
2086 [list
$phase $rowidlist $rowisopt $rowfinal]
2089 catch
{unset treediffs
}
2091 if {[info exists hlview
] && $hlview == $n} {
2093 set selectedhlview
[mc
"None"]
2095 catch
{unset commitinterest
}
2099 .bar.view entryconf
[mc
"Edit view..."] -state [expr {$n == 0?
"disabled": "normal"}]
2100 .bar.view entryconf
[mc
"Delete view"] -state [expr {$n == 0?
"disabled": "normal"}]
2103 if {![info exists viewdata
($n)]} {
2105 set pending_select
$selid
2112 set phase
[lindex
$v 0]
2113 set displayorder
$vdisporder($n)
2114 set parentlist
$vparentlist($n)
2115 set commitlisted
$vcmitlisted($n)
2116 set rowidlist
[lindex
$v 1]
2117 set rowisopt
[lindex
$v 2]
2118 set rowfinal
[lindex
$v 3]
2119 set numcommits
$commitidx($n)
2121 catch
{unset colormap
}
2122 catch
{unset rowtextx
}
2124 set canvxmax
[$canv cget
-width]
2131 if {$selid ne
{} && [info exists commitrow
($n,$selid)]} {
2132 set row
$commitrow($n,$selid)
2133 # try to get the selected row in the same position on the screen
2134 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2135 set ytop
[expr {[yc
$row] - $yscreen}]
2139 set yf
[expr {$ytop * 1.0 / $ymax}]
2141 allcanvs yview moveto
$yf
2145 } elseif
{$selid ne
{}} {
2146 set pending_select
$selid
2148 set row
[first_real_row
]
2149 if {$row < $numcommits} {
2156 if {$phase eq
"getcommits"} {
2157 show_status
[mc
"Reading commits..."]
2160 } elseif
{$numcommits == 0} {
2161 show_status
[mc
"No commits selected"]
2165 # Stuff relating to the highlighting facility
2167 proc ishighlighted
{row
} {
2168 global vhighlights fhighlights nhighlights rhighlights
2170 if {[info exists nhighlights
($row)] && $nhighlights($row) > 0} {
2171 return $nhighlights($row)
2173 if {[info exists vhighlights
($row)] && $vhighlights($row) > 0} {
2174 return $vhighlights($row)
2176 if {[info exists fhighlights
($row)] && $fhighlights($row) > 0} {
2177 return $fhighlights($row)
2179 if {[info exists rhighlights
($row)] && $rhighlights($row) > 0} {
2180 return $rhighlights($row)
2185 proc bolden
{row font
} {
2186 global canv linehtag selectedline boldrows
2188 lappend boldrows
$row
2189 $canv itemconf
$linehtag($row) -font $font
2190 if {[info exists selectedline
] && $row == $selectedline} {
2192 set t
[eval $canv create rect
[$canv bbox
$linehtag($row)] \
2193 -outline {{}} -tags secsel \
2194 -fill [$canv cget
-selectbackground]]
2199 proc bolden_name
{row font
} {
2200 global canv2 linentag selectedline boldnamerows
2202 lappend boldnamerows
$row
2203 $canv2 itemconf
$linentag($row) -font $font
2204 if {[info exists selectedline
] && $row == $selectedline} {
2205 $canv2 delete secsel
2206 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($row)] \
2207 -outline {{}} -tags secsel \
2208 -fill [$canv2 cget
-selectbackground]]
2217 foreach row
$boldrows {
2218 if {![ishighlighted
$row]} {
2219 bolden
$row mainfont
2221 lappend stillbold
$row
2224 set boldrows
$stillbold
2227 proc addvhighlight
{n
} {
2228 global hlview curview viewdata vhl_done vhighlights commitidx
2230 if {[info exists hlview
]} {
2234 if {$n != $curview && ![info exists viewdata
($n)]} {
2235 set viewdata
($n) [list getcommits
{{}} 0 0 0]
2236 set vparentlist
($n) {}
2237 set vdisporder
($n) {}
2238 set vcmitlisted
($n) {}
2241 set vhl_done
$commitidx($hlview)
2242 if {$vhl_done > 0} {
2247 proc delvhighlight
{} {
2248 global hlview vhighlights
2250 if {![info exists hlview
]} return
2252 catch
{unset vhighlights
}
2256 proc vhighlightmore
{} {
2257 global hlview vhl_done commitidx vhighlights
2258 global displayorder vdisporder curview
2260 set max
$commitidx($hlview)
2261 if {$hlview == $curview} {
2262 set disp
$displayorder
2264 set disp
$vdisporder($hlview)
2266 set vr
[visiblerows
]
2267 set r0
[lindex
$vr 0]
2268 set r1
[lindex
$vr 1]
2269 for {set i
$vhl_done} {$i < $max} {incr i
} {
2270 set id
[lindex
$disp $i]
2271 if {[info exists commitrow
($curview,$id)]} {
2272 set row
$commitrow($curview,$id)
2273 if {$r0 <= $row && $row <= $r1} {
2274 if {![highlighted
$row]} {
2275 bolden
$row mainfontbold
2277 set vhighlights
($row) 1
2284 proc askvhighlight
{row id
} {
2285 global hlview vhighlights commitrow iddrawn
2287 if {[info exists commitrow
($hlview,$id)]} {
2288 if {[info exists iddrawn
($id)] && ![ishighlighted
$row]} {
2289 bolden
$row mainfontbold
2291 set vhighlights
($row) 1
2293 set vhighlights
($row) 0
2297 proc hfiles_change
{} {
2298 global highlight_files filehighlight fhighlights fh_serial
2299 global highlight_paths gdttype
2301 if {[info exists filehighlight
]} {
2302 # delete previous highlights
2303 catch
{close
$filehighlight}
2305 catch
{unset fhighlights
}
2307 unhighlight_filelist
2309 set highlight_paths
{}
2310 after cancel do_file_hl
$fh_serial
2312 if {$highlight_files ne
{}} {
2313 after
300 do_file_hl
$fh_serial
2317 proc gdttype_change
{name ix op
} {
2318 global gdttype highlight_files findstring findpattern
2321 if {$findstring ne
{}} {
2322 if {$gdttype eq
[mc
"containing:"]} {
2323 if {$highlight_files ne
{}} {
2324 set highlight_files
{}
2329 if {$findpattern ne
{}} {
2333 set highlight_files
$findstring
2338 # enable/disable findtype/findloc menus too
2341 proc find_change
{name ix op
} {
2342 global gdttype findstring highlight_files
2345 if {$gdttype eq
[mc
"containing:"]} {
2348 if {$highlight_files ne
$findstring} {
2349 set highlight_files
$findstring
2356 proc findcom_change args
{
2357 global nhighlights boldnamerows
2358 global findpattern findtype findstring gdttype
2361 # delete previous highlights, if any
2362 foreach row
$boldnamerows {
2363 bolden_name
$row mainfont
2366 catch
{unset nhighlights
}
2369 if {$gdttype ne
[mc
"containing:"] ||
$findstring eq
{}} {
2371 } elseif
{$findtype eq
[mc
"Regexp"]} {
2372 set findpattern
$findstring
2374 set e
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2376 set findpattern
"*$e*"
2380 proc makepatterns
{l
} {
2383 set ee
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2384 if {[string index
$ee end
] eq
"/"} {
2394 proc do_file_hl
{serial
} {
2395 global highlight_files filehighlight highlight_paths gdttype fhl_list
2397 if {$gdttype eq
[mc
"touching paths:"]} {
2398 if {[catch
{set paths
[shellsplit
$highlight_files]}]} return
2399 set highlight_paths
[makepatterns
$paths]
2401 set gdtargs
[concat
-- $paths]
2402 } elseif
{$gdttype eq
[mc
"adding/removing string:"]} {
2403 set gdtargs
[list
"-S$highlight_files"]
2405 # must be "containing:", i.e. we're searching commit info
2408 set cmd
[concat | git diff-tree
-r -s --stdin $gdtargs]
2409 set filehighlight
[open
$cmd r
+]
2410 fconfigure
$filehighlight -blocking 0
2411 filerun
$filehighlight readfhighlight
2417 proc flushhighlights
{} {
2418 global filehighlight fhl_list
2420 if {[info exists filehighlight
]} {
2422 puts
$filehighlight ""
2423 flush
$filehighlight
2427 proc askfilehighlight
{row id
} {
2428 global filehighlight fhighlights fhl_list
2430 lappend fhl_list
$id
2431 set fhighlights
($row) -1
2432 puts
$filehighlight $id
2435 proc readfhighlight
{} {
2436 global filehighlight fhighlights commitrow curview iddrawn
2437 global fhl_list find_dirn
2439 if {![info exists filehighlight
]} {
2443 while {[incr nr
] <= 100 && [gets
$filehighlight line
] >= 0} {
2444 set line
[string trim
$line]
2445 set i
[lsearch
-exact $fhl_list $line]
2446 if {$i < 0} continue
2447 for {set j
0} {$j < $i} {incr j
} {
2448 set id
[lindex
$fhl_list $j]
2449 if {[info exists commitrow
($curview,$id)]} {
2450 set fhighlights
($commitrow($curview,$id)) 0
2453 set fhl_list
[lrange
$fhl_list [expr {$i+1}] end
]
2454 if {$line eq
{}} continue
2455 if {![info exists commitrow
($curview,$line)]} continue
2456 set row
$commitrow($curview,$line)
2457 if {[info exists iddrawn
($line)] && ![ishighlighted
$row]} {
2458 bolden
$row mainfontbold
2460 set fhighlights
($row) 1
2462 if {[eof
$filehighlight]} {
2464 puts
"oops, git diff-tree died"
2465 catch
{close
$filehighlight}
2469 if {[info exists find_dirn
]} {
2475 proc doesmatch
{f
} {
2476 global findtype findpattern
2478 if {$findtype eq
[mc
"Regexp"]} {
2479 return [regexp
$findpattern $f]
2480 } elseif
{$findtype eq
[mc
"IgnCase"]} {
2481 return [string match
-nocase $findpattern $f]
2483 return [string match
$findpattern $f]
2487 proc askfindhighlight
{row id
} {
2488 global nhighlights commitinfo iddrawn
2490 global markingmatches
2492 if {![info exists commitinfo
($id)]} {
2495 set info
$commitinfo($id)
2497 set fldtypes
[list
[mc Headline
] [mc Author
] [mc Date
] [mc Committer
] [mc CDate
] [mc Comments
]]
2498 foreach f
$info ty
$fldtypes {
2499 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
2501 if {$ty eq
[mc
"Author"]} {
2508 if {$isbold && [info exists iddrawn
($id)]} {
2509 if {![ishighlighted
$row]} {
2510 bolden
$row mainfontbold
2512 bolden_name
$row mainfontbold
2515 if {$markingmatches} {
2516 markrowmatches
$row $id
2519 set nhighlights
($row) $isbold
2522 proc markrowmatches
{row id
} {
2523 global canv canv2 linehtag linentag commitinfo findloc
2525 set headline
[lindex
$commitinfo($id) 0]
2526 set author
[lindex
$commitinfo($id) 1]
2527 $canv delete match
$row
2528 $canv2 delete match
$row
2529 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Headline"]} {
2530 set m
[findmatches
$headline]
2532 markmatches
$canv $row $headline $linehtag($row) $m \
2533 [$canv itemcget
$linehtag($row) -font] $row
2536 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Author"]} {
2537 set m
[findmatches
$author]
2539 markmatches
$canv2 $row $author $linentag($row) $m \
2540 [$canv2 itemcget
$linentag($row) -font] $row
2545 proc vrel_change
{name ix op
} {
2546 global highlight_related
2549 if {$highlight_related ne
[mc
"None"]} {
2554 # prepare for testing whether commits are descendents or ancestors of a
2555 proc rhighlight_sel
{a
} {
2556 global descendent desc_todo ancestor anc_todo
2557 global highlight_related rhighlights
2559 catch
{unset descendent
}
2560 set desc_todo
[list
$a]
2561 catch
{unset ancestor
}
2562 set anc_todo
[list
$a]
2563 if {$highlight_related ne
[mc
"None"]} {
2569 proc rhighlight_none
{} {
2572 catch
{unset rhighlights
}
2576 proc is_descendent
{a
} {
2577 global curview children commitrow descendent desc_todo
2580 set la
$commitrow($v,$a)
2584 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2585 set do [lindex
$todo $i]
2586 if {$commitrow($v,$do) < $la} {
2587 lappend leftover
$do
2590 foreach nk
$children($v,$do) {
2591 if {![info exists descendent
($nk)]} {
2592 set descendent
($nk) 1
2600 set desc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2604 set descendent
($a) 0
2605 set desc_todo
$leftover
2608 proc is_ancestor
{a
} {
2609 global curview parentlist commitrow ancestor anc_todo
2612 set la
$commitrow($v,$a)
2616 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2617 set do [lindex
$todo $i]
2618 if {![info exists commitrow
($v,$do)] ||
$commitrow($v,$do) > $la} {
2619 lappend leftover
$do
2622 foreach np
[lindex
$parentlist $commitrow($v,$do)] {
2623 if {![info exists ancestor
($np)]} {
2632 set anc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2637 set anc_todo
$leftover
2640 proc askrelhighlight
{row id
} {
2641 global descendent highlight_related iddrawn rhighlights
2642 global selectedline ancestor
2644 if {![info exists selectedline
]} return
2646 if {$highlight_related eq
[mc
"Descendant"] ||
2647 $highlight_related eq
[mc
"Not descendant"]} {
2648 if {![info exists descendent
($id)]} {
2651 if {$descendent($id) == ($highlight_related eq
[mc
"Descendant"])} {
2654 } elseif
{$highlight_related eq
[mc
"Ancestor"] ||
2655 $highlight_related eq
[mc
"Not ancestor"]} {
2656 if {![info exists ancestor
($id)]} {
2659 if {$ancestor($id) == ($highlight_related eq
[mc
"Ancestor"])} {
2663 if {[info exists iddrawn
($id)]} {
2664 if {$isbold && ![ishighlighted
$row]} {
2665 bolden
$row mainfontbold
2668 set rhighlights
($row) $isbold
2671 # Graph layout functions
2673 proc shortids
{ids
} {
2676 if {[llength
$id] > 1} {
2677 lappend res
[shortids
$id]
2678 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $id]} {
2679 lappend res
[string range
$id 0 7]
2690 for {set mask
1} {$mask <= $n} {incr mask
$mask} {
2691 if {($n & $mask) != 0} {
2692 set ret
[concat
$ret $o]
2694 set o
[concat
$o $o]
2699 # Work out where id should go in idlist so that order-token
2700 # values increase from left to right
2701 proc idcol
{idlist id
{i
0}} {
2702 global ordertok curview
2704 set t
$ordertok($curview,$id)
2705 if {$i >= [llength
$idlist] ||
2706 $t < $ordertok($curview,[lindex
$idlist $i])} {
2707 if {$i > [llength
$idlist]} {
2708 set i
[llength
$idlist]
2710 while {[incr i
-1] >= 0 &&
2711 $t < $ordertok($curview,[lindex
$idlist $i])} {}
2714 if {$t > $ordertok($curview,[lindex
$idlist $i])} {
2715 while {[incr i
] < [llength
$idlist] &&
2716 $t >= $ordertok($curview,[lindex
$idlist $i])} {}
2722 proc initlayout
{} {
2723 global rowidlist rowisopt rowfinal displayorder commitlisted
2724 global numcommits canvxmax canv
2727 global colormap rowtextx
2738 set canvxmax
[$canv cget
-width]
2739 catch
{unset colormap
}
2740 catch
{unset rowtextx
}
2744 proc setcanvscroll
{} {
2745 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2747 set ymax
[expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2748 $canv conf
-scrollregion [list
0 0 $canvxmax $ymax]
2749 $canv2 conf
-scrollregion [list
0 0 0 $ymax]
2750 $canv3 conf
-scrollregion [list
0 0 0 $ymax]
2753 proc visiblerows
{} {
2754 global canv numcommits linespc
2756 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2757 if {$ymax eq
{} ||
$ymax == 0} return
2759 set y0
[expr {int
([lindex
$f 0] * $ymax)}]
2760 set r0
[expr {int
(($y0 - 3) / $linespc) - 1}]
2764 set y1
[expr {int
([lindex
$f 1] * $ymax)}]
2765 set r1
[expr {int
(($y1 - 3) / $linespc) + 1}]
2766 if {$r1 >= $numcommits} {
2767 set r1
[expr {$numcommits - 1}]
2769 return [list
$r0 $r1]
2772 proc layoutmore
{} {
2773 global commitidx viewcomplete numcommits
2774 global uparrowlen downarrowlen mingaplen curview
2776 set show
$commitidx($curview)
2777 if {$show > $numcommits ||
$viewcomplete($curview)} {
2778 showstuff
$show $viewcomplete($curview)
2782 proc showstuff
{canshow last
} {
2783 global numcommits commitrow pending_select selectedline curview
2784 global mainheadid displayorder selectfirst
2785 global lastscrollset commitinterest
2787 if {$numcommits == 0} {
2789 set phase
"incrdraw"
2793 set prev
$numcommits
2794 set numcommits
$canshow
2795 set t
[clock clicks
-milliseconds]
2796 if {$prev < 100 ||
$last ||
$t - $lastscrollset > 500} {
2797 set lastscrollset
$t
2800 set rows
[visiblerows
]
2801 set r1
[lindex
$rows 1]
2802 if {$r1 >= $canshow} {
2803 set r1
[expr {$canshow - 1}]
2808 if {[info exists pending_select
] &&
2809 [info exists commitrow
($curview,$pending_select)] &&
2810 $commitrow($curview,$pending_select) < $numcommits} {
2811 selectline
$commitrow($curview,$pending_select) 1
2814 if {[info exists selectedline
] ||
[info exists pending_select
]} {
2817 set l
[first_real_row
]
2824 proc doshowlocalchanges
{} {
2825 global curview mainheadid phase commitrow
2827 if {[info exists commitrow
($curview,$mainheadid)] &&
2828 ($phase eq
{} ||
$commitrow($curview,$mainheadid) < $numcommits - 1)} {
2830 } elseif
{$phase ne
{}} {
2831 lappend commitinterest
($mainheadid) {}
2835 proc dohidelocalchanges
{} {
2836 global localfrow localirow lserial
2838 if {$localfrow >= 0} {
2839 removerow
$localfrow
2841 if {$localirow > 0} {
2845 if {$localirow >= 0} {
2846 removerow
$localirow
2852 # spawn off a process to do git diff-index --cached HEAD
2853 proc dodiffindex
{} {
2854 global localirow localfrow lserial showlocalchanges
2856 if {!$showlocalchanges} return
2860 set fd
[open
"|git diff-index --cached HEAD" r
]
2861 fconfigure
$fd -blocking 0
2862 filerun
$fd [list readdiffindex
$fd $lserial]
2865 proc readdiffindex
{fd serial
} {
2866 global localirow commitrow mainheadid nullid2 curview
2867 global commitinfo commitdata lserial
2870 if {[gets
$fd line
] < 0} {
2876 # we only need to see one line and we don't really care what it says...
2879 # now see if there are any local changes not checked in to the index
2880 if {$serial == $lserial} {
2881 set fd
[open
"|git diff-files" r
]
2882 fconfigure
$fd -blocking 0
2883 filerun
$fd [list readdifffiles
$fd $serial]
2886 if {$isdiff && $serial == $lserial && $localirow == -1} {
2887 # add the line for the changes in the index to the graph
2888 set localirow
$commitrow($curview,$mainheadid)
2889 set hl
[mc
"Local changes checked in to index but not committed"]
2890 set commitinfo
($nullid2) [list
$hl {} {} {} {} " $hl\n"]
2891 set commitdata
($nullid2) "\n $hl\n"
2892 insertrow
$localirow $nullid2
2897 proc readdifffiles
{fd serial
} {
2898 global localirow localfrow commitrow mainheadid nullid curview
2899 global commitinfo commitdata lserial
2902 if {[gets
$fd line
] < 0} {
2908 # we only need to see one line and we don't really care what it says...
2911 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2912 # add the line for the local diff to the graph
2913 if {$localirow >= 0} {
2914 set localfrow
$localirow
2917 set localfrow
$commitrow($curview,$mainheadid)
2919 set hl
[mc
"Local uncommitted changes, not checked in to index"]
2920 set commitinfo
($nullid) [list
$hl {} {} {} {} " $hl\n"]
2921 set commitdata
($nullid) "\n $hl\n"
2922 insertrow
$localfrow $nullid
2927 proc nextuse
{id row
} {
2928 global commitrow curview children
2930 if {[info exists children
($curview,$id)]} {
2931 foreach kid
$children($curview,$id) {
2932 if {![info exists commitrow
($curview,$kid)]} {
2935 if {$commitrow($curview,$kid) > $row} {
2936 return $commitrow($curview,$kid)
2940 if {[info exists commitrow
($curview,$id)]} {
2941 return $commitrow($curview,$id)
2946 proc prevuse
{id row
} {
2947 global commitrow curview children
2950 if {[info exists children
($curview,$id)]} {
2951 foreach kid
$children($curview,$id) {
2952 if {![info exists commitrow
($curview,$kid)]} break
2953 if {$commitrow($curview,$kid) < $row} {
2954 set ret
$commitrow($curview,$kid)
2961 proc make_idlist
{row
} {
2962 global displayorder parentlist uparrowlen downarrowlen mingaplen
2963 global commitidx curview ordertok children commitrow
2965 set r
[expr {$row - $mingaplen - $downarrowlen - 1}]
2969 set ra
[expr {$row - $downarrowlen}]
2973 set rb
[expr {$row + $uparrowlen}]
2974 if {$rb > $commitidx($curview)} {
2975 set rb
$commitidx($curview)
2978 for {} {$r < $ra} {incr r
} {
2979 set nextid
[lindex
$displayorder [expr {$r + 1}]]
2980 foreach p
[lindex
$parentlist $r] {
2981 if {$p eq
$nextid} continue
2982 set rn
[nextuse
$p $r]
2984 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2985 lappend ids
[list
$ordertok($curview,$p) $p]
2989 for {} {$r < $row} {incr r
} {
2990 set nextid
[lindex
$displayorder [expr {$r + 1}]]
2991 foreach p
[lindex
$parentlist $r] {
2992 if {$p eq
$nextid} continue
2993 set rn
[nextuse
$p $r]
2994 if {$rn < 0 ||
$rn >= $row} {
2995 lappend ids
[list
$ordertok($curview,$p) $p]
2999 set id
[lindex
$displayorder $row]
3000 lappend ids
[list
$ordertok($curview,$id) $id]
3002 foreach p
[lindex
$parentlist $r] {
3003 set firstkid
[lindex
$children($curview,$p) 0]
3004 if {$commitrow($curview,$firstkid) < $row} {
3005 lappend ids
[list
$ordertok($curview,$p) $p]
3009 set id
[lindex
$displayorder $r]
3011 set firstkid
[lindex
$children($curview,$id) 0]
3012 if {$firstkid ne
{} && $commitrow($curview,$firstkid) < $row} {
3013 lappend ids
[list
$ordertok($curview,$id) $id]
3018 foreach idx
[lsort
-unique $ids] {
3019 lappend idlist
[lindex
$idx 1]
3024 proc rowsequal
{a b
} {
3025 while {[set i
[lsearch
-exact $a {}]] >= 0} {
3026 set a
[lreplace
$a $i $i]
3028 while {[set i
[lsearch
-exact $b {}]] >= 0} {
3029 set b
[lreplace
$b $i $i]
3031 return [expr {$a eq
$b}]
3034 proc makeupline
{id row rend
col} {
3035 global rowidlist uparrowlen downarrowlen mingaplen
3037 for {set r
$rend} {1} {set r
$rstart} {
3038 set rstart
[prevuse
$id $r]
3039 if {$rstart < 0} return
3040 if {$rstart < $row} break
3042 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3043 set rstart
[expr {$rend - $uparrowlen - 1}]
3045 for {set r
$rstart} {[incr r
] <= $row} {} {
3046 set idlist
[lindex
$rowidlist $r]
3047 if {$idlist ne
{} && [lsearch
-exact $idlist $id] < 0} {
3048 set col [idcol
$idlist $id $col]
3049 lset rowidlist
$r [linsert
$idlist $col $id]
3055 proc layoutrows
{row endrow
} {
3056 global rowidlist rowisopt rowfinal displayorder
3057 global uparrowlen downarrowlen maxwidth mingaplen
3058 global children parentlist
3059 global commitidx viewcomplete curview commitrow
3063 set rm1
[expr {$row - 1}]
3064 foreach id
[lindex
$rowidlist $rm1] {
3069 set final
[lindex
$rowfinal $rm1]
3071 for {} {$row < $endrow} {incr row
} {
3072 set rm1
[expr {$row - 1}]
3073 if {$rm1 < 0 ||
$idlist eq
{}} {
3074 set idlist
[make_idlist
$row]
3077 set id
[lindex
$displayorder $rm1]
3078 set col [lsearch
-exact $idlist $id]
3079 set idlist
[lreplace
$idlist $col $col]
3080 foreach p
[lindex
$parentlist $rm1] {
3081 if {[lsearch
-exact $idlist $p] < 0} {
3082 set col [idcol
$idlist $p $col]
3083 set idlist
[linsert
$idlist $col $p]
3084 # if not the first child, we have to insert a line going up
3085 if {$id ne
[lindex
$children($curview,$p) 0]} {
3086 makeupline
$p $rm1 $row $col
3090 set id
[lindex
$displayorder $row]
3091 if {$row > $downarrowlen} {
3092 set termrow
[expr {$row - $downarrowlen - 1}]
3093 foreach p
[lindex
$parentlist $termrow] {
3094 set i
[lsearch
-exact $idlist $p]
3095 if {$i < 0} continue
3096 set nr
[nextuse
$p $termrow]
3097 if {$nr < 0 ||
$nr >= $row + $mingaplen + $uparrowlen} {
3098 set idlist
[lreplace
$idlist $i $i]
3102 set col [lsearch
-exact $idlist $id]
3104 set col [idcol
$idlist $id]
3105 set idlist
[linsert
$idlist $col $id]
3106 if {$children($curview,$id) ne
{}} {
3107 makeupline
$id $rm1 $row $col
3110 set r
[expr {$row + $uparrowlen - 1}]
3111 if {$r < $commitidx($curview)} {
3113 foreach p
[lindex
$parentlist $r] {
3114 if {[lsearch
-exact $idlist $p] >= 0} continue
3115 set fk
[lindex
$children($curview,$p) 0]
3116 if {$commitrow($curview,$fk) < $row} {
3117 set x
[idcol
$idlist $p $x]
3118 set idlist
[linsert
$idlist $x $p]
3121 if {[incr r
] < $commitidx($curview)} {
3122 set p
[lindex
$displayorder $r]
3123 if {[lsearch
-exact $idlist $p] < 0} {
3124 set fk
[lindex
$children($curview,$p) 0]
3125 if {$fk ne
{} && $commitrow($curview,$fk) < $row} {
3126 set x
[idcol
$idlist $p $x]
3127 set idlist
[linsert
$idlist $x $p]
3133 if {$final && !$viewcomplete($curview) &&
3134 $row + $uparrowlen + $mingaplen + $downarrowlen
3135 >= $commitidx($curview)} {
3138 set l
[llength
$rowidlist]
3140 lappend rowidlist
$idlist
3142 lappend rowfinal
$final
3143 } elseif
{$row < $l} {
3144 if {![rowsequal
$idlist [lindex
$rowidlist $row]]} {
3145 lset rowidlist
$row $idlist
3148 lset rowfinal
$row $final
3150 set pad
[ntimes
[expr {$row - $l}] {}]
3151 set rowidlist
[concat
$rowidlist $pad]
3152 lappend rowidlist
$idlist
3153 set rowfinal
[concat
$rowfinal $pad]
3154 lappend rowfinal
$final
3155 set rowisopt
[concat
$rowisopt [ntimes
[expr {$row - $l + 1}] 0]]
3161 proc changedrow
{row
} {
3162 global displayorder iddrawn rowisopt need_redisplay
3164 set l
[llength
$rowisopt]
3166 lset rowisopt
$row 0
3167 if {$row + 1 < $l} {
3168 lset rowisopt
[expr {$row + 1}] 0
3169 if {$row + 2 < $l} {
3170 lset rowisopt
[expr {$row + 2}] 0
3174 set id
[lindex
$displayorder $row]
3175 if {[info exists iddrawn
($id)]} {
3176 set need_redisplay
1
3180 proc insert_pad
{row
col npad
} {
3183 set pad
[ntimes
$npad {}]
3184 set idlist
[lindex
$rowidlist $row]
3185 set bef
[lrange
$idlist 0 [expr {$col - 1}]]
3186 set aft
[lrange
$idlist $col end
]
3187 set i
[lsearch
-exact $aft {}]
3189 set aft
[lreplace
$aft $i $i]
3191 lset rowidlist
$row [concat
$bef $pad $aft]
3195 proc optimize_rows
{row
col endrow
} {
3196 global rowidlist rowisopt displayorder curview children
3201 for {} {$row < $endrow} {incr row
; set col 0} {
3202 if {[lindex
$rowisopt $row]} continue
3204 set y0
[expr {$row - 1}]
3205 set ym
[expr {$row - 2}]
3206 set idlist
[lindex
$rowidlist $row]
3207 set previdlist
[lindex
$rowidlist $y0]
3208 if {$idlist eq
{} ||
$previdlist eq
{}} continue
3210 set pprevidlist
[lindex
$rowidlist $ym]
3211 if {$pprevidlist eq
{}} continue
3217 for {} {$col < [llength
$idlist]} {incr
col} {
3218 set id
[lindex
$idlist $col]
3219 if {[lindex
$previdlist $col] eq
$id} continue
3224 set x0
[lsearch
-exact $previdlist $id]
3225 if {$x0 < 0} continue
3226 set z
[expr {$x0 - $col}]
3230 set xm
[lsearch
-exact $pprevidlist $id]
3232 set z0
[expr {$xm - $x0}]
3236 # if row y0 is the first child of $id then it's not an arrow
3237 if {[lindex
$children($curview,$id) 0] ne
3238 [lindex
$displayorder $y0]} {
3242 if {!$isarrow && $id ne
[lindex
$displayorder $row] &&
3243 [lsearch
-exact [lindex
$rowidlist [expr {$row+1}]] $id] < 0} {
3246 # Looking at lines from this row to the previous row,
3247 # make them go straight up if they end in an arrow on
3248 # the previous row; otherwise make them go straight up
3250 if {$z < -1 ||
($z < 0 && $isarrow)} {
3251 # Line currently goes left too much;
3252 # insert pads in the previous row, then optimize it
3253 set npad
[expr {-1 - $z + $isarrow}]
3254 insert_pad
$y0 $x0 $npad
3256 optimize_rows
$y0 $x0 $row
3258 set previdlist
[lindex
$rowidlist $y0]
3259 set x0
[lsearch
-exact $previdlist $id]
3260 set z
[expr {$x0 - $col}]
3262 set pprevidlist
[lindex
$rowidlist $ym]
3263 set xm
[lsearch
-exact $pprevidlist $id]
3264 set z0
[expr {$xm - $x0}]
3266 } elseif
{$z > 1 ||
($z > 0 && $isarrow)} {
3267 # Line currently goes right too much;
3268 # insert pads in this line
3269 set npad
[expr {$z - 1 + $isarrow}]
3270 insert_pad
$row $col $npad
3271 set idlist
[lindex
$rowidlist $row]
3273 set z
[expr {$x0 - $col}]
3276 if {$z0 eq
{} && !$isarrow && $ym >= 0} {
3277 # this line links to its first child on row $row-2
3278 set id
[lindex
$displayorder $ym]
3279 set xc
[lsearch
-exact $pprevidlist $id]
3281 set z0
[expr {$xc - $x0}]
3284 # avoid lines jigging left then immediately right
3285 if {$z0 ne
{} && $z < 0 && $z0 > 0} {
3286 insert_pad
$y0 $x0 1
3288 optimize_rows
$y0 $x0 $row
3289 set previdlist
[lindex
$rowidlist $y0]
3293 # Find the first column that doesn't have a line going right
3294 for {set col [llength
$idlist]} {[incr
col -1] >= 0} {} {
3295 set id
[lindex
$idlist $col]
3296 if {$id eq
{}} break
3297 set x0
[lsearch
-exact $previdlist $id]
3299 # check if this is the link to the first child
3300 set kid
[lindex
$displayorder $y0]
3301 if {[lindex
$children($curview,$id) 0] eq
$kid} {
3302 # it is, work out offset to child
3303 set x0
[lsearch
-exact $previdlist $kid]
3306 if {$x0 <= $col} break
3308 # Insert a pad at that column as long as it has a line and
3309 # isn't the last column
3310 if {$x0 >= 0 && [incr
col] < [llength
$idlist]} {
3311 set idlist
[linsert
$idlist $col {}]
3312 lset rowidlist
$row $idlist
3320 global canvx0 linespc
3321 return [expr {$canvx0 + $col * $linespc}]
3325 global canvy0 linespc
3326 return [expr {$canvy0 + $row * $linespc}]
3329 proc linewidth
{id
} {
3330 global thickerline lthickness
3333 if {[info exists thickerline
] && $id eq
$thickerline} {
3334 set wid
[expr {2 * $lthickness}]
3339 proc rowranges
{id
} {
3340 global commitrow curview children uparrowlen downarrowlen
3343 set kids
$children($curview,$id)
3349 foreach child
$kids {
3350 if {![info exists commitrow
($curview,$child)]} break
3351 set row
$commitrow($curview,$child)
3352 if {![info exists prev
]} {
3353 lappend ret
[expr {$row + 1}]
3355 if {$row <= $prevrow} {
3356 puts
"oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3358 # see if the line extends the whole way from prevrow to row
3359 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3360 [lsearch
-exact [lindex
$rowidlist \
3361 [expr {int
(($row + $prevrow) / 2)}]] $id] < 0} {
3362 # it doesn't, see where it ends
3363 set r
[expr {$prevrow + $downarrowlen}]
3364 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3365 while {[incr r
-1] > $prevrow &&
3366 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3368 while {[incr r
] <= $row &&
3369 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3373 # see where it starts up again
3374 set r
[expr {$row - $uparrowlen}]
3375 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3376 while {[incr r
] < $row &&
3377 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3379 while {[incr r
-1] >= $prevrow &&
3380 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3386 if {$child eq
$id} {
3395 proc drawlineseg
{id row endrow arrowlow
} {
3396 global rowidlist displayorder iddrawn linesegs
3397 global canv colormap linespc curview maxlinelen parentlist
3399 set cols
[list
[lsearch
-exact [lindex
$rowidlist $row] $id]]
3400 set le
[expr {$row + 1}]
3403 set c
[lsearch
-exact [lindex
$rowidlist $le] $id]
3409 set x
[lindex
$displayorder $le]
3414 if {[info exists iddrawn
($x)] ||
$le == $endrow} {
3415 set c
[lsearch
-exact [lindex
$rowidlist [expr {$le+1}]] $id]
3431 if {[info exists linesegs
($id)]} {
3432 set lines
$linesegs($id)
3434 set r0
[lindex
$li 0]
3436 if {$r0 == $le && [lindex
$li 1] - $row <= $maxlinelen} {
3446 set li
[lindex
$lines [expr {$i-1}]]
3447 set r1
[lindex
$li 1]
3448 if {$r1 == $row && $le - [lindex
$li 0] <= $maxlinelen} {
3453 set x
[lindex
$cols [expr {$le - $row}]]
3454 set xp
[lindex
$cols [expr {$le - 1 - $row}]]
3455 set dir
[expr {$xp - $x}]
3457 set ith
[lindex
$lines $i 2]
3458 set coords
[$canv coords
$ith]
3459 set ah
[$canv itemcget
$ith -arrow]
3460 set arrowhigh
[expr {$ah eq
"first" ||
$ah eq
"both"}]
3461 set x2
[lindex
$cols [expr {$le + 1 - $row}]]
3462 if {$x2 ne
{} && $x - $x2 == $dir} {
3463 set coords
[lrange
$coords 0 end-2
]
3466 set coords
[list
[xc
$le $x] [yc
$le]]
3469 set itl
[lindex
$lines [expr {$i-1}] 2]
3470 set al
[$canv itemcget
$itl -arrow]
3471 set arrowlow
[expr {$al eq
"last" ||
$al eq
"both"}]
3472 } elseif
{$arrowlow} {
3473 if {[lsearch
-exact [lindex
$rowidlist [expr {$row-1}]] $id] >= 0 ||
3474 [lsearch
-exact [lindex
$parentlist [expr {$row-1}]] $id] >= 0} {
3478 set arrow
[lindex
{none first last both
} [expr {$arrowhigh + 2*$arrowlow}]]
3479 for {set y
$le} {[incr y
-1] > $row} {} {
3481 set xp
[lindex
$cols [expr {$y - 1 - $row}]]
3482 set ndir
[expr {$xp - $x}]
3483 if {$dir != $ndir ||
$xp < 0} {
3484 lappend coords
[xc
$y $x] [yc
$y]
3490 # join parent line to first child
3491 set ch
[lindex
$displayorder $row]
3492 set xc
[lsearch
-exact [lindex
$rowidlist $row] $ch]
3494 puts
"oops: drawlineseg: child $ch not on row $row"
3495 } elseif
{$xc != $x} {
3496 if {($arrowhigh && $le == $row + 1) ||
$dir == 0} {
3497 set d
[expr {int
(0.5 * $linespc)}]
3500 set x2
[expr {$x1 - $d}]
3502 set x2
[expr {$x1 + $d}]
3505 set y1
[expr {$y2 + $d}]
3506 lappend coords
$x1 $y1 $x2 $y2
3507 } elseif
{$xc < $x - 1} {
3508 lappend coords
[xc
$row [expr {$x-1}]] [yc
$row]
3509 } elseif
{$xc > $x + 1} {
3510 lappend coords
[xc
$row [expr {$x+1}]] [yc
$row]
3514 lappend coords
[xc
$row $x] [yc
$row]
3516 set xn
[xc
$row $xp]
3518 lappend coords
$xn $yn
3522 set t
[$canv create line
$coords -width [linewidth
$id] \
3523 -fill $colormap($id) -tags lines.
$id -arrow $arrow]
3526 set lines
[linsert
$lines $i [list
$row $le $t]]
3528 $canv coords
$ith $coords
3529 if {$arrow ne
$ah} {
3530 $canv itemconf
$ith -arrow $arrow
3532 lset lines
$i 0 $row
3535 set xo
[lsearch
-exact [lindex
$rowidlist [expr {$row - 1}]] $id]
3536 set ndir
[expr {$xo - $xp}]
3537 set clow
[$canv coords
$itl]
3538 if {$dir == $ndir} {
3539 set clow
[lrange
$clow 2 end
]
3541 set coords
[concat
$coords $clow]
3543 lset lines
[expr {$i-1}] 1 $le
3545 # coalesce two pieces
3547 set b
[lindex
$lines [expr {$i-1}] 0]
3548 set e
[lindex
$lines $i 1]
3549 set lines
[lreplace
$lines [expr {$i-1}] $i [list
$b $e $itl]]
3551 $canv coords
$itl $coords
3552 if {$arrow ne
$al} {
3553 $canv itemconf
$itl -arrow $arrow
3557 set linesegs
($id) $lines
3561 proc drawparentlinks
{id row
} {
3562 global rowidlist canv colormap curview parentlist
3563 global idpos linespc
3565 set rowids
[lindex
$rowidlist $row]
3566 set col [lsearch
-exact $rowids $id]
3567 if {$col < 0} return
3568 set olds
[lindex
$parentlist $row]
3569 set row2
[expr {$row + 1}]
3570 set x
[xc
$row $col]
3573 set d
[expr {int
(0.5 * $linespc)}]
3574 set ymid
[expr {$y + $d}]
3575 set ids
[lindex
$rowidlist $row2]
3576 # rmx = right-most X coord used
3579 set i
[lsearch
-exact $ids $p]
3581 puts
"oops, parent $p of $id not in list"
3584 set x2
[xc
$row2 $i]
3588 set j
[lsearch
-exact $rowids $p]
3590 # drawlineseg will do this one for us
3594 # should handle duplicated parents here...
3595 set coords
[list
$x $y]
3597 # if attaching to a vertical segment, draw a smaller
3598 # slant for visual distinctness
3601 lappend coords
[expr {$x2 + $d}] $y $x2 $ymid
3603 lappend coords
[expr {$x2 - $d}] $y $x2 $ymid
3605 } elseif
{$i < $col && $i < $j} {
3606 # segment slants towards us already
3607 lappend coords
[xc
$row $j] $y
3609 if {$i < $col - 1} {
3610 lappend coords
[expr {$x2 + $linespc}] $y
3611 } elseif
{$i > $col + 1} {
3612 lappend coords
[expr {$x2 - $linespc}] $y
3614 lappend coords
$x2 $y2
3617 lappend coords
$x2 $y2
3619 set t
[$canv create line
$coords -width [linewidth
$p] \
3620 -fill $colormap($p) -tags lines.
$p]
3624 if {$rmx > [lindex
$idpos($id) 1]} {
3625 lset idpos
($id) 1 $rmx
3630 proc drawlines
{id
} {
3633 $canv itemconf lines.
$id -width [linewidth
$id]
3636 proc drawcmittext
{id row
col} {
3637 global linespc canv canv2 canv3 canvy0 fgcolor curview
3638 global commitlisted commitinfo rowidlist parentlist
3639 global rowtextx idpos idtags idheads idotherrefs
3640 global linehtag linentag linedtag selectedline
3641 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3643 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3644 set listed
[lindex
$commitlisted $row]
3645 if {$id eq
$nullid} {
3647 } elseif
{$id eq
$nullid2} {
3650 set ofill
[expr {$listed != 0 ?
$listed == 2 ?
"gray" : "blue" : "white"}]
3652 set x
[xc
$row $col]
3654 set orad
[expr {$linespc / 3}]
3656 set t
[$canv create oval
[expr {$x - $orad}] [expr {$y - $orad}] \
3657 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3658 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3659 } elseif
{$listed == 3} {
3660 # triangle pointing left for left-side commits
3661 set t
[$canv create polygon \
3662 [expr {$x - $orad}] $y \
3663 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3664 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3665 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3667 # triangle pointing right for right-side commits
3668 set t
[$canv create polygon \
3669 [expr {$x + $orad - 1}] $y \
3670 [expr {$x - $orad}] [expr {$y - $orad}] \
3671 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3672 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3675 $canv bind $t <1> {selcanvline
{} %x
%y
}
3676 set rmx
[llength
[lindex
$rowidlist $row]]
3677 set olds
[lindex
$parentlist $row]
3679 set nextids
[lindex
$rowidlist [expr {$row + 1}]]
3681 set i
[lsearch
-exact $nextids $p]
3687 set xt
[xc
$row $rmx]
3688 set rowtextx
($row) $xt
3689 set idpos
($id) [list
$x $xt $y]
3690 if {[info exists idtags
($id)] ||
[info exists idheads
($id)]
3691 ||
[info exists idotherrefs
($id)]} {
3692 set xt
[drawtags
$id $x $xt $y]
3694 set headline
[lindex
$commitinfo($id) 0]
3695 set name
[lindex
$commitinfo($id) 1]
3696 set date [lindex
$commitinfo($id) 2]
3697 set date [formatdate
$date]
3700 set isbold
[ishighlighted
$row]
3702 lappend boldrows
$row
3703 set font mainfontbold
3705 lappend boldnamerows
$row
3706 set nfont mainfontbold
3709 set linehtag
($row) [$canv create text
$xt $y -anchor w
-fill $fgcolor \
3710 -text $headline -font $font -tags text
]
3711 $canv bind $linehtag($row) <Button-3
> "rowmenu %X %Y $id"
3712 set linentag
($row) [$canv2 create text
3 $y -anchor w
-fill $fgcolor \
3713 -text $name -font $nfont -tags text
]
3714 set linedtag
($row) [$canv3 create text
3 $y -anchor w
-fill $fgcolor \
3715 -text $date -font mainfont
-tags text
]
3716 if {[info exists selectedline
] && $selectedline == $row} {
3719 set xr
[expr {$xt + [font measure
$font $headline]}]
3720 if {$xr > $canvxmax} {
3726 proc drawcmitrow
{row
} {
3727 global displayorder rowidlist nrows_drawn
3728 global iddrawn markingmatches
3729 global commitinfo parentlist numcommits
3730 global filehighlight fhighlights findpattern nhighlights
3731 global hlview vhighlights
3732 global highlight_related rhighlights
3734 if {$row >= $numcommits} return
3736 set id
[lindex
$displayorder $row]
3737 if {[info exists hlview
] && ![info exists vhighlights
($row)]} {
3738 askvhighlight
$row $id
3740 if {[info exists filehighlight
] && ![info exists fhighlights
($row)]} {
3741 askfilehighlight
$row $id
3743 if {$findpattern ne
{} && ![info exists nhighlights
($row)]} {
3744 askfindhighlight
$row $id
3746 if {$highlight_related ne
[mc
"None"] && ![info exists rhighlights
($row)]} {
3747 askrelhighlight
$row $id
3749 if {![info exists iddrawn
($id)]} {
3750 set col [lsearch
-exact [lindex
$rowidlist $row] $id]
3752 puts
"oops, row $row id $id not in list"
3755 if {![info exists commitinfo
($id)]} {
3759 drawcmittext
$id $row $col
3763 if {$markingmatches} {
3764 markrowmatches
$row $id
3768 proc drawcommits
{row
{endrow
{}}} {
3769 global numcommits iddrawn displayorder curview need_redisplay
3770 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3775 if {$endrow eq
{}} {
3778 if {$endrow >= $numcommits} {
3779 set endrow
[expr {$numcommits - 1}]
3782 set rl1
[expr {$row - $downarrowlen - 3}]
3786 set ro1
[expr {$row - 3}]
3790 set r2
[expr {$endrow + $uparrowlen + 3}]
3791 if {$r2 > $numcommits} {
3794 for {set r
$rl1} {$r < $r2} {incr r
} {
3795 if {[lindex
$rowidlist $r] ne
{} && [lindex
$rowfinal $r]} {
3799 set rl1
[expr {$r + 1}]
3805 optimize_rows
$ro1 0 $r2
3806 if {$need_redisplay ||
$nrows_drawn > 2000} {
3811 # make the lines join to already-drawn rows either side
3812 set r
[expr {$row - 1}]
3813 if {$r < 0 ||
![info exists iddrawn
([lindex
$displayorder $r])]} {
3816 set er
[expr {$endrow + 1}]
3817 if {$er >= $numcommits ||
3818 ![info exists iddrawn
([lindex
$displayorder $er])]} {
3821 for {} {$r <= $er} {incr r
} {
3822 set id
[lindex
$displayorder $r]
3823 set wasdrawn
[info exists iddrawn
($id)]
3825 if {$r == $er} break
3826 set nextid
[lindex
$displayorder [expr {$r + 1}]]
3827 if {$wasdrawn && [info exists iddrawn
($nextid)]} continue
3828 drawparentlinks
$id $r
3830 set rowids
[lindex
$rowidlist $r]
3831 foreach lid
$rowids {
3832 if {$lid eq
{}} continue
3833 if {[info exists lineend
($lid)] && $lineend($lid) > $r} continue
3835 # see if this is the first child of any of its parents
3836 foreach p
[lindex
$parentlist $r] {
3837 if {[lsearch
-exact $rowids $p] < 0} {
3838 # make this line extend up to the child
3839 set lineend
($p) [drawlineseg
$p $r $er 0]
3843 set lineend
($lid) [drawlineseg
$lid $r $er 1]
3849 proc drawfrac
{f0 f1
} {
3852 set ymax
[lindex
[$canv cget
-scrollregion] 3]
3853 if {$ymax eq
{} ||
$ymax == 0} return
3854 set y0
[expr {int
($f0 * $ymax)}]
3855 set row
[expr {int
(($y0 - 3) / $linespc) - 1}]
3856 set y1
[expr {int
($f1 * $ymax)}]
3857 set endrow
[expr {int
(($y1 - 3) / $linespc) + 1}]
3858 drawcommits
$row $endrow
3861 proc drawvisible
{} {
3863 eval drawfrac
[$canv yview
]
3866 proc clear_display
{} {
3867 global iddrawn linesegs need_redisplay nrows_drawn
3868 global vhighlights fhighlights nhighlights rhighlights
3871 catch
{unset iddrawn
}
3872 catch
{unset linesegs
}
3873 catch
{unset vhighlights
}
3874 catch
{unset fhighlights
}
3875 catch
{unset nhighlights
}
3876 catch
{unset rhighlights
}
3877 set need_redisplay
0
3881 proc findcrossings
{id
} {
3882 global rowidlist parentlist numcommits displayorder
3886 foreach
{s e
} [rowranges
$id] {
3887 if {$e >= $numcommits} {
3888 set e
[expr {$numcommits - 1}]
3890 if {$e <= $s} continue
3891 for {set row
$e} {[incr row
-1] >= $s} {} {
3892 set x
[lsearch
-exact [lindex
$rowidlist $row] $id]
3894 set olds
[lindex
$parentlist $row]
3895 set kid
[lindex
$displayorder $row]
3896 set kidx
[lsearch
-exact [lindex
$rowidlist $row] $kid]
3897 if {$kidx < 0} continue
3898 set nextrow
[lindex
$rowidlist [expr {$row + 1}]]
3900 set px
[lsearch
-exact $nextrow $p]
3901 if {$px < 0} continue
3902 if {($kidx < $x && $x < $px) ||
($px < $x && $x < $kidx)} {
3903 if {[lsearch
-exact $ccross $p] >= 0} continue
3904 if {$x == $px + ($kidx < $px?
-1: 1)} {
3906 } elseif
{[lsearch
-exact $cross $p] < 0} {
3913 return [concat
$ccross {{}} $cross]
3916 proc assigncolor
{id
} {
3917 global colormap colors nextcolor
3918 global commitrow parentlist children children curview
3920 if {[info exists colormap
($id)]} return
3921 set ncolors
[llength
$colors]
3922 if {[info exists children
($curview,$id)]} {
3923 set kids
$children($curview,$id)
3927 if {[llength
$kids] == 1} {
3928 set child
[lindex
$kids 0]
3929 if {[info exists colormap
($child)]
3930 && [llength
[lindex
$parentlist $commitrow($curview,$child)]] == 1} {
3931 set colormap
($id) $colormap($child)
3937 foreach x
[findcrossings
$id] {
3939 # delimiter between corner crossings and other crossings
3940 if {[llength
$badcolors] >= $ncolors - 1} break
3941 set origbad
$badcolors
3943 if {[info exists colormap
($x)]
3944 && [lsearch
-exact $badcolors $colormap($x)] < 0} {
3945 lappend badcolors
$colormap($x)
3948 if {[llength
$badcolors] >= $ncolors} {
3949 set badcolors
$origbad
3951 set origbad
$badcolors
3952 if {[llength
$badcolors] < $ncolors - 1} {
3953 foreach child
$kids {
3954 if {[info exists colormap
($child)]
3955 && [lsearch
-exact $badcolors $colormap($child)] < 0} {
3956 lappend badcolors
$colormap($child)
3958 foreach p
[lindex
$parentlist $commitrow($curview,$child)] {
3959 if {[info exists colormap
($p)]
3960 && [lsearch
-exact $badcolors $colormap($p)] < 0} {
3961 lappend badcolors
$colormap($p)
3965 if {[llength
$badcolors] >= $ncolors} {
3966 set badcolors
$origbad
3969 for {set i
0} {$i <= $ncolors} {incr i
} {
3970 set c
[lindex
$colors $nextcolor]
3971 if {[incr nextcolor
] >= $ncolors} {
3974 if {[lsearch
-exact $badcolors $c]} break
3976 set colormap
($id) $c
3979 proc bindline
{t id
} {
3982 $canv bind $t <Enter
> "lineenter %x %y $id"
3983 $canv bind $t <Motion
> "linemotion %x %y $id"
3984 $canv bind $t <Leave
> "lineleave $id"
3985 $canv bind $t <Button-1
> "lineclick %x %y $id 1"
3988 proc drawtags
{id x xt y1
} {
3989 global idtags idheads idotherrefs mainhead
3990 global linespc lthickness
3991 global canv commitrow rowtextx curview fgcolor bgcolor
3996 if {[info exists idtags
($id)]} {
3997 set marks
$idtags($id)
3998 set ntags
[llength
$marks]
4000 if {[info exists idheads
($id)]} {
4001 set marks
[concat
$marks $idheads($id)]
4002 set nheads
[llength
$idheads($id)]
4004 if {[info exists idotherrefs
($id)]} {
4005 set marks
[concat
$marks $idotherrefs($id)]
4011 set delta
[expr {int
(0.5 * ($linespc - $lthickness))}]
4012 set yt
[expr {$y1 - 0.5 * $linespc}]
4013 set yb
[expr {$yt + $linespc - 1}]
4017 foreach tag
$marks {
4019 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq
$mainhead} {
4020 set wid
[font measure mainfontbold
$tag]
4022 set wid
[font measure mainfont
$tag]
4026 set xt
[expr {$xt + $delta + $wid + $lthickness + $linespc}]
4028 set t
[$canv create line
$x $y1 [lindex
$xvals end
] $y1 \
4029 -width $lthickness -fill black
-tags tag.
$id]
4031 foreach tag
$marks x
$xvals wid
$wvals {
4032 set xl
[expr {$x + $delta}]
4033 set xr
[expr {$x + $delta + $wid + $lthickness}]
4035 if {[incr ntags
-1] >= 0} {
4037 set t
[$canv create polygon
$x [expr {$yt + $delta}] $xl $yt \
4038 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4039 -width 1 -outline black
-fill yellow
-tags tag.
$id]
4040 $canv bind $t <1> [list showtag
$tag 1]
4041 set rowtextx
($commitrow($curview,$id)) [expr {$xr + $linespc}]
4043 # draw a head or other ref
4044 if {[incr nheads
-1] >= 0} {
4046 if {$tag eq
$mainhead} {
4047 set font mainfontbold
4052 set xl
[expr {$xl - $delta/2}]
4053 $canv create polygon
$x $yt $xr $yt $xr $yb $x $yb \
4054 -width 1 -outline black
-fill $col -tags tag.
$id
4055 if {[regexp
{^
(remotes
/.
*/|remotes
/)} $tag match remoteprefix
]} {
4056 set rwid
[font measure mainfont
$remoteprefix]
4057 set xi
[expr {$x + 1}]
4058 set yti
[expr {$yt + 1}]
4059 set xri
[expr {$x + $rwid}]
4060 $canv create polygon
$xi $yti $xri $yti $xri $yb $xi $yb \
4061 -width 0 -fill "#ffddaa" -tags tag.
$id
4064 set t
[$canv create text
$xl $y1 -anchor w
-text $tag -fill $fgcolor \
4065 -font $font -tags [list tag.
$id text
]]
4067 $canv bind $t <1> [list showtag
$tag 1]
4068 } elseif
{$nheads >= 0} {
4069 $canv bind $t <Button-3
> [list headmenu
%X
%Y
$id $tag]
4075 proc xcoord
{i level
ln} {
4076 global canvx0 xspc1 xspc2
4078 set x
[expr {$canvx0 + $i * $xspc1($ln)}]
4079 if {$i > 0 && $i == $level} {
4080 set x
[expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4081 } elseif
{$i > $level} {
4082 set x
[expr {$x + $xspc2 - $xspc1($ln)}]
4087 proc show_status
{msg
} {
4091 $canv create text
3 3 -anchor nw
-text $msg -font mainfont \
4092 -tags text
-fill $fgcolor
4095 # Insert a new commit as the child of the commit on row $row.
4096 # The new commit will be displayed on row $row and the commits
4097 # on that row and below will move down one row.
4098 proc insertrow
{row newcmit
} {
4099 global displayorder parentlist commitlisted children
4100 global commitrow curview rowidlist rowisopt rowfinal numcommits
4102 global selectedline commitidx ordertok
4104 if {$row >= $numcommits} {
4105 puts
"oops, inserting new row $row but only have $numcommits rows"
4108 set p
[lindex
$displayorder $row]
4109 set displayorder
[linsert
$displayorder $row $newcmit]
4110 set parentlist
[linsert
$parentlist $row $p]
4111 set kids
$children($curview,$p)
4112 lappend kids
$newcmit
4113 set children
($curview,$p) $kids
4114 set children
($curview,$newcmit) {}
4115 set commitlisted
[linsert
$commitlisted $row 1]
4116 set l
[llength
$displayorder]
4117 for {set r
$row} {$r < $l} {incr r
} {
4118 set id
[lindex
$displayorder $r]
4119 set commitrow
($curview,$id) $r
4121 incr commitidx
($curview)
4122 set ordertok
($curview,$newcmit) $ordertok($curview,$p)
4124 if {$row < [llength
$rowidlist]} {
4125 set idlist
[lindex
$rowidlist $row]
4126 if {$idlist ne
{}} {
4127 if {[llength
$kids] == 1} {
4128 set col [lsearch
-exact $idlist $p]
4129 lset idlist
$col $newcmit
4131 set col [llength
$idlist]
4132 lappend idlist
$newcmit
4135 set rowidlist
[linsert
$rowidlist $row $idlist]
4136 set rowisopt
[linsert
$rowisopt $row 0]
4137 set rowfinal
[linsert
$rowfinal $row [lindex
$rowfinal $row]]
4142 if {[info exists selectedline
] && $selectedline >= $row} {
4148 # Remove a commit that was inserted with insertrow on row $row.
4149 proc removerow
{row
} {
4150 global displayorder parentlist commitlisted children
4151 global commitrow curview rowidlist rowisopt rowfinal numcommits
4153 global linesegends selectedline commitidx
4155 if {$row >= $numcommits} {
4156 puts
"oops, removing row $row but only have $numcommits rows"
4159 set rp1
[expr {$row + 1}]
4160 set id
[lindex
$displayorder $row]
4161 set p
[lindex
$parentlist $row]
4162 set displayorder
[lreplace
$displayorder $row $row]
4163 set parentlist
[lreplace
$parentlist $row $row]
4164 set commitlisted
[lreplace
$commitlisted $row $row]
4165 set kids
$children($curview,$p)
4166 set i
[lsearch
-exact $kids $id]
4168 set kids
[lreplace
$kids $i $i]
4169 set children
($curview,$p) $kids
4171 set l
[llength
$displayorder]
4172 for {set r
$row} {$r < $l} {incr r
} {
4173 set id
[lindex
$displayorder $r]
4174 set commitrow
($curview,$id) $r
4176 incr commitidx
($curview) -1
4178 if {$row < [llength
$rowidlist]} {
4179 set rowidlist
[lreplace
$rowidlist $row $row]
4180 set rowisopt
[lreplace
$rowisopt $row $row]
4181 set rowfinal
[lreplace
$rowfinal $row $row]
4186 if {[info exists selectedline
] && $selectedline > $row} {
4187 incr selectedline
-1
4192 # Don't change the text pane cursor if it is currently the hand cursor,
4193 # showing that we are over a sha1 ID link.
4194 proc settextcursor
{c
} {
4195 global ctext curtextcursor
4197 if {[$ctext cget
-cursor] == $curtextcursor} {
4198 $ctext config
-cursor $c
4200 set curtextcursor
$c
4203 proc nowbusy
{what
{name
{}}} {
4204 global isbusy busyname statusw
4206 if {[array names isbusy
] eq
{}} {
4207 . config
-cursor watch
4211 set busyname
($what) $name
4213 $statusw conf
-text $name
4217 proc notbusy
{what
} {
4218 global isbusy maincursor textcursor busyname statusw
4222 if {$busyname($what) ne
{} &&
4223 [$statusw cget
-text] eq
$busyname($what)} {
4224 $statusw conf
-text {}
4227 if {[array names isbusy
] eq
{}} {
4228 . config
-cursor $maincursor
4229 settextcursor
$textcursor
4233 proc findmatches
{f
} {
4234 global findtype findstring
4235 if {$findtype == [mc
"Regexp"]} {
4236 set matches
[regexp
-indices -all -inline $findstring $f]
4239 if {$findtype == [mc
"IgnCase"]} {
4240 set f
[string tolower
$f]
4241 set fs
[string tolower
$fs]
4245 set l
[string length
$fs]
4246 while {[set j
[string first
$fs $f $i]] >= 0} {
4247 lappend matches
[list
$j [expr {$j+$l-1}]]
4248 set i
[expr {$j + $l}]
4254 proc dofind
{{dirn
1} {wrap
1}} {
4255 global findstring findstartline findcurline selectedline numcommits
4256 global gdttype filehighlight fh_serial find_dirn findallowwrap
4258 if {[info exists find_dirn
]} {
4259 if {$find_dirn == $dirn} return
4263 if {$findstring eq
{} ||
$numcommits == 0} return
4264 if {![info exists selectedline
]} {
4265 set findstartline
[lindex
[visiblerows
] [expr {$dirn < 0}]]
4267 set findstartline
$selectedline
4269 set findcurline
$findstartline
4270 nowbusy finding
[mc
"Searching"]
4271 if {$gdttype ne
[mc
"containing:"] && ![info exists filehighlight
]} {
4272 after cancel do_file_hl
$fh_serial
4273 do_file_hl
$fh_serial
4276 set findallowwrap
$wrap
4280 proc stopfinding
{} {
4281 global find_dirn findcurline fprogcoord
4283 if {[info exists find_dirn
]} {
4293 global commitdata commitinfo numcommits findpattern findloc
4294 global findstartline findcurline displayorder
4295 global find_dirn gdttype fhighlights fprogcoord
4296 global findallowwrap
4298 if {![info exists find_dirn
]} {
4301 set fldtypes
[list
[mc
"Headline"] [mc
"Author"] [mc
"Date"] [mc
"Committer"] [mc
"CDate"] [mc
"Comments"]]
4304 if {$find_dirn > 0} {
4306 if {$l >= $numcommits} {
4309 if {$l <= $findstartline} {
4310 set lim
[expr {$findstartline + 1}]
4313 set moretodo
$findallowwrap
4320 if {$l >= $findstartline} {
4321 set lim
[expr {$findstartline - 1}]
4324 set moretodo
$findallowwrap
4327 set n
[expr {($lim - $l) * $find_dirn}]
4334 if {$gdttype eq
[mc
"containing:"]} {
4335 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4336 set id
[lindex
$displayorder $l]
4337 # shouldn't happen unless git log doesn't give all the commits...
4338 if {![info exists commitdata
($id)]} continue
4339 if {![doesmatch
$commitdata($id)]} continue
4340 if {![info exists commitinfo
($id)]} {
4343 set info
$commitinfo($id)
4344 foreach f
$info ty
$fldtypes {
4345 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
4354 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4355 set id
[lindex
$displayorder $l]
4356 if {![info exists fhighlights
($l)]} {
4357 askfilehighlight
$l $id
4360 set findcurline
[expr {$l - $find_dirn}]
4362 } elseif
{$fhighlights($l)} {
4368 if {$found ||
($domore && !$moretodo)} {
4384 set findcurline
[expr {$l - $find_dirn}]
4386 set n
[expr {($findcurline - $findstartline) * $find_dirn - 1}]
4390 set fprogcoord
[expr {$n * 1.0 / $numcommits}]
4395 proc findselectline
{l
} {
4396 global findloc commentend ctext findcurline markingmatches gdttype
4398 set markingmatches
1
4401 if {$findloc == [mc
"All fields"] ||
$findloc == [mc
"Comments"]} {
4402 # highlight the matches in the comments
4403 set f
[$ctext get
1.0 $commentend]
4404 set matches
[findmatches
$f]
4405 foreach match
$matches {
4406 set start
[lindex
$match 0]
4407 set end
[expr {[lindex
$match 1] + 1}]
4408 $ctext tag add found
"1.0 + $start c" "1.0 + $end c"
4414 # mark the bits of a headline or author that match a find string
4415 proc markmatches
{canv l str tag matches font row
} {
4418 set bbox
[$canv bbox
$tag]
4419 set x0
[lindex
$bbox 0]
4420 set y0
[lindex
$bbox 1]
4421 set y1
[lindex
$bbox 3]
4422 foreach match
$matches {
4423 set start
[lindex
$match 0]
4424 set end
[lindex
$match 1]
4425 if {$start > $end} continue
4426 set xoff
[font measure
$font [string range
$str 0 [expr {$start-1}]]]
4427 set xlen
[font measure
$font [string range
$str 0 [expr {$end}]]]
4428 set t
[$canv create rect
[expr {$x0+$xoff}] $y0 \
4429 [expr {$x0+$xlen+2}] $y1 \
4430 -outline {} -tags [list match
$l matches
] -fill yellow
]
4432 if {[info exists selectedline
] && $row == $selectedline} {
4433 $canv raise
$t secsel
4438 proc unmarkmatches
{} {
4439 global markingmatches
4441 allcanvs delete matches
4442 set markingmatches
0
4446 proc selcanvline
{w x y
} {
4447 global canv canvy0 ctext linespc
4449 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4450 if {$ymax == {}} return
4451 set yfrac
[lindex
[$canv yview
] 0]
4452 set y
[expr {$y + $yfrac * $ymax}]
4453 set l
[expr {int
(($y - $canvy0) / $linespc + 0.5)}]
4458 if {![info exists rowtextx
($l)] ||
$x < $rowtextx($l)} return
4464 proc commit_descriptor
{p
} {
4466 if {![info exists commitinfo
($p)]} {
4470 if {[llength
$commitinfo($p)] > 1} {
4471 set l
[lindex
$commitinfo($p) 0]
4476 # append some text to the ctext widget, and make any SHA1 ID
4477 # that we know about be a clickable link.
4478 proc appendwithlinks
{text tags
} {
4479 global ctext commitrow linknum curview pendinglinks
4481 set start
[$ctext index
"end - 1c"]
4482 $ctext insert end
$text $tags
4483 set links
[regexp
-indices -all -inline {[0-9a-f]{40}} $text]
4487 set linkid
[string range
$text $s $e]
4489 $ctext tag delete link
$linknum
4490 $ctext tag add link
$linknum "$start + $s c" "$start + $e c"
4491 setlink
$linkid link
$linknum
4496 proc setlink
{id lk
} {
4497 global curview commitrow ctext pendinglinks commitinterest
4499 if {[info exists commitrow
($curview,$id)]} {
4500 $ctext tag conf
$lk -foreground blue
-underline 1
4501 $ctext tag
bind $lk <1> [list selectline
$commitrow($curview,$id) 1]
4502 $ctext tag
bind $lk <Enter
> {linkcursor
%W
1}
4503 $ctext tag
bind $lk <Leave
> {linkcursor
%W
-1}
4505 lappend pendinglinks
($id) $lk
4506 lappend commitinterest
($id) {makelink
%I
}
4510 proc makelink
{id
} {
4513 if {![info exists pendinglinks
($id)]} return
4514 foreach lk
$pendinglinks($id) {
4517 unset pendinglinks
($id)
4520 proc linkcursor
{w inc
} {
4521 global linkentercount curtextcursor
4523 if {[incr linkentercount
$inc] > 0} {
4524 $w configure
-cursor hand2
4526 $w configure
-cursor $curtextcursor
4527 if {$linkentercount < 0} {
4528 set linkentercount
0
4533 proc viewnextline
{dir
} {
4537 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4538 set wnow
[$canv yview
]
4539 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4540 set newtop
[expr {$wtop + $dir * $linespc}]
4543 } elseif
{$newtop > $ymax} {
4546 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4549 # add a list of tag or branch names at position pos
4550 # returns the number of names inserted
4551 proc appendrefs
{pos ids var
} {
4552 global ctext commitrow linknum curview
$var maxrefs
4554 if {[catch
{$ctext index
$pos}]} {
4557 $ctext conf
-state normal
4558 $ctext delete
$pos "$pos lineend"
4561 foreach tag
[set $var\
($id\
)] {
4562 lappend tags
[list
$tag $id]
4565 if {[llength
$tags] > $maxrefs} {
4566 $ctext insert
$pos "many ([llength $tags])"
4568 set tags
[lsort
-index 0 -decreasing $tags]
4571 set id
[lindex
$ti 1]
4574 $ctext tag delete
$lk
4575 $ctext insert
$pos $sep
4576 $ctext insert
$pos [lindex
$ti 0] $lk
4581 $ctext conf
-state disabled
4582 return [llength
$tags]
4585 # called when we have finished computing the nearby tags
4586 proc dispneartags
{delay
} {
4587 global selectedline currentid showneartags tagphase
4589 if {![info exists selectedline
] ||
!$showneartags} return
4590 after cancel dispnexttag
4592 after
200 dispnexttag
4595 after idle dispnexttag
4600 proc dispnexttag
{} {
4601 global selectedline currentid showneartags tagphase ctext
4603 if {![info exists selectedline
] ||
!$showneartags} return
4604 switch
-- $tagphase {
4606 set dtags
[desctags
$currentid]
4608 appendrefs precedes
$dtags idtags
4612 set atags
[anctags
$currentid]
4614 appendrefs follows
$atags idtags
4618 set dheads
[descheads
$currentid]
4619 if {$dheads ne
{}} {
4620 if {[appendrefs branch
$dheads idheads
] > 1
4621 && [$ctext get
"branch -3c"] eq
"h"} {
4622 # turn "Branch" into "Branches"
4623 $ctext conf
-state normal
4624 $ctext insert
"branch -2c" "es"
4625 $ctext conf
-state disabled
4630 if {[incr tagphase
] <= 2} {
4631 after idle dispnexttag
4635 proc make_secsel
{l
} {
4636 global linehtag linentag linedtag canv canv2 canv3
4638 if {![info exists linehtag
($l)]} return
4640 set t
[eval $canv create rect
[$canv bbox
$linehtag($l)] -outline {{}} \
4641 -tags secsel
-fill [$canv cget
-selectbackground]]
4643 $canv2 delete secsel
4644 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($l)] -outline {{}} \
4645 -tags secsel
-fill [$canv2 cget
-selectbackground]]
4647 $canv3 delete secsel
4648 set t
[eval $canv3 create rect
[$canv3 bbox
$linedtag($l)] -outline {{}} \
4649 -tags secsel
-fill [$canv3 cget
-selectbackground]]
4653 proc selectline
{l isnew
} {
4654 global canv ctext commitinfo selectedline
4656 global canvy0 linespc parentlist children curview
4657 global currentid sha1entry
4658 global commentend idtags linknum
4659 global mergemax numcommits pending_select
4660 global cmitmode showneartags allcommits
4662 catch
{unset pending_select
}
4667 if {$l < 0 ||
$l >= $numcommits} return
4668 set y
[expr {$canvy0 + $l * $linespc}]
4669 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4670 set ytop
[expr {$y - $linespc - 1}]
4671 set ybot
[expr {$y + $linespc + 1}]
4672 set wnow
[$canv yview
]
4673 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4674 set wbot
[expr {[lindex
$wnow 1] * $ymax}]
4675 set wh
[expr {$wbot - $wtop}]
4677 if {$ytop < $wtop} {
4678 if {$ybot < $wtop} {
4679 set newtop
[expr {$y - $wh / 2.0}]
4682 if {$newtop > $wtop - $linespc} {
4683 set newtop
[expr {$wtop - $linespc}]
4686 } elseif
{$ybot > $wbot} {
4687 if {$ytop > $wbot} {
4688 set newtop
[expr {$y - $wh / 2.0}]
4690 set newtop
[expr {$ybot - $wh}]
4691 if {$newtop < $wtop + $linespc} {
4692 set newtop
[expr {$wtop + $linespc}]
4696 if {$newtop != $wtop} {
4700 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4707 addtohistory
[list selectline
$l 0]
4712 set id
[lindex
$displayorder $l]
4714 $sha1entry delete
0 end
4715 $sha1entry insert
0 $id
4716 $sha1entry selection from
0
4717 $sha1entry selection to end
4720 $ctext conf
-state normal
4723 set info
$commitinfo($id)
4724 set date [formatdate
[lindex
$info 2]]
4725 $ctext insert end
"[mc "Author
"]: [lindex $info 1] $date\n"
4726 set date [formatdate
[lindex
$info 4]]
4727 $ctext insert end
"[mc "Committer
"]: [lindex $info 3] $date\n"
4728 if {[info exists idtags
($id)]} {
4729 $ctext insert end
[mc
"Tags:"]
4730 foreach tag
$idtags($id) {
4731 $ctext insert end
" $tag"
4733 $ctext insert end
"\n"
4737 set olds
[lindex
$parentlist $l]
4738 if {[llength
$olds] > 1} {
4741 if {$np >= $mergemax} {
4746 $ctext insert end
"[mc "Parent
"]: " $tag
4747 appendwithlinks
[commit_descriptor
$p] {}
4752 append headers
"[mc "Parent
"]: [commit_descriptor $p]"
4756 foreach c
$children($curview,$id) {
4757 append headers
"[mc "Child
"]: [commit_descriptor $c]"
4760 # make anything that looks like a SHA1 ID be a clickable link
4761 appendwithlinks
$headers {}
4762 if {$showneartags} {
4763 if {![info exists allcommits
]} {
4766 $ctext insert end
"[mc "Branch
"]: "
4767 $ctext mark
set branch
"end -1c"
4768 $ctext mark gravity branch left
4769 $ctext insert end
"\n[mc "Follows
"]: "
4770 $ctext mark
set follows
"end -1c"
4771 $ctext mark gravity follows left
4772 $ctext insert end
"\n[mc "Precedes
"]: "
4773 $ctext mark
set precedes
"end -1c"
4774 $ctext mark gravity precedes left
4775 $ctext insert end
"\n"
4778 $ctext insert end
"\n"
4779 set comment
[lindex
$info 5]
4780 if {[string first
"\r" $comment] >= 0} {
4781 set comment
[string map
{"\r" "\n "} $comment]
4783 appendwithlinks
$comment {comment
}
4785 $ctext tag remove found
1.0 end
4786 $ctext conf
-state disabled
4787 set commentend
[$ctext index
"end - 1c"]
4789 init_flist
[mc
"Comments"]
4790 if {$cmitmode eq
"tree"} {
4792 } elseif
{[llength
$olds] <= 1} {
4799 proc selfirstline
{} {
4804 proc sellastline
{} {
4807 set l
[expr {$numcommits - 1}]
4811 proc selnextline
{dir
} {
4814 if {![info exists selectedline
]} return
4815 set l
[expr {$selectedline + $dir}]
4820 proc selnextpage
{dir
} {
4821 global canv linespc selectedline numcommits
4823 set lpp
[expr {([winfo height
$canv] - 2) / $linespc}]
4827 allcanvs yview scroll
[expr {$dir * $lpp}] units
4829 if {![info exists selectedline
]} return
4830 set l
[expr {$selectedline + $dir * $lpp}]
4833 } elseif
{$l >= $numcommits} {
4834 set l
[expr $numcommits - 1]
4840 proc unselectline
{} {
4841 global selectedline currentid
4843 catch
{unset selectedline
}
4844 catch
{unset currentid
}
4845 allcanvs delete secsel
4849 proc reselectline
{} {
4852 if {[info exists selectedline
]} {
4853 selectline
$selectedline 0
4857 proc addtohistory
{cmd
} {
4858 global
history historyindex curview
4860 set elt
[list
$curview $cmd]
4861 if {$historyindex > 0
4862 && [lindex
$history [expr {$historyindex - 1}]] == $elt} {
4866 if {$historyindex < [llength
$history]} {
4867 set history [lreplace
$history $historyindex end
$elt]
4869 lappend
history $elt
4872 if {$historyindex > 1} {
4873 .tf.bar.leftbut conf
-state normal
4875 .tf.bar.leftbut conf
-state disabled
4877 .tf.bar.rightbut conf
-state disabled
4883 set view
[lindex
$elt 0]
4884 set cmd
[lindex
$elt 1]
4885 if {$curview != $view} {
4892 global
history historyindex
4895 if {$historyindex > 1} {
4896 incr historyindex
-1
4897 godo
[lindex
$history [expr {$historyindex - 1}]]
4898 .tf.bar.rightbut conf
-state normal
4900 if {$historyindex <= 1} {
4901 .tf.bar.leftbut conf
-state disabled
4906 global
history historyindex
4909 if {$historyindex < [llength
$history]} {
4910 set cmd
[lindex
$history $historyindex]
4913 .tf.bar.leftbut conf
-state normal
4915 if {$historyindex >= [llength
$history]} {
4916 .tf.bar.rightbut conf
-state disabled
4921 global treefilelist treeidlist diffids diffmergeid treepending
4922 global nullid nullid2
4925 catch
{unset diffmergeid
}
4926 if {![info exists treefilelist
($id)]} {
4927 if {![info exists treepending
]} {
4928 if {$id eq
$nullid} {
4929 set cmd
[list | git ls-files
]
4930 } elseif
{$id eq
$nullid2} {
4931 set cmd
[list | git ls-files
--stage -t]
4933 set cmd
[list | git ls-tree
-r $id]
4935 if {[catch
{set gtf
[open
$cmd r
]}]} {
4939 set treefilelist
($id) {}
4940 set treeidlist
($id) {}
4941 fconfigure
$gtf -blocking 0
4942 filerun
$gtf [list gettreeline
$gtf $id]
4949 proc gettreeline
{gtf id
} {
4950 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4953 while {[incr
nl] <= 1000 && [gets
$gtf line
] >= 0} {
4954 if {$diffids eq
$nullid} {
4957 if {$diffids ne
$nullid2 && [lindex
$line 1] ne
"blob"} continue
4958 set i
[string first
"\t" $line]
4959 if {$i < 0} continue
4960 set sha1
[lindex
$line 2]
4961 set fname
[string range
$line [expr {$i+1}] end
]
4962 if {[string index
$fname 0] eq
"\""} {
4963 set fname
[lindex
$fname 0]
4965 lappend treeidlist
($id) $sha1
4967 lappend treefilelist
($id) $fname
4970 return [expr {$nl >= 1000?
2: 1}]
4974 if {$cmitmode ne
"tree"} {
4975 if {![info exists diffmergeid
]} {
4976 gettreediffs
$diffids
4978 } elseif
{$id ne
$diffids} {
4987 global treefilelist treeidlist diffids nullid nullid2
4988 global ctext commentend
4990 set i
[lsearch
-exact $treefilelist($diffids) $f]
4992 puts
"oops, $f not in list for id $diffids"
4995 if {$diffids eq
$nullid} {
4996 if {[catch
{set bf
[open
$f r
]} err
]} {
4997 puts
"oops, can't read $f: $err"
5001 set blob
[lindex
$treeidlist($diffids) $i]
5002 if {[catch
{set bf
[open
[concat | git cat-file blob
$blob] r
]} err
]} {
5003 puts
"oops, error reading blob $blob: $err"
5007 fconfigure
$bf -blocking 0
5008 filerun
$bf [list getblobline
$bf $diffids]
5009 $ctext config
-state normal
5010 clear_ctext
$commentend
5011 $ctext insert end
"\n"
5012 $ctext insert end
"$f\n" filesep
5013 $ctext config
-state disabled
5014 $ctext yview
$commentend
5018 proc getblobline
{bf id
} {
5019 global diffids cmitmode ctext
5021 if {$id ne
$diffids ||
$cmitmode ne
"tree"} {
5025 $ctext config
-state normal
5027 while {[incr
nl] <= 1000 && [gets
$bf line
] >= 0} {
5028 $ctext insert end
"$line\n"
5031 # delete last newline
5032 $ctext delete
"end - 2c" "end - 1c"
5036 $ctext config
-state disabled
5037 return [expr {$nl >= 1000?
2: 1}]
5040 proc mergediff
{id l
} {
5041 global diffmergeid mdifffd
5045 global limitdiffs viewfiles curview
5049 # this doesn't seem to actually affect anything...
5050 set cmd
[concat | git diff-tree
--no-commit-id --cc -U$diffcontext $id]
5051 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5052 set cmd
[concat
$cmd -- $viewfiles($curview)]
5054 if {[catch
{set mdf
[open
$cmd r
]} err
]} {
5055 error_popup
"[mc "Error getting merge diffs
:"] $err"
5058 fconfigure
$mdf -blocking 0
5059 set mdifffd
($id) $mdf
5060 set np
[llength
[lindex
$parentlist $l]]
5062 filerun
$mdf [list getmergediffline
$mdf $id $np]
5065 proc getmergediffline
{mdf id np
} {
5066 global diffmergeid ctext cflist mergemax
5067 global difffilestart mdifffd
5069 $ctext conf
-state normal
5071 while {[incr nr
] <= 1000 && [gets
$mdf line
] >= 0} {
5072 if {![info exists diffmergeid
] ||
$id != $diffmergeid
5073 ||
$mdf != $mdifffd($id)} {
5077 if {[regexp
{^
diff --cc (.
*)} $line match fname
]} {
5078 # start of a new file
5079 $ctext insert end
"\n"
5080 set here
[$ctext index
"end - 1c"]
5081 lappend difffilestart
$here
5082 add_flist
[list
$fname]
5083 set l
[expr {(78 - [string length
$fname]) / 2}]
5084 set pad
[string range
"----------------------------------------" 1 $l]
5085 $ctext insert end
"$pad $fname $pad\n" filesep
5086 } elseif
{[regexp
{^@@
} $line]} {
5087 $ctext insert end
"$line\n" hunksep
5088 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $line] ||
[regexp
{^index
} $line]} {
5091 # parse the prefix - one ' ', '-' or '+' for each parent
5096 for {set j
0} {$j < $np} {incr j
} {
5097 set c
[string range
$line $j $j]
5100 } elseif
{$c == "-"} {
5102 } elseif
{$c == "+"} {
5111 if {!$isbad && $minuses ne
{} && $pluses eq
{}} {
5112 # line doesn't appear in result, parents in $minuses have the line
5113 set num
[lindex
$minuses 0]
5114 } elseif
{!$isbad && $pluses ne
{} && $minuses eq
{}} {
5115 # line appears in result, parents in $pluses don't have the line
5116 lappend tags mresult
5117 set num
[lindex
$spaces 0]
5120 if {$num >= $mergemax} {
5125 $ctext insert end
"$line\n" $tags
5128 $ctext conf
-state disabled
5133 return [expr {$nr >= 1000?
2: 1}]
5136 proc startdiff
{ids
} {
5137 global treediffs diffids treepending diffmergeid nullid nullid2
5141 catch
{unset diffmergeid
}
5142 if {![info exists treediffs
($ids)] ||
5143 [lsearch
-exact $ids $nullid] >= 0 ||
5144 [lsearch
-exact $ids $nullid2] >= 0} {
5145 if {![info exists treepending
]} {
5153 proc path_filter
{filter name
} {
5155 set l
[string length
$p]
5156 if {[string index
$p end
] eq
"/"} {
5157 if {[string compare
-length $l $p $name] == 0} {
5161 if {[string compare
-length $l $p $name] == 0 &&
5162 ([string length
$name] == $l ||
5163 [string index
$name $l] eq
"/")} {
5171 proc addtocflist
{ids
} {
5174 add_flist
$treediffs($ids)
5178 proc diffcmd
{ids flags
} {
5179 global nullid nullid2
5181 set i
[lsearch
-exact $ids $nullid]
5182 set j
[lsearch
-exact $ids $nullid2]
5184 if {[llength
$ids] > 1 && $j < 0} {
5185 # comparing working directory with some specific revision
5186 set cmd
[concat | git diff-index
$flags]
5188 lappend cmd
-R [lindex
$ids 1]
5190 lappend cmd
[lindex
$ids 0]
5193 # comparing working directory with index
5194 set cmd
[concat | git diff-files
$flags]
5199 } elseif
{$j >= 0} {
5200 set cmd
[concat | git diff-index
--cached $flags]
5201 if {[llength
$ids] > 1} {
5202 # comparing index with specific revision
5204 lappend cmd
-R [lindex
$ids 1]
5206 lappend cmd
[lindex
$ids 0]
5209 # comparing index with HEAD
5213 set cmd
[concat | git diff-tree
-r $flags $ids]
5218 proc gettreediffs
{ids
} {
5219 global treediff treepending
5221 set treepending
$ids
5223 if {[catch
{set gdtf
[open
[diffcmd
$ids {--no-commit-id}] r
]}]} return
5224 fconfigure
$gdtf -blocking 0
5225 filerun
$gdtf [list gettreediffline
$gdtf $ids]
5228 proc gettreediffline
{gdtf ids
} {
5229 global treediff treediffs treepending diffids diffmergeid
5230 global cmitmode viewfiles curview limitdiffs
5233 while {[incr nr
] <= 1000 && [gets
$gdtf line
] >= 0} {
5234 set i
[string first
"\t" $line]
5236 set file [string range
$line [expr {$i+1}] end
]
5237 if {[string index
$file 0] eq
"\""} {
5238 set file [lindex
$file 0]
5240 lappend treediff
$file
5244 return [expr {$nr >= 1000?
2: 1}]
5247 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5249 foreach f
$treediff {
5250 if {[path_filter
$viewfiles($curview) $f]} {
5254 set treediffs
($ids) $flist
5256 set treediffs
($ids) $treediff
5259 if {$cmitmode eq
"tree"} {
5261 } elseif
{$ids != $diffids} {
5262 if {![info exists diffmergeid
]} {
5263 gettreediffs
$diffids
5271 # empty string or positive integer
5272 proc diffcontextvalidate
{v
} {
5273 return [regexp
{^
(|
[1-9][0-9]*)$
} $v]
5276 proc diffcontextchange
{n1 n2 op
} {
5277 global diffcontextstring diffcontext
5279 if {[string is integer
-strict $diffcontextstring]} {
5280 if {$diffcontextstring > 0} {
5281 set diffcontext
$diffcontextstring
5287 proc changeignorespace
{} {
5291 proc getblobdiffs
{ids
} {
5292 global blobdifffd diffids env
5293 global diffinhdr treediffs
5296 global limitdiffs viewfiles curview
5298 set cmd
[diffcmd
$ids "-p -C --no-commit-id -U$diffcontext"]
5302 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5303 set cmd
[concat
$cmd -- $viewfiles($curview)]
5305 if {[catch
{set bdf
[open
$cmd r
]} err
]} {
5306 puts
"error getting diffs: $err"
5310 fconfigure
$bdf -blocking 0
5311 set blobdifffd
($ids) $bdf
5312 filerun
$bdf [list getblobdiffline
$bdf $diffids]
5315 proc setinlist
{var i val
} {
5318 while {[llength
[set $var]] < $i} {
5321 if {[llength
[set $var]] == $i} {
5328 proc makediffhdr
{fname ids
} {
5329 global ctext curdiffstart treediffs
5331 set i
[lsearch
-exact $treediffs($ids) $fname]
5333 setinlist difffilestart
$i $curdiffstart
5335 set l
[expr {(78 - [string length
$fname]) / 2}]
5336 set pad
[string range
"----------------------------------------" 1 $l]
5337 $ctext insert
$curdiffstart "$pad $fname $pad" filesep
5340 proc getblobdiffline
{bdf ids
} {
5341 global diffids blobdifffd ctext curdiffstart
5342 global diffnexthead diffnextnote difffilestart
5343 global diffinhdr treediffs
5346 $ctext conf
-state normal
5347 while {[incr nr
] <= 1000 && [gets
$bdf line
] >= 0} {
5348 if {$ids != $diffids ||
$bdf != $blobdifffd($ids)} {
5352 if {![string compare
-length 11 "diff --git " $line]} {
5353 # trim off "diff --git "
5354 set line
[string range
$line 11 end
]
5356 # start of a new file
5357 $ctext insert end
"\n"
5358 set curdiffstart
[$ctext index
"end - 1c"]
5359 $ctext insert end
"\n" filesep
5360 # If the name hasn't changed the length will be odd,
5361 # the middle char will be a space, and the two bits either
5362 # side will be a/name and b/name, or "a/name" and "b/name".
5363 # If the name has changed we'll get "rename from" and
5364 # "rename to" or "copy from" and "copy to" lines following this,
5365 # and we'll use them to get the filenames.
5366 # This complexity is necessary because spaces in the filename(s)
5367 # don't get escaped.
5368 set l
[string length
$line]
5369 set i
[expr {$l / 2}]
5370 if {!(($l & 1) && [string index
$line $i] eq
" " &&
5371 [string range
$line 2 [expr {$i - 1}]] eq \
5372 [string range
$line [expr {$i + 3}] end
])} {
5375 # unescape if quoted and chop off the a/ from the front
5376 if {[string index
$line 0] eq
"\""} {
5377 set fname
[string range
[lindex
$line 0] 2 end
]
5379 set fname
[string range
$line 2 [expr {$i - 1}]]
5381 makediffhdr
$fname $ids
5383 } elseif
{[regexp
{^@@
-([0-9]+)(,[0-9]+)? \
+([0-9]+)(,[0-9]+)? @@
(.
*)} \
5384 $line match f1l f1c f2l f2c rest
]} {
5385 $ctext insert end
"$line\n" hunksep
5388 } elseif
{$diffinhdr} {
5389 if {![string compare
-length 12 "rename from " $line]} {
5390 set fname
[string range
$line [expr 6 + [string first
" from " $line] ] end
]
5391 if {[string index
$fname 0] eq
"\""} {
5392 set fname
[lindex
$fname 0]
5394 set i
[lsearch
-exact $treediffs($ids) $fname]
5396 setinlist difffilestart
$i $curdiffstart
5398 } elseif
{![string compare
-length 10 $line "rename to "] ||
5399 ![string compare
-length 8 $line "copy to "]} {
5400 set fname
[string range
$line [expr 4 + [string first
" to " $line] ] end
]
5401 if {[string index
$fname 0] eq
"\""} {
5402 set fname
[lindex
$fname 0]
5404 makediffhdr
$fname $ids
5405 } elseif
{[string compare
-length 3 $line "---"] == 0} {
5408 } elseif
{[string compare
-length 3 $line "+++"] == 0} {
5412 $ctext insert end
"$line\n" filesep
5415 set x
[string range
$line 0 0]
5416 if {$x == "-" ||
$x == "+"} {
5417 set tag
[expr {$x == "+"}]
5418 $ctext insert end
"$line\n" d
$tag
5419 } elseif
{$x == " "} {
5420 $ctext insert end
"$line\n"
5422 # "\ No newline at end of file",
5423 # or something else we don't recognize
5424 $ctext insert end
"$line\n" hunksep
5428 $ctext conf
-state disabled
5433 return [expr {$nr >= 1000?
2: 1}]
5436 proc changediffdisp
{} {
5437 global ctext diffelide
5439 $ctext tag conf d0
-elide [lindex
$diffelide 0]
5440 $ctext tag conf d1
-elide [lindex
$diffelide 1]
5444 global difffilestart ctext
5445 set prev
[lindex
$difffilestart 0]
5446 set here
[$ctext index @
0,0]
5447 foreach loc
$difffilestart {
5448 if {[$ctext compare
$loc >= $here]} {
5458 global difffilestart ctext
5459 set here
[$ctext index @
0,0]
5460 foreach loc
$difffilestart {
5461 if {[$ctext compare
$loc > $here]} {
5468 proc clear_ctext
{{first
1.0}} {
5469 global ctext smarktop smarkbot
5472 set l
[lindex
[split $first .
] 0]
5473 if {![info exists smarktop
] ||
[$ctext compare
$first < $smarktop.0]} {
5476 if {![info exists smarkbot
] ||
[$ctext compare
$first < $smarkbot.0]} {
5479 $ctext delete
$first end
5480 if {$first eq
"1.0"} {
5481 catch
{unset pendinglinks
}
5485 proc settabs
{{firstab
{}}} {
5486 global firsttabstop tabstop ctext have_tk85
5488 if {$firstab ne
{} && $have_tk85} {
5489 set firsttabstop
$firstab
5491 set w
[font measure textfont
"0"]
5492 if {$firsttabstop != 0} {
5493 $ctext conf
-tabs [list
[expr {($firsttabstop + $tabstop) * $w}] \
5494 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5495 } elseif
{$have_tk85 ||
$tabstop != 8} {
5496 $ctext conf
-tabs [expr {$tabstop * $w}]
5498 $ctext conf
-tabs {}
5502 proc incrsearch
{name ix op
} {
5503 global ctext searchstring searchdirn
5505 $ctext tag remove found
1.0 end
5506 if {[catch
{$ctext index anchor
}]} {
5507 # no anchor set, use start of selection, or of visible area
5508 set sel
[$ctext tag ranges sel
]
5510 $ctext mark
set anchor
[lindex
$sel 0]
5511 } elseif
{$searchdirn eq
"-forwards"} {
5512 $ctext mark
set anchor @
0,0
5514 $ctext mark
set anchor @
0,[winfo height
$ctext]
5517 if {$searchstring ne
{}} {
5518 set here
[$ctext search
$searchdirn -- $searchstring anchor
]
5527 global sstring ctext searchstring searchdirn
5530 $sstring icursor end
5531 set searchdirn
-forwards
5532 if {$searchstring ne
{}} {
5533 set sel
[$ctext tag ranges sel
]
5535 set start
"[lindex $sel 0] + 1c"
5536 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5539 set match
[$ctext search
-count mlen
-- $searchstring $start]
5540 $ctext tag remove sel
1.0 end
5546 set mend
"$match + $mlen c"
5547 $ctext tag add sel
$match $mend
5548 $ctext mark
unset anchor
5552 proc dosearchback
{} {
5553 global sstring ctext searchstring searchdirn
5556 $sstring icursor end
5557 set searchdirn
-backwards
5558 if {$searchstring ne
{}} {
5559 set sel
[$ctext tag ranges sel
]
5561 set start
[lindex
$sel 0]
5562 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5563 set start @
0,[winfo height
$ctext]
5565 set match
[$ctext search
-backwards -count ml
-- $searchstring $start]
5566 $ctext tag remove sel
1.0 end
5572 set mend
"$match + $ml c"
5573 $ctext tag add sel
$match $mend
5574 $ctext mark
unset anchor
5578 proc searchmark
{first last
} {
5579 global ctext searchstring
5583 set match
[$ctext search
-count mlen
-- $searchstring $mend $last.end
]
5584 if {$match eq
{}} break
5585 set mend
"$match + $mlen c"
5586 $ctext tag add found
$match $mend
5590 proc searchmarkvisible
{doall
} {
5591 global ctext smarktop smarkbot
5593 set topline
[lindex
[split [$ctext index @
0,0] .
] 0]
5594 set botline
[lindex
[split [$ctext index @
0,[winfo height
$ctext]] .
] 0]
5595 if {$doall ||
$botline < $smarktop ||
$topline > $smarkbot} {
5596 # no overlap with previous
5597 searchmark
$topline $botline
5598 set smarktop
$topline
5599 set smarkbot
$botline
5601 if {$topline < $smarktop} {
5602 searchmark
$topline [expr {$smarktop-1}]
5603 set smarktop
$topline
5605 if {$botline > $smarkbot} {
5606 searchmark
[expr {$smarkbot+1}] $botline
5607 set smarkbot
$botline
5612 proc scrolltext
{f0 f1
} {
5615 .bleft.sb
set $f0 $f1
5616 if {$searchstring ne
{}} {
5622 global linespc charspc canvx0 canvy0
5623 global xspc1 xspc2 lthickness
5625 set linespc
[font metrics mainfont
-linespace]
5626 set charspc
[font measure mainfont
"m"]
5627 set canvy0
[expr {int
(3 + 0.5 * $linespc)}]
5628 set canvx0
[expr {int
(3 + 0.5 * $linespc)}]
5629 set lthickness
[expr {int
($linespc / 9) + 1}]
5630 set xspc1
(0) $linespc
5638 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5639 if {$ymax eq
{} ||
$ymax == 0} return
5640 set span
[$canv yview
]
5643 allcanvs yview moveto
[lindex
$span 0]
5645 if {[info exists selectedline
]} {
5646 selectline
$selectedline 0
5647 allcanvs yview moveto
[lindex
$span 0]
5651 proc parsefont
{f n
} {
5654 set fontattr
($f,family
) [lindex
$n 0]
5656 if {$s eq
{} ||
$s == 0} {
5659 set s
[expr {int
(-$s / [winfo fpixels .
1p
] + 0.5)}]
5661 set fontattr
($f,size
) $s
5662 set fontattr
($f,weight
) normal
5663 set fontattr
($f,slant
) roman
5664 foreach style
[lrange
$n 2 end
] {
5667 "bold" {set fontattr
($f,weight
) $style}
5669 "italic" {set fontattr
($f,slant
) $style}
5674 proc fontflags
{f
{isbold
0}} {
5677 return [list
-family $fontattr($f,family
) -size $fontattr($f,size
) \
5678 -weight [expr {$isbold?
"bold": $fontattr($f,weight
)}] \
5679 -slant $fontattr($f,slant
)]
5685 set n
[list
$fontattr($f,family
) $fontattr($f,size
)]
5686 if {$fontattr($f,weight
) eq
"bold"} {
5689 if {$fontattr($f,slant
) eq
"italic"} {
5695 proc incrfont
{inc
} {
5696 global mainfont textfont ctext canv phase cflist showrefstop
5697 global stopped entries fontattr
5700 set s
$fontattr(mainfont
,size
)
5705 set fontattr
(mainfont
,size
) $s
5706 font config mainfont
-size $s
5707 font config mainfontbold
-size $s
5708 set mainfont
[fontname mainfont
]
5709 set s
$fontattr(textfont
,size
)
5714 set fontattr
(textfont
,size
) $s
5715 font config textfont
-size $s
5716 font config textfontbold
-size $s
5717 set textfont
[fontname textfont
]
5724 global sha1entry sha1string
5725 if {[string length
$sha1string] == 40} {
5726 $sha1entry delete
0 end
5730 proc sha1change
{n1 n2 op
} {
5731 global sha1string currentid sha1but
5732 if {$sha1string == {}
5733 ||
([info exists currentid
] && $sha1string == $currentid)} {
5738 if {[$sha1but cget
-state] == $state} return
5739 if {$state == "normal"} {
5740 $sha1but conf
-state normal
-relief raised
-text "[mc "Goto
:"] "
5742 $sha1but conf
-state disabled
-relief flat
-text "[mc "SHA1 ID
:"] "
5746 proc gotocommit
{} {
5747 global sha1string currentid commitrow tagids headids
5748 global displayorder numcommits curview
5750 if {$sha1string == {}
5751 ||
([info exists currentid
] && $sha1string == $currentid)} return
5752 if {[info exists tagids
($sha1string)]} {
5753 set id
$tagids($sha1string)
5754 } elseif
{[info exists headids
($sha1string)]} {
5755 set id
$headids($sha1string)
5757 set id
[string tolower
$sha1string]
5758 if {[regexp
{^
[0-9a-f]{4,39}$
} $id]} {
5760 foreach i
$displayorder {
5761 if {[string match
$id* $i]} {
5765 if {$matches ne
{}} {
5766 if {[llength
$matches] > 1} {
5767 error_popup
[mc
"Short SHA1 id %s is ambiguous" $id]
5770 set id
[lindex
$matches 0]
5774 if {[info exists commitrow
($curview,$id)]} {
5775 selectline
$commitrow($curview,$id) 1
5778 if {[regexp
{^
[0-9a-fA-F]{4,}$
} $sha1string]} {
5779 set msg
[mc
"SHA1 id %s is not known" $sha1string]
5781 set msg
[mc
"Tag/Head %s is not known" $sha1string]
5786 proc lineenter
{x y id
} {
5787 global hoverx hovery hoverid hovertimer
5788 global commitinfo canv
5790 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5794 if {[info exists hovertimer
]} {
5795 after cancel
$hovertimer
5797 set hovertimer
[after
500 linehover
]
5801 proc linemotion
{x y id
} {
5802 global hoverx hovery hoverid hovertimer
5804 if {[info exists hoverid
] && $id == $hoverid} {
5807 if {[info exists hovertimer
]} {
5808 after cancel
$hovertimer
5810 set hovertimer
[after
500 linehover
]
5814 proc lineleave
{id
} {
5815 global hoverid hovertimer canv
5817 if {[info exists hoverid
] && $id == $hoverid} {
5819 if {[info exists hovertimer
]} {
5820 after cancel
$hovertimer
5828 global hoverx hovery hoverid hovertimer
5829 global canv linespc lthickness
5832 set text
[lindex
$commitinfo($hoverid) 0]
5833 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5834 if {$ymax == {}} return
5835 set yfrac
[lindex
[$canv yview
] 0]
5836 set x
[expr {$hoverx + 2 * $linespc}]
5837 set y
[expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5838 set x0
[expr {$x - 2 * $lthickness}]
5839 set y0
[expr {$y - 2 * $lthickness}]
5840 set x1
[expr {$x + [font measure mainfont
$text] + 2 * $lthickness}]
5841 set y1
[expr {$y + $linespc + 2 * $lthickness}]
5842 set t
[$canv create rectangle
$x0 $y0 $x1 $y1 \
5843 -fill \
#ffff80 -outline black -width 1 -tags hover]
5845 set t
[$canv create text
$x $y -anchor nw
-text $text -tags hover \
5850 proc clickisonarrow
{id y
} {
5853 set ranges
[rowranges
$id]
5854 set thresh
[expr {2 * $lthickness + 6}]
5855 set n
[expr {[llength
$ranges] - 1}]
5856 for {set i
1} {$i < $n} {incr i
} {
5857 set row
[lindex
$ranges $i]
5858 if {abs
([yc
$row] - $y) < $thresh} {
5865 proc arrowjump
{id n y
} {
5868 # 1 <-> 2, 3 <-> 4, etc...
5869 set n
[expr {(($n - 1) ^
1) + 1}]
5870 set row
[lindex
[rowranges
$id] $n]
5872 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5873 if {$ymax eq
{} ||
$ymax <= 0} return
5874 set view
[$canv yview
]
5875 set yspan
[expr {[lindex
$view 1] - [lindex
$view 0]}]
5876 set yfrac
[expr {$yt / $ymax - $yspan / 2}]
5880 allcanvs yview moveto
$yfrac
5883 proc lineclick
{x y id isnew
} {
5884 global ctext commitinfo children canv thickerline curview commitrow
5886 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5891 # draw this line thicker than normal
5895 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5896 if {$ymax eq
{}} return
5897 set yfrac
[lindex
[$canv yview
] 0]
5898 set y
[expr {$y + $yfrac * $ymax}]
5900 set dirn
[clickisonarrow
$id $y]
5902 arrowjump
$id $dirn $y
5907 addtohistory
[list lineclick
$x $y $id 0]
5909 # fill the details pane with info about this line
5910 $ctext conf
-state normal
5913 $ctext insert end
"[mc "Parent
"]:\t"
5914 $ctext insert end
$id link0
5916 set info
$commitinfo($id)
5917 $ctext insert end
"\n\t[lindex $info 0]\n"
5918 $ctext insert end
"\t[mc "Author
"]:\t[lindex $info 1]\n"
5919 set date [formatdate
[lindex
$info 2]]
5920 $ctext insert end
"\t[mc "Date
"]:\t$date\n"
5921 set kids
$children($curview,$id)
5923 $ctext insert end
"\n[mc "Children
"]:"
5925 foreach child
$kids {
5927 if {![info exists commitinfo
($child)] && ![getcommit
$child]} continue
5928 set info
$commitinfo($child)
5929 $ctext insert end
"\n\t"
5930 $ctext insert end
$child link
$i
5931 setlink
$child link
$i
5932 $ctext insert end
"\n\t[lindex $info 0]"
5933 $ctext insert end
"\n\t[mc "Author
"]:\t[lindex $info 1]"
5934 set date [formatdate
[lindex
$info 2]]
5935 $ctext insert end
"\n\t[mc "Date
"]:\t$date\n"
5938 $ctext conf
-state disabled
5942 proc normalline
{} {
5944 if {[info exists thickerline
]} {
5952 global commitrow curview
5953 if {[info exists commitrow
($curview,$id)]} {
5954 selectline
$commitrow($curview,$id) 1
5960 if {![info exists startmstime
]} {
5961 set startmstime
[clock clicks
-milliseconds]
5963 return [format
"%.3f" [expr {([clock click
-milliseconds] - $startmstime) / 1000.0}]]
5966 proc rowmenu
{x y id
} {
5967 global rowctxmenu commitrow selectedline rowmenuid curview
5968 global nullid nullid2 fakerowmenu mainhead
5972 if {![info exists selectedline
]
5973 ||
$commitrow($curview,$id) eq
$selectedline} {
5978 if {$id ne
$nullid && $id ne
$nullid2} {
5979 set menu
$rowctxmenu
5980 $menu entryconfigure
7 -label [mc
"Reset %s branch to here" $mainhead]
5982 set menu
$fakerowmenu
5984 $menu entryconfigure
[mc
"Diff this -> selected"] -state $state
5985 $menu entryconfigure
[mc
"Diff selected -> this"] -state $state
5986 $menu entryconfigure
[mc
"Make patch"] -state $state
5987 tk_popup
$menu $x $y
5990 proc diffvssel
{dirn
} {
5991 global rowmenuid selectedline displayorder
5993 if {![info exists selectedline
]} return
5995 set oldid
[lindex
$displayorder $selectedline]
5996 set newid
$rowmenuid
5998 set oldid
$rowmenuid
5999 set newid
[lindex
$displayorder $selectedline]
6001 addtohistory
[list doseldiff
$oldid $newid]
6002 doseldiff
$oldid $newid
6005 proc doseldiff
{oldid newid
} {
6009 $ctext conf
-state normal
6011 init_flist
[mc
"Top"]
6012 $ctext insert end
"[mc "From
"] "
6013 $ctext insert end
$oldid link0
6014 setlink
$oldid link0
6015 $ctext insert end
"\n "
6016 $ctext insert end
[lindex
$commitinfo($oldid) 0]
6017 $ctext insert end
"\n\n[mc "To
"] "
6018 $ctext insert end
$newid link1
6019 setlink
$newid link1
6020 $ctext insert end
"\n "
6021 $ctext insert end
[lindex
$commitinfo($newid) 0]
6022 $ctext insert end
"\n"
6023 $ctext conf
-state disabled
6024 $ctext tag remove found
1.0 end
6025 startdiff
[list
$oldid $newid]
6029 global rowmenuid currentid commitinfo patchtop patchnum
6031 if {![info exists currentid
]} return
6032 set oldid
$currentid
6033 set oldhead
[lindex
$commitinfo($oldid) 0]
6034 set newid
$rowmenuid
6035 set newhead
[lindex
$commitinfo($newid) 0]
6038 catch
{destroy
$top}
6040 label
$top.title
-text [mc
"Generate patch"]
6041 grid
$top.title
- -pady 10
6042 label
$top.from
-text [mc
"From:"]
6043 entry
$top.fromsha1
-width 40 -relief flat
6044 $top.fromsha1 insert
0 $oldid
6045 $top.fromsha1 conf
-state readonly
6046 grid
$top.from
$top.fromsha1
-sticky w
6047 entry
$top.fromhead
-width 60 -relief flat
6048 $top.fromhead insert
0 $oldhead
6049 $top.fromhead conf
-state readonly
6050 grid x
$top.fromhead
-sticky w
6051 label
$top.to
-text [mc
"To:"]
6052 entry
$top.tosha1
-width 40 -relief flat
6053 $top.tosha1 insert
0 $newid
6054 $top.tosha1 conf
-state readonly
6055 grid
$top.to
$top.tosha1
-sticky w
6056 entry
$top.tohead
-width 60 -relief flat
6057 $top.tohead insert
0 $newhead
6058 $top.tohead conf
-state readonly
6059 grid x
$top.tohead
-sticky w
6060 button
$top.
rev -text [mc
"Reverse"] -command mkpatchrev
-padx 5
6061 grid
$top.
rev x
-pady 10
6062 label
$top.flab
-text [mc
"Output file:"]
6063 entry
$top.fname
-width 60
6064 $top.fname insert
0 [file normalize
"patch$patchnum.patch"]
6066 grid
$top.flab
$top.fname
-sticky w
6068 button
$top.buts.gen
-text [mc
"Generate"] -command mkpatchgo
6069 button
$top.buts.can
-text [mc
"Cancel"] -command mkpatchcan
6070 grid
$top.buts.gen
$top.buts.can
6071 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6072 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6073 grid
$top.buts
- -pady 10 -sticky ew
6077 proc mkpatchrev
{} {
6080 set oldid
[$patchtop.fromsha1 get
]
6081 set oldhead
[$patchtop.fromhead get
]
6082 set newid
[$patchtop.tosha1 get
]
6083 set newhead
[$patchtop.tohead get
]
6084 foreach e
[list fromsha1 fromhead tosha1 tohead
] \
6085 v
[list
$newid $newhead $oldid $oldhead] {
6086 $patchtop.
$e conf
-state normal
6087 $patchtop.
$e delete
0 end
6088 $patchtop.
$e insert
0 $v
6089 $patchtop.
$e conf
-state readonly
6094 global patchtop nullid nullid2
6096 set oldid
[$patchtop.fromsha1 get
]
6097 set newid
[$patchtop.tosha1 get
]
6098 set fname
[$patchtop.fname get
]
6099 set cmd
[diffcmd
[list
$oldid $newid] -p]
6100 # trim off the initial "|"
6101 set cmd
[lrange
$cmd 1 end
]
6102 lappend cmd
>$fname &
6103 if {[catch
{eval exec $cmd} err
]} {
6104 error_popup
"[mc "Error creating
patch:"] $err"
6106 catch
{destroy
$patchtop}
6110 proc mkpatchcan
{} {
6113 catch
{destroy
$patchtop}
6118 global rowmenuid mktagtop commitinfo
6122 catch
{destroy
$top}
6124 label
$top.title
-text [mc
"Create tag"]
6125 grid
$top.title
- -pady 10
6126 label
$top.id
-text [mc
"ID:"]
6127 entry
$top.sha1
-width 40 -relief flat
6128 $top.sha1 insert
0 $rowmenuid
6129 $top.sha1 conf
-state readonly
6130 grid
$top.id
$top.sha1
-sticky w
6131 entry
$top.
head -width 60 -relief flat
6132 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6133 $top.
head conf
-state readonly
6134 grid x
$top.
head -sticky w
6135 label
$top.tlab
-text [mc
"Tag name:"]
6136 entry
$top.tag
-width 60
6137 grid
$top.tlab
$top.tag
-sticky w
6139 button
$top.buts.gen
-text [mc
"Create"] -command mktaggo
6140 button
$top.buts.can
-text [mc
"Cancel"] -command mktagcan
6141 grid
$top.buts.gen
$top.buts.can
6142 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6143 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6144 grid
$top.buts
- -pady 10 -sticky ew
6149 global mktagtop env tagids idtags
6151 set id
[$mktagtop.sha1 get
]
6152 set tag
[$mktagtop.tag get
]
6154 error_popup
[mc
"No tag name specified"]
6157 if {[info exists tagids
($tag)]} {
6158 error_popup
[mc
"Tag \"%s\" already exists" $tag]
6162 exec git tag
$tag $id
6164 error_popup
"[mc "Error creating tag
:"] $err"
6168 set tagids
($tag) $id
6169 lappend idtags
($id) $tag
6176 proc redrawtags
{id
} {
6177 global canv linehtag commitrow idpos selectedline curview
6178 global canvxmax iddrawn
6180 if {![info exists commitrow
($curview,$id)]} return
6181 if {![info exists iddrawn
($id)]} return
6182 drawcommits
$commitrow($curview,$id)
6183 $canv delete tag.
$id
6184 set xt
[eval drawtags
$id $idpos($id)]
6185 $canv coords
$linehtag($commitrow($curview,$id)) $xt [lindex
$idpos($id) 2]
6186 set text
[$canv itemcget
$linehtag($commitrow($curview,$id)) -text]
6187 set xr
[expr {$xt + [font measure mainfont
$text]}]
6188 if {$xr > $canvxmax} {
6192 if {[info exists selectedline
]
6193 && $selectedline == $commitrow($curview,$id)} {
6194 selectline
$selectedline 0
6201 catch
{destroy
$mktagtop}
6210 proc writecommit
{} {
6211 global rowmenuid wrcomtop commitinfo wrcomcmd
6213 set top .writecommit
6215 catch
{destroy
$top}
6217 label
$top.title
-text [mc
"Write commit to file"]
6218 grid
$top.title
- -pady 10
6219 label
$top.id
-text [mc
"ID:"]
6220 entry
$top.sha1
-width 40 -relief flat
6221 $top.sha1 insert
0 $rowmenuid
6222 $top.sha1 conf
-state readonly
6223 grid
$top.id
$top.sha1
-sticky w
6224 entry
$top.
head -width 60 -relief flat
6225 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6226 $top.
head conf
-state readonly
6227 grid x
$top.
head -sticky w
6228 label
$top.clab
-text [mc
"Command:"]
6229 entry
$top.cmd
-width 60 -textvariable wrcomcmd
6230 grid
$top.clab
$top.cmd
-sticky w
-pady 10
6231 label
$top.flab
-text [mc
"Output file:"]
6232 entry
$top.fname
-width 60
6233 $top.fname insert
0 [file normalize
"commit-[string range $rowmenuid 0 6]"]
6234 grid
$top.flab
$top.fname
-sticky w
6236 button
$top.buts.gen
-text [mc
"Write"] -command wrcomgo
6237 button
$top.buts.can
-text [mc
"Cancel"] -command wrcomcan
6238 grid
$top.buts.gen
$top.buts.can
6239 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6240 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6241 grid
$top.buts
- -pady 10 -sticky ew
6248 set id
[$wrcomtop.sha1 get
]
6249 set cmd
"echo $id | [$wrcomtop.cmd get]"
6250 set fname
[$wrcomtop.fname get
]
6251 if {[catch
{exec sh
-c $cmd >$fname &} err
]} {
6252 error_popup
"[mc "Error writing commit
:"] $err"
6254 catch
{destroy
$wrcomtop}
6261 catch
{destroy
$wrcomtop}
6266 global rowmenuid mkbrtop
6269 catch
{destroy
$top}
6271 label
$top.title
-text [mc
"Create new branch"]
6272 grid
$top.title
- -pady 10
6273 label
$top.id
-text [mc
"ID:"]
6274 entry
$top.sha1
-width 40 -relief flat
6275 $top.sha1 insert
0 $rowmenuid
6276 $top.sha1 conf
-state readonly
6277 grid
$top.id
$top.sha1
-sticky w
6278 label
$top.nlab
-text [mc
"Name:"]
6279 entry
$top.name
-width 40
6280 grid
$top.nlab
$top.name
-sticky w
6282 button
$top.buts.go
-text [mc
"Create"] -command [list mkbrgo
$top]
6283 button
$top.buts.can
-text [mc
"Cancel"] -command "catch {destroy $top}"
6284 grid
$top.buts.go
$top.buts.can
6285 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6286 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6287 grid
$top.buts
- -pady 10 -sticky ew
6292 global headids idheads
6294 set name
[$top.name get
]
6295 set id
[$top.sha1 get
]
6297 error_popup
[mc
"Please specify a name for the new branch"]
6300 catch
{destroy
$top}
6304 exec git branch
$name $id
6309 set headids
($name) $id
6310 lappend idheads
($id) $name
6319 proc cherrypick
{} {
6320 global rowmenuid curview commitrow
6323 set oldhead
[exec git rev-parse HEAD
]
6324 set dheads
[descheads
$rowmenuid]
6325 if {$dheads ne
{} && [lsearch
-exact $dheads $oldhead] >= 0} {
6326 set ok
[confirm_popup
[mc
"Commit %s is already\
6327 included in branch %s -- really re-apply it?" \
6328 [string range
$rowmenuid 0 7] $mainhead]]
6331 nowbusy cherrypick
[mc
"Cherry-picking"]
6333 # Unfortunately git-cherry-pick writes stuff to stderr even when
6334 # no error occurs, and exec takes that as an indication of error...
6335 if {[catch
{exec sh
-c "git cherry-pick -r $rowmenuid 2>&1"} err
]} {
6340 set newhead
[exec git rev-parse HEAD
]
6341 if {$newhead eq
$oldhead} {
6343 error_popup
[mc
"No changes committed"]
6346 addnewchild
$newhead $oldhead
6347 if {[info exists commitrow
($curview,$oldhead)]} {
6348 insertrow
$commitrow($curview,$oldhead) $newhead
6349 if {$mainhead ne
{}} {
6350 movehead
$newhead $mainhead
6351 movedhead
$newhead $mainhead
6360 global mainheadid mainhead rowmenuid confirm_ok resettype
6363 set w
".confirmreset"
6366 wm title
$w [mc
"Confirm reset"]
6367 message
$w.m
-text \
6368 [mc
"Reset branch %s to %s?" $mainhead [string range
$rowmenuid 0 7]] \
6369 -justify center
-aspect 1000
6370 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
6371 frame
$w.f
-relief sunken
-border 2
6372 message
$w.f.rt
-text [mc
"Reset type:"] -aspect 1000
6373 grid
$w.f.rt
-sticky w
6375 radiobutton
$w.f.soft
-value soft
-variable resettype
-justify left \
6376 -text [mc
"Soft: Leave working tree and index untouched"]
6377 grid
$w.f.soft
-sticky w
6378 radiobutton
$w.f.mixed
-value mixed
-variable resettype
-justify left \
6379 -text [mc
"Mixed: Leave working tree untouched, reset index"]
6380 grid
$w.f.mixed
-sticky w
6381 radiobutton
$w.f.hard
-value hard
-variable resettype
-justify left \
6382 -text [mc
"Hard: Reset working tree and index\n(discard ALL local changes)"]
6383 grid
$w.f.hard
-sticky w
6384 pack
$w.f
-side top
-fill x
6385 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
6386 pack
$w.ok
-side left
-fill x
-padx 20 -pady 20
6387 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
6388 pack
$w.cancel
-side right
-fill x
-padx 20 -pady 20
6389 bind $w <Visibility
> "grab $w; focus $w"
6391 if {!$confirm_ok} return
6392 if {[catch
{set fd
[open \
6393 [list | sh
-c "git reset --$resettype $rowmenuid 2>&1"] r
]} err
]} {
6397 filerun
$fd [list readresetstat
$fd]
6398 nowbusy
reset [mc
"Resetting"]
6402 proc readresetstat
{fd
} {
6403 global mainhead mainheadid showlocalchanges rprogcoord
6405 if {[gets
$fd line
] >= 0} {
6406 if {[regexp
{([0-9]+)% \
(([0-9]+)/([0-9]+)\
)} $line match p m n
]} {
6407 set rprogcoord
[expr {1.0 * $m / $n}]
6415 if {[catch
{close
$fd} err
]} {
6418 set oldhead
$mainheadid
6419 set newhead
[exec git rev-parse HEAD
]
6420 if {$newhead ne
$oldhead} {
6421 movehead
$newhead $mainhead
6422 movedhead
$newhead $mainhead
6423 set mainheadid
$newhead
6427 if {$showlocalchanges} {
6433 # context menu for a head
6434 proc headmenu
{x y id
head} {
6435 global headmenuid headmenuhead headctxmenu mainhead
6439 set headmenuhead
$head
6441 if {$head eq
$mainhead} {
6444 $headctxmenu entryconfigure
0 -state $state
6445 $headctxmenu entryconfigure
1 -state $state
6446 tk_popup
$headctxmenu $x $y
6450 global headmenuid headmenuhead mainhead headids
6451 global showlocalchanges mainheadid
6453 # check the tree is clean first??
6454 set oldmainhead
$mainhead
6455 nowbusy checkout
[mc
"Checking out"]
6459 exec git checkout
-q $headmenuhead
6465 set mainhead
$headmenuhead
6466 set mainheadid
$headmenuid
6467 if {[info exists headids
($oldmainhead)]} {
6468 redrawtags
$headids($oldmainhead)
6470 redrawtags
$headmenuid
6472 if {$showlocalchanges} {
6478 global headmenuid headmenuhead mainhead
6481 set head $headmenuhead
6483 # this check shouldn't be needed any more...
6484 if {$head eq
$mainhead} {
6485 error_popup
[mc
"Cannot delete the currently checked-out branch"]
6488 set dheads
[descheads
$id]
6489 if {[llength
$dheads] == 1 && $idheads($dheads) eq
$head} {
6490 # the stuff on this branch isn't on any other branch
6491 if {![confirm_popup
[mc
"The commits on branch %s aren't on any other\
6492 branch.\nReally delete branch %s?" $head $head]]} return
6496 if {[catch
{exec git branch
-D $head} err
]} {
6501 removehead
$id $head
6502 removedhead
$id $head
6509 # Display a list of tags and heads
6511 global showrefstop bgcolor fgcolor selectbgcolor
6512 global bglist fglist reflistfilter reflist maincursor
6515 set showrefstop
$top
6516 if {[winfo exists
$top]} {
6522 wm title
$top [mc
"Tags and heads: %s" [file tail [pwd]]]
6523 text
$top.list
-background $bgcolor -foreground $fgcolor \
6524 -selectbackground $selectbgcolor -font mainfont \
6525 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6526 -width 30 -height 20 -cursor $maincursor \
6527 -spacing1 1 -spacing3 1 -state disabled
6528 $top.list tag configure highlight
-background $selectbgcolor
6529 lappend bglist
$top.list
6530 lappend fglist
$top.list
6531 scrollbar
$top.ysb
-command "$top.list yview" -orient vertical
6532 scrollbar
$top.xsb
-command "$top.list xview" -orient horizontal
6533 grid
$top.list
$top.ysb
-sticky nsew
6534 grid
$top.xsb x
-sticky ew
6536 label
$top.f.l
-text "[mc "Filter
"]: "
6537 entry
$top.f.e
-width 20 -textvariable reflistfilter
6538 set reflistfilter
"*"
6539 trace add variable reflistfilter
write reflistfilter_change
6540 pack
$top.f.e
-side right
-fill x
-expand 1
6541 pack
$top.f.l
-side left
6542 grid
$top.f
- -sticky ew
-pady 2
6543 button
$top.close
-command [list destroy
$top] -text [mc
"Close"]
6545 grid columnconfigure
$top 0 -weight 1
6546 grid rowconfigure
$top 0 -weight 1
6547 bind $top.list
<1> {break}
6548 bind $top.list
<B1-Motion
> {break}
6549 bind $top.list
<ButtonRelease-1
> {sel_reflist
%W
%x
%y
; break}
6554 proc sel_reflist
{w x y
} {
6555 global showrefstop reflist headids tagids otherrefids
6557 if {![winfo exists
$showrefstop]} return
6558 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
6559 set ref
[lindex
$reflist [expr {$l-1}]]
6560 set n
[lindex
$ref 0]
6561 switch
-- [lindex
$ref 1] {
6562 "H" {selbyid
$headids($n)}
6563 "T" {selbyid
$tagids($n)}
6564 "o" {selbyid
$otherrefids($n)}
6566 $showrefstop.list tag add highlight
$l.0 "$l.0 lineend"
6569 proc unsel_reflist
{} {
6572 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6573 $showrefstop.list tag remove highlight
0.0 end
6576 proc reflistfilter_change
{n1 n2 op
} {
6577 global reflistfilter
6579 after cancel refill_reflist
6580 after
200 refill_reflist
6583 proc refill_reflist
{} {
6584 global reflist reflistfilter showrefstop headids tagids otherrefids
6585 global commitrow curview commitinterest
6587 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6589 foreach n
[array names headids
] {
6590 if {[string match
$reflistfilter $n]} {
6591 if {[info exists commitrow
($curview,$headids($n))]} {
6592 lappend refs
[list
$n H
]
6594 set commitinterest
($headids($n)) {run refill_reflist
}
6598 foreach n
[array names tagids
] {
6599 if {[string match
$reflistfilter $n]} {
6600 if {[info exists commitrow
($curview,$tagids($n))]} {
6601 lappend refs
[list
$n T
]
6603 set commitinterest
($tagids($n)) {run refill_reflist
}
6607 foreach n
[array names otherrefids
] {
6608 if {[string match
$reflistfilter $n]} {
6609 if {[info exists commitrow
($curview,$otherrefids($n))]} {
6610 lappend refs
[list
$n o
]
6612 set commitinterest
($otherrefids($n)) {run refill_reflist
}
6616 set refs
[lsort
-index 0 $refs]
6617 if {$refs eq
$reflist} return
6619 # Update the contents of $showrefstop.list according to the
6620 # differences between $reflist (old) and $refs (new)
6621 $showrefstop.list conf
-state normal
6622 $showrefstop.list insert end
"\n"
6625 while {$i < [llength
$reflist] ||
$j < [llength
$refs]} {
6626 if {$i < [llength
$reflist]} {
6627 if {$j < [llength
$refs]} {
6628 set cmp [string compare
[lindex
$reflist $i 0] \
6629 [lindex
$refs $j 0]]
6631 set cmp [string compare
[lindex
$reflist $i 1] \
6632 [lindex
$refs $j 1]]
6642 $showrefstop.list delete
"[expr {$j+1}].0" "[expr {$j+2}].0"
6650 set l
[expr {$j + 1}]
6651 $showrefstop.list image create
$l.0 -align baseline \
6652 -image reficon-
[lindex
$refs $j 1] -padx 2
6653 $showrefstop.list insert
$l.1 "[lindex $refs $j 0]\n"
6659 # delete last newline
6660 $showrefstop.list delete end-2c end-1c
6661 $showrefstop.list conf
-state disabled
6664 # Stuff for finding nearby tags
6665 proc getallcommits
{} {
6666 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6667 global idheads idtags idotherrefs allparents tagobjid
6669 if {![info exists allcommits
]} {
6675 set allccache
[file join [gitdir
] "gitk.cache"]
6677 set f
[open
$allccache r
]
6686 set cmd
[list | git rev-list
--parents]
6687 set allcupdate
[expr {$seeds ne
{}}]
6691 set refs
[concat
[array names idheads
] [array names idtags
] \
6692 [array names idotherrefs
]]
6695 foreach name
[array names tagobjid
] {
6696 lappend tagobjs
$tagobjid($name)
6698 foreach id
[lsort
-unique $refs] {
6699 if {![info exists allparents
($id)] &&
6700 [lsearch
-exact $tagobjs $id] < 0} {
6711 set fd
[open
[concat
$cmd $ids] r
]
6712 fconfigure
$fd -blocking 0
6715 filerun
$fd [list getallclines
$fd]
6721 # Since most commits have 1 parent and 1 child, we group strings of
6722 # such commits into "arcs" joining branch/merge points (BMPs), which
6723 # are commits that either don't have 1 parent or don't have 1 child.
6725 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6726 # arcout(id) - outgoing arcs for BMP
6727 # arcids(a) - list of IDs on arc including end but not start
6728 # arcstart(a) - BMP ID at start of arc
6729 # arcend(a) - BMP ID at end of arc
6730 # growing(a) - arc a is still growing
6731 # arctags(a) - IDs out of arcids (excluding end) that have tags
6732 # archeads(a) - IDs out of arcids (excluding end) that have heads
6733 # The start of an arc is at the descendent end, so "incoming" means
6734 # coming from descendents, and "outgoing" means going towards ancestors.
6736 proc getallclines
{fd
} {
6737 global allparents allchildren idtags idheads nextarc
6738 global arcnos arcids arctags arcout arcend arcstart archeads growing
6739 global seeds allcommits cachedarcs allcupdate
6742 while {[incr nid
] <= 1000 && [gets
$fd line
] >= 0} {
6743 set id
[lindex
$line 0]
6744 if {[info exists allparents
($id)]} {
6749 set olds
[lrange
$line 1 end
]
6750 set allparents
($id) $olds
6751 if {![info exists allchildren
($id)]} {
6752 set allchildren
($id) {}
6757 if {[llength
$olds] == 1 && [llength
$a] == 1} {
6758 lappend arcids
($a) $id
6759 if {[info exists idtags
($id)]} {
6760 lappend arctags
($a) $id
6762 if {[info exists idheads
($id)]} {
6763 lappend archeads
($a) $id
6765 if {[info exists allparents
($olds)]} {
6766 # seen parent already
6767 if {![info exists arcout
($olds)]} {
6770 lappend arcids
($a) $olds
6771 set arcend
($a) $olds
6774 lappend allchildren
($olds) $id
6775 lappend arcnos
($olds) $a
6779 foreach a
$arcnos($id) {
6780 lappend arcids
($a) $id
6787 lappend allchildren
($p) $id
6788 set a
[incr nextarc
]
6789 set arcstart
($a) $id
6796 if {[info exists allparents
($p)]} {
6797 # seen it already, may need to make a new branch
6798 if {![info exists arcout
($p)]} {
6801 lappend arcids
($a) $p
6805 lappend arcnos
($p) $a
6810 global cached_dheads cached_dtags cached_atags
6811 catch
{unset cached_dheads
}
6812 catch
{unset cached_dtags
}
6813 catch
{unset cached_atags
}
6816 return [expr {$nid >= 1000?
2: 1}]
6820 fconfigure
$fd -blocking 1
6823 # got an error reading the list of commits
6824 # if we were updating, try rereading the whole thing again
6830 error_popup
"[mc "Error reading commit topology information
;\
6831 branch and preceding
/following tag information\
6832 will be incomplete.
"]\n($err)"
6835 if {[incr allcommits
-1] == 0} {
6845 proc recalcarc
{a
} {
6846 global arctags archeads arcids idtags idheads
6850 foreach id
[lrange
$arcids($a) 0 end-1
] {
6851 if {[info exists idtags
($id)]} {
6854 if {[info exists idheads
($id)]} {
6859 set archeads
($a) $ah
6863 global arcnos arcids nextarc arctags archeads idtags idheads
6864 global arcstart arcend arcout allparents growing
6867 if {[llength
$a] != 1} {
6868 puts
"oops splitarc called but [llength $a] arcs already"
6872 set i
[lsearch
-exact $arcids($a) $p]
6874 puts
"oops splitarc $p not in arc $a"
6877 set na
[incr nextarc
]
6878 if {[info exists arcend
($a)]} {
6879 set arcend
($na) $arcend($a)
6881 set l
[lindex
$allparents([lindex
$arcids($a) end
]) 0]
6882 set j
[lsearch
-exact $arcnos($l) $a]
6883 set arcnos
($l) [lreplace
$arcnos($l) $j $j $na]
6885 set tail [lrange
$arcids($a) [expr {$i+1}] end
]
6886 set arcids
($a) [lrange
$arcids($a) 0 $i]
6888 set arcstart
($na) $p
6890 set arcids
($na) $tail
6891 if {[info exists growing
($a)]} {
6897 if {[llength
$arcnos($id)] == 1} {
6900 set j
[lsearch
-exact $arcnos($id) $a]
6901 set arcnos
($id) [lreplace
$arcnos($id) $j $j $na]
6905 # reconstruct tags and heads lists
6906 if {$arctags($a) ne
{} ||
$archeads($a) ne
{}} {
6911 set archeads
($na) {}
6915 # Update things for a new commit added that is a child of one
6916 # existing commit. Used when cherry-picking.
6917 proc addnewchild
{id p
} {
6918 global allparents allchildren idtags nextarc
6919 global arcnos arcids arctags arcout arcend arcstart archeads growing
6920 global seeds allcommits
6922 if {![info exists allcommits
] ||
![info exists arcnos
($p)]} return
6923 set allparents
($id) [list
$p]
6924 set allchildren
($id) {}
6927 lappend allchildren
($p) $id
6928 set a
[incr nextarc
]
6929 set arcstart
($a) $id
6932 set arcids
($a) [list
$p]
6934 if {![info exists arcout
($p)]} {
6937 lappend arcnos
($p) $a
6938 set arcout
($id) [list
$a]
6941 # This implements a cache for the topology information.
6942 # The cache saves, for each arc, the start and end of the arc,
6943 # the ids on the arc, and the outgoing arcs from the end.
6944 proc readcache
{f
} {
6945 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6946 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6951 if {$lim - $a > 500} {
6952 set lim
[expr {$a + 500}]
6956 # finish reading the cache and setting up arctags, etc.
6958 if {$line ne
"1"} {error
"bad final version"}
6960 foreach id
[array names idtags
] {
6961 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
6962 [llength
$allparents($id)] == 1} {
6963 set a
[lindex
$arcnos($id) 0]
6964 if {$arctags($a) eq
{}} {
6969 foreach id
[array names idheads
] {
6970 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
6971 [llength
$allparents($id)] == 1} {
6972 set a
[lindex
$arcnos($id) 0]
6973 if {$archeads($a) eq
{}} {
6978 foreach id
[lsort
-unique $possible_seeds] {
6979 if {$arcnos($id) eq
{}} {
6985 while {[incr a
] <= $lim} {
6987 if {[llength
$line] != 3} {error
"bad line"}
6988 set s
[lindex
$line 0]
6990 lappend arcout
($s) $a
6991 if {![info exists arcnos
($s)]} {
6992 lappend possible_seeds
$s
6995 set e
[lindex
$line 1]
7000 if {![info exists arcout
($e)]} {
7004 set arcids
($a) [lindex
$line 2]
7005 foreach id
$arcids($a) {
7006 lappend allparents
($s) $id
7008 lappend arcnos
($id) $a
7010 if {![info exists allparents
($s)]} {
7011 set allparents
($s) {}
7016 set nextarc
[expr {$a - 1}]
7029 global nextarc cachedarcs possible_seeds
7033 if {[llength
$line] != 2 ||
[lindex
$line 0] ne
"1"} {error
"bad version"}
7034 # make sure it's an integer
7035 set cachedarcs
[expr {int
([lindex
$line 1])}]
7036 if {$cachedarcs < 0} {error
"bad number of arcs"}
7038 set possible_seeds
{}
7046 proc dropcache
{err
} {
7047 global allcwait nextarc cachedarcs seeds
7049 #puts "dropping cache ($err)"
7050 foreach v
{arcnos arcout arcids arcstart arcend growing \
7051 arctags archeads allparents allchildren
} {
7062 proc writecache
{f
} {
7063 global cachearc cachedarcs allccache
7064 global arcstart arcend arcnos arcids arcout
7068 if {$lim - $a > 1000} {
7069 set lim
[expr {$a + 1000}]
7072 while {[incr a
] <= $lim} {
7073 if {[info exists arcend
($a)]} {
7074 puts
$f [list
$arcstart($a) $arcend($a) $arcids($a)]
7076 puts
$f [list
$arcstart($a) {} $arcids($a)]
7081 catch
{file delete
$allccache}
7082 #puts "writing cache failed ($err)"
7085 set cachearc
[expr {$a - 1}]
7086 if {$a > $cachedarcs} {
7095 global nextarc cachedarcs cachearc allccache
7097 if {$nextarc == $cachedarcs} return
7099 set cachedarcs
$nextarc
7101 set f
[open
$allccache w
]
7102 puts
$f [list
1 $cachedarcs]
7107 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7108 # or 0 if neither is true.
7109 proc anc_or_desc
{a b
} {
7110 global arcout arcstart arcend arcnos cached_isanc
7112 if {$arcnos($a) eq
$arcnos($b)} {
7113 # Both are on the same arc(s); either both are the same BMP,
7114 # or if one is not a BMP, the other is also not a BMP or is
7115 # the BMP at end of the arc (and it only has 1 incoming arc).
7116 # Or both can be BMPs with no incoming arcs.
7117 if {$a eq
$b ||
$arcnos($a) eq
{}} {
7120 # assert {[llength $arcnos($a)] == 1}
7121 set arc
[lindex
$arcnos($a) 0]
7122 set i
[lsearch
-exact $arcids($arc) $a]
7123 set j
[lsearch
-exact $arcids($arc) $b]
7124 if {$i < 0 ||
$i > $j} {
7131 if {![info exists arcout
($a)]} {
7132 set arc
[lindex
$arcnos($a) 0]
7133 if {[info exists arcend
($arc)]} {
7134 set aend
$arcend($arc)
7138 set a
$arcstart($arc)
7142 if {![info exists arcout
($b)]} {
7143 set arc
[lindex
$arcnos($b) 0]
7144 if {[info exists arcend
($arc)]} {
7145 set bend
$arcend($arc)
7149 set b
$arcstart($arc)
7159 if {[info exists cached_isanc
($a,$bend)]} {
7160 if {$cached_isanc($a,$bend)} {
7164 if {[info exists cached_isanc
($b,$aend)]} {
7165 if {$cached_isanc($b,$aend)} {
7168 if {[info exists cached_isanc
($a,$bend)]} {
7173 set todo
[list
$a $b]
7176 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7177 set x
[lindex
$todo $i]
7178 if {$anc($x) eq
{}} {
7181 foreach arc
$arcnos($x) {
7182 set xd
$arcstart($arc)
7184 set cached_isanc
($a,$bend) 1
7185 set cached_isanc
($b,$aend) 0
7187 } elseif
{$xd eq
$aend} {
7188 set cached_isanc
($b,$aend) 1
7189 set cached_isanc
($a,$bend) 0
7192 if {![info exists anc
($xd)]} {
7193 set anc
($xd) $anc($x)
7195 } elseif
{$anc($xd) ne
$anc($x)} {
7200 set cached_isanc
($a,$bend) 0
7201 set cached_isanc
($b,$aend) 0
7205 # This identifies whether $desc has an ancestor that is
7206 # a growing tip of the graph and which is not an ancestor of $anc
7207 # and returns 0 if so and 1 if not.
7208 # If we subsequently discover a tag on such a growing tip, and that
7209 # turns out to be a descendent of $anc (which it could, since we
7210 # don't necessarily see children before parents), then $desc
7211 # isn't a good choice to display as a descendent tag of
7212 # $anc (since it is the descendent of another tag which is
7213 # a descendent of $anc). Similarly, $anc isn't a good choice to
7214 # display as a ancestor tag of $desc.
7216 proc is_certain
{desc anc
} {
7217 global arcnos arcout arcstart arcend growing problems
7220 if {[llength
$arcnos($anc)] == 1} {
7221 # tags on the same arc are certain
7222 if {$arcnos($desc) eq
$arcnos($anc)} {
7225 if {![info exists arcout
($anc)]} {
7226 # if $anc is partway along an arc, use the start of the arc instead
7227 set a
[lindex
$arcnos($anc) 0]
7228 set anc
$arcstart($a)
7231 if {[llength
$arcnos($desc)] > 1 ||
[info exists arcout
($desc)]} {
7234 set a
[lindex
$arcnos($desc) 0]
7240 set anclist
[list
$x]
7244 for {set i
0} {$i < [llength
$anclist] && ($nnh > 0 ||
$ngrowanc > 0)} {incr i
} {
7245 set x
[lindex
$anclist $i]
7250 foreach a
$arcout($x) {
7251 if {[info exists growing
($a)]} {
7252 if {![info exists growanc
($x)] && $dl($x)} {
7258 if {[info exists dl
($y)]} {
7262 if {![info exists
done($y)]} {
7265 if {[info exists growanc
($x)]} {
7269 for {set k
0} {$k < [llength
$xl]} {incr k
} {
7270 set z
[lindex
$xl $k]
7271 foreach c
$arcout($z) {
7272 if {[info exists arcend
($c)]} {
7274 if {[info exists dl
($v)] && $dl($v)} {
7276 if {![info exists
done($v)]} {
7279 if {[info exists growanc
($v)]} {
7289 } elseif
{$y eq
$anc ||
!$dl($x)} {
7300 foreach x
[array names growanc
] {
7309 proc validate_arctags
{a
} {
7310 global arctags idtags
7314 foreach id
$arctags($a) {
7316 if {![info exists idtags
($id)]} {
7317 set na
[lreplace
$na $i $i]
7324 proc validate_archeads
{a
} {
7325 global archeads idheads
7328 set na
$archeads($a)
7329 foreach id
$archeads($a) {
7331 if {![info exists idheads
($id)]} {
7332 set na
[lreplace
$na $i $i]
7336 set archeads
($a) $na
7339 # Return the list of IDs that have tags that are descendents of id,
7340 # ignoring IDs that are descendents of IDs already reported.
7341 proc desctags
{id
} {
7342 global arcnos arcstart arcids arctags idtags allparents
7343 global growing cached_dtags
7345 if {![info exists allparents
($id)]} {
7348 set t1
[clock clicks
-milliseconds]
7350 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7351 # part-way along an arc; check that arc first
7352 set a
[lindex
$arcnos($id) 0]
7353 if {$arctags($a) ne
{}} {
7355 set i
[lsearch
-exact $arcids($a) $id]
7357 foreach t
$arctags($a) {
7358 set j
[lsearch
-exact $arcids($a) $t]
7366 set id
$arcstart($a)
7367 if {[info exists idtags
($id)]} {
7371 if {[info exists cached_dtags
($id)]} {
7372 return $cached_dtags($id)
7379 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7380 set id
[lindex
$todo $i]
7382 set ta
[info exists hastaggedancestor
($id)]
7386 # ignore tags on starting node
7387 if {!$ta && $i > 0} {
7388 if {[info exists idtags
($id)]} {
7391 } elseif
{[info exists cached_dtags
($id)]} {
7392 set tagloc
($id) $cached_dtags($id)
7396 foreach a
$arcnos($id) {
7398 if {!$ta && $arctags($a) ne
{}} {
7400 if {$arctags($a) ne
{}} {
7401 lappend tagloc
($id) [lindex
$arctags($a) end
]
7404 if {$ta ||
$arctags($a) ne
{}} {
7405 set tomark
[list
$d]
7406 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7407 set dd [lindex
$tomark $j]
7408 if {![info exists hastaggedancestor
($dd)]} {
7409 if {[info exists
done($dd)]} {
7410 foreach b
$arcnos($dd) {
7411 lappend tomark
$arcstart($b)
7413 if {[info exists tagloc
($dd)]} {
7416 } elseif
{[info exists queued
($dd)]} {
7419 set hastaggedancestor
($dd) 1
7423 if {![info exists queued
($d)]} {
7426 if {![info exists hastaggedancestor
($d)]} {
7433 foreach id
[array names tagloc
] {
7434 if {![info exists hastaggedancestor
($id)]} {
7435 foreach t
$tagloc($id) {
7436 if {[lsearch
-exact $tags $t] < 0} {
7442 set t2
[clock clicks
-milliseconds]
7445 # remove tags that are descendents of other tags
7446 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7447 set a
[lindex
$tags $i]
7448 for {set j
0} {$j < $i} {incr j
} {
7449 set b
[lindex
$tags $j]
7450 set r
[anc_or_desc
$a $b]
7452 set tags
[lreplace
$tags $j $j]
7455 } elseif
{$r == -1} {
7456 set tags
[lreplace
$tags $i $i]
7463 if {[array names growing
] ne
{}} {
7464 # graph isn't finished, need to check if any tag could get
7465 # eclipsed by another tag coming later. Simply ignore any
7466 # tags that could later get eclipsed.
7469 if {[is_certain
$t $origid]} {
7473 if {$tags eq
$ctags} {
7474 set cached_dtags
($origid) $tags
7479 set cached_dtags
($origid) $tags
7481 set t3
[clock clicks
-milliseconds]
7482 if {0 && $t3 - $t1 >= 100} {
7483 puts
"iterating descendents ($loopix/[llength $todo] nodes) took\
7484 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7490 global arcnos arcids arcout arcend arctags idtags allparents
7491 global growing cached_atags
7493 if {![info exists allparents
($id)]} {
7496 set t1
[clock clicks
-milliseconds]
7498 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7499 # part-way along an arc; check that arc first
7500 set a
[lindex
$arcnos($id) 0]
7501 if {$arctags($a) ne
{}} {
7503 set i
[lsearch
-exact $arcids($a) $id]
7504 foreach t
$arctags($a) {
7505 set j
[lsearch
-exact $arcids($a) $t]
7511 if {![info exists arcend
($a)]} {
7515 if {[info exists idtags
($id)]} {
7519 if {[info exists cached_atags
($id)]} {
7520 return $cached_atags($id)
7528 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7529 set id
[lindex
$todo $i]
7531 set td
[info exists hastaggeddescendent
($id)]
7535 # ignore tags on starting node
7536 if {!$td && $i > 0} {
7537 if {[info exists idtags
($id)]} {
7540 } elseif
{[info exists cached_atags
($id)]} {
7541 set tagloc
($id) $cached_atags($id)
7545 foreach a
$arcout($id) {
7546 if {!$td && $arctags($a) ne
{}} {
7548 if {$arctags($a) ne
{}} {
7549 lappend tagloc
($id) [lindex
$arctags($a) 0]
7552 if {![info exists arcend
($a)]} continue
7554 if {$td ||
$arctags($a) ne
{}} {
7555 set tomark
[list
$d]
7556 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7557 set dd [lindex
$tomark $j]
7558 if {![info exists hastaggeddescendent
($dd)]} {
7559 if {[info exists
done($dd)]} {
7560 foreach b
$arcout($dd) {
7561 if {[info exists arcend
($b)]} {
7562 lappend tomark
$arcend($b)
7565 if {[info exists tagloc
($dd)]} {
7568 } elseif
{[info exists queued
($dd)]} {
7571 set hastaggeddescendent
($dd) 1
7575 if {![info exists queued
($d)]} {
7578 if {![info exists hastaggeddescendent
($d)]} {
7584 set t2
[clock clicks
-milliseconds]
7587 foreach id
[array names tagloc
] {
7588 if {![info exists hastaggeddescendent
($id)]} {
7589 foreach t
$tagloc($id) {
7590 if {[lsearch
-exact $tags $t] < 0} {
7597 # remove tags that are ancestors of other tags
7598 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7599 set a
[lindex
$tags $i]
7600 for {set j
0} {$j < $i} {incr j
} {
7601 set b
[lindex
$tags $j]
7602 set r
[anc_or_desc
$a $b]
7604 set tags
[lreplace
$tags $j $j]
7607 } elseif
{$r == 1} {
7608 set tags
[lreplace
$tags $i $i]
7615 if {[array names growing
] ne
{}} {
7616 # graph isn't finished, need to check if any tag could get
7617 # eclipsed by another tag coming later. Simply ignore any
7618 # tags that could later get eclipsed.
7621 if {[is_certain
$origid $t]} {
7625 if {$tags eq
$ctags} {
7626 set cached_atags
($origid) $tags
7631 set cached_atags
($origid) $tags
7633 set t3
[clock clicks
-milliseconds]
7634 if {0 && $t3 - $t1 >= 100} {
7635 puts
"iterating ancestors ($loopix/[llength $todo] nodes) took\
7636 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7641 # Return the list of IDs that have heads that are descendents of id,
7642 # including id itself if it has a head.
7643 proc descheads
{id
} {
7644 global arcnos arcstart arcids archeads idheads cached_dheads
7647 if {![info exists allparents
($id)]} {
7651 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7652 # part-way along an arc; check it first
7653 set a
[lindex
$arcnos($id) 0]
7654 if {$archeads($a) ne
{}} {
7655 validate_archeads
$a
7656 set i
[lsearch
-exact $arcids($a) $id]
7657 foreach t
$archeads($a) {
7658 set j
[lsearch
-exact $arcids($a) $t]
7663 set id
$arcstart($a)
7669 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7670 set id
[lindex
$todo $i]
7671 if {[info exists cached_dheads
($id)]} {
7672 set ret
[concat
$ret $cached_dheads($id)]
7674 if {[info exists idheads
($id)]} {
7677 foreach a
$arcnos($id) {
7678 if {$archeads($a) ne
{}} {
7679 validate_archeads
$a
7680 if {$archeads($a) ne
{}} {
7681 set ret
[concat
$ret $archeads($a)]
7685 if {![info exists seen
($d)]} {
7692 set ret
[lsort
-unique $ret]
7693 set cached_dheads
($origid) $ret
7694 return [concat
$ret $aret]
7697 proc addedtag
{id
} {
7698 global arcnos arcout cached_dtags cached_atags
7700 if {![info exists arcnos
($id)]} return
7701 if {![info exists arcout
($id)]} {
7702 recalcarc
[lindex
$arcnos($id) 0]
7704 catch
{unset cached_dtags
}
7705 catch
{unset cached_atags
}
7708 proc addedhead
{hid
head} {
7709 global arcnos arcout cached_dheads
7711 if {![info exists arcnos
($hid)]} return
7712 if {![info exists arcout
($hid)]} {
7713 recalcarc
[lindex
$arcnos($hid) 0]
7715 catch
{unset cached_dheads
}
7718 proc removedhead
{hid
head} {
7719 global cached_dheads
7721 catch
{unset cached_dheads
}
7724 proc movedhead
{hid
head} {
7725 global arcnos arcout cached_dheads
7727 if {![info exists arcnos
($hid)]} return
7728 if {![info exists arcout
($hid)]} {
7729 recalcarc
[lindex
$arcnos($hid) 0]
7731 catch
{unset cached_dheads
}
7734 proc changedrefs
{} {
7735 global cached_dheads cached_dtags cached_atags
7736 global arctags archeads arcnos arcout idheads idtags
7738 foreach id
[concat
[array names idheads
] [array names idtags
]] {
7739 if {[info exists arcnos
($id)] && ![info exists arcout
($id)]} {
7740 set a
[lindex
$arcnos($id) 0]
7741 if {![info exists donearc
($a)]} {
7747 catch
{unset cached_dtags
}
7748 catch
{unset cached_atags
}
7749 catch
{unset cached_dheads
}
7752 proc rereadrefs
{} {
7753 global idtags idheads idotherrefs mainhead
7755 set refids
[concat
[array names idtags
] \
7756 [array names idheads
] [array names idotherrefs
]]
7757 foreach id
$refids {
7758 if {![info exists ref
($id)]} {
7759 set ref
($id) [listrefs
$id]
7762 set oldmainhead
$mainhead
7765 set refids
[lsort
-unique [concat
$refids [array names idtags
] \
7766 [array names idheads
] [array names idotherrefs
]]]
7767 foreach id
$refids {
7768 set v
[listrefs
$id]
7769 if {![info exists ref
($id)] ||
$ref($id) != $v ||
7770 ($id eq
$oldmainhead && $id ne
$mainhead) ||
7771 ($id eq
$mainhead && $id ne
$oldmainhead)} {
7778 proc listrefs
{id
} {
7779 global idtags idheads idotherrefs
7782 if {[info exists idtags
($id)]} {
7786 if {[info exists idheads
($id)]} {
7790 if {[info exists idotherrefs
($id)]} {
7791 set z
$idotherrefs($id)
7793 return [list
$x $y $z]
7796 proc showtag
{tag isnew
} {
7797 global ctext tagcontents tagids linknum tagobjid
7800 addtohistory
[list showtag
$tag 0]
7802 $ctext conf
-state normal
7806 if {![info exists tagcontents
($tag)]} {
7808 set tagcontents
($tag) [exec git cat-file tag
$tagobjid($tag)]
7811 if {[info exists tagcontents
($tag)]} {
7812 set text
$tagcontents($tag)
7814 set text
"[mc "Tag
"]: $tag\n[mc "Id
"]: $tagids($tag)"
7816 appendwithlinks
$text {}
7817 $ctext conf
-state disabled
7828 proc mkfontdisp
{font top
which} {
7829 global fontattr fontpref
$font
7831 set fontpref
($font) [set $font]
7832 button
$top.
${font}but
-text $which -font optionfont \
7833 -command [list choosefont
$font $which]
7834 label
$top.
$font -relief flat
-font $font \
7835 -text $fontattr($font,family
) -justify left
7836 grid x
$top.
${font}but
$top.
$font -sticky w
7839 proc choosefont
{font
which} {
7840 global fontparam fontlist fonttop fontattr
7842 set fontparam
(which) $which
7843 set fontparam
(font
) $font
7844 set fontparam
(family
) [font actual
$font -family]
7845 set fontparam
(size
) $fontattr($font,size
)
7846 set fontparam
(weight
) $fontattr($font,weight
)
7847 set fontparam
(slant
) $fontattr($font,slant
)
7850 if {![winfo exists
$top]} {
7852 eval font config sample
[font actual
$font]
7854 wm title
$top [mc
"Gitk font chooser"]
7855 label
$top.l
-textvariable fontparam
(which)
7856 pack
$top.l
-side top
7857 set fontlist
[lsort
[font families
]]
7859 listbox
$top.f.fam
-listvariable fontlist \
7860 -yscrollcommand [list
$top.f.sb
set]
7861 bind $top.f.fam
<<ListboxSelect>> selfontfam
7862 scrollbar $top.f.sb -command [list $top.f.fam yview]
7863 pack $top.f.sb -side right -fill y
7864 pack $top.f.fam -side left -fill both -expand 1
7865 pack $top.f -side top -fill both -expand 1
7867 spinbox $top.g.size -from 4 -to 40 -width 4 \
7868 -textvariable fontparam(size) \
7869 -validatecommand {string is integer -strict %s}
7870 checkbutton $top.g.bold -padx 5 \
7871 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7872 -variable fontparam(weight) -onvalue bold -offvalue normal
7873 checkbutton $top.g.ital -padx 5 \
7874 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7875 -variable fontparam(slant) -onvalue italic -offvalue roman
7876 pack $top.g.size $top.g.bold $top.g.ital -side left
7877 pack $top.g -side top
7878 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7880 $top.c create text 100 25 -anchor center -text $which -font sample \
7881 -fill black -tags text
7882 bind $top.c <Configure> [list centertext $top.c]
7883 pack $top.c -side top -fill x
7885 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7886 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7887 grid $top.buts.ok $top.buts.can
7888 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7889 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7890 pack $top.buts -side bottom -fill x
7891 trace add variable fontparam write chg_fontparam
7894 $top.c itemconf text -text $which
7896 set i [lsearch -exact $fontlist $fontparam(family)]
7898 $top.f.fam selection set $i
7903 proc centertext {w} {
7904 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7908 global fontparam fontpref prefstop
7910 set f $fontparam(font)
7911 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7912 if {$fontparam(weight) eq "bold"} {
7913 lappend fontpref($f) "bold"
7915 if {$fontparam(slant) eq "italic"} {
7916 lappend fontpref($f) "italic"
7919 $w conf -text $fontparam(family) -font $fontpref($f)
7925 global fonttop fontparam
7927 if {[info exists fonttop]} {
7928 catch {destroy $fonttop}
7929 catch {font delete sample}
7935 proc selfontfam {} {
7936 global fonttop fontparam
7938 set i [$fonttop.f.fam curselection]
7940 set fontparam(family) [$fonttop.f.fam get $i]
7944 proc chg_fontparam {v sub op} {
7947 font config sample -$sub $fontparam($sub)
7951 global maxwidth maxgraphpct
7952 global oldprefs prefstop showneartags showlocalchanges
7953 global bgcolor fgcolor ctext diffcolors selectbgcolor
7954 global tabstop limitdiffs
7958 if {[winfo exists $top]} {
7962 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7963 limitdiffs tabstop} {
7964 set oldprefs($v) [set $v]
7967 wm title $top [mc "Gitk preferences"]
7968 label $top.ldisp -text [mc "Commit list display options"]
7969 grid $top.ldisp - -sticky w -pady 10
7970 label $top.spacer -text " "
7971 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7973 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7974 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7975 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7977 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7978 grid x $top.maxpctl $top.maxpct -sticky w
7979 frame $top.showlocal
7980 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7981 checkbutton $top.showlocal.b -variable showlocalchanges
7982 pack $top.showlocal.b $top.showlocal.l -side left
7983 grid x $top.showlocal -sticky w
7985 label $top.ddisp -text [mc "Diff display options"]
7986 grid $top.ddisp - -sticky w -pady 10
7987 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7988 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7989 grid x $top.tabstopl $top.tabstop -sticky w
7991 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7992 checkbutton $top.ntag.b -variable showneartags
7993 pack $top.ntag.b $top.ntag.l -side left
7994 grid x $top.ntag -sticky w
7996 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7997 checkbutton $top.ldiff.b -variable limitdiffs
7998 pack $top.ldiff.b $top.ldiff.l -side left
7999 grid x $top.ldiff -sticky w
8001 label $top.cdisp -text [mc "Colors: press to choose"]
8002 grid $top.cdisp - -sticky w -pady 10
8003 label $top.bg -padx 40 -relief sunk -background $bgcolor
8004 button $top.bgbut -text [mc "Background"] -font optionfont \
8005 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8006 grid x $top.bgbut $top.bg -sticky w
8007 label $top.fg -padx 40 -relief sunk -background $fgcolor
8008 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8009 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8010 grid x $top.fgbut $top.fg -sticky w
8011 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8012 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8013 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8014 [list $ctext tag conf d0 -foreground]]
8015 grid x $top.diffoldbut $top.diffold -sticky w
8016 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8017 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8018 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8019 [list $ctext tag conf d1 -foreground]]
8020 grid x $top.diffnewbut $top.diffnew -sticky w
8021 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8022 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8023 -command [list choosecolor diffcolors 2 $top.hunksep \
8024 "diff hunk header" \
8025 [list $ctext tag conf hunksep -foreground]]
8026 grid x $top.hunksepbut $top.hunksep -sticky w
8027 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8028 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8029 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8030 grid x $top.selbgbut $top.selbgsep -sticky w
8032 label $top.cfont -text [mc "Fonts: press to choose"]
8033 grid $top.cfont - -sticky w -pady 10
8034 mkfontdisp mainfont $top [mc "Main font"]
8035 mkfontdisp textfont $top [mc "Diff display font"]
8036 mkfontdisp uifont $top [mc "User interface font"]
8039 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8040 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8041 grid $top.buts.ok $top.buts.can
8042 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8043 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8044 grid $top.buts - - -pady 10 -sticky ew
8045 bind $top <Visibility> "focus $top.buts.ok"
8048 proc choosecolor {v vi w x cmd} {
8051 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8052 -title [mc "Gitk: choose color for %s" $x]]
8053 if {$c eq {}} return
8054 $w conf -background $c
8060 global bglist cflist
8062 $w configure -selectbackground $c
8064 $cflist tag configure highlight \
8065 -background [$cflist cget -selectbackground]
8066 allcanvs itemconf secsel -fill $c
8073 $w conf -background $c
8081 $w conf -foreground $c
8083 allcanvs itemconf text -fill $c
8084 $canv itemconf circle -outline $c
8088 global oldprefs prefstop
8090 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8091 limitdiffs tabstop} {
8093 set $v $oldprefs($v)
8095 catch {destroy $prefstop}
8101 global maxwidth maxgraphpct
8102 global oldprefs prefstop showneartags showlocalchanges
8103 global fontpref mainfont textfont uifont
8104 global limitdiffs treediffs
8106 catch {destroy $prefstop}
8110 if {$mainfont ne $fontpref(mainfont)} {
8111 set mainfont $fontpref(mainfont)
8112 parsefont mainfont $mainfont
8113 eval font configure mainfont [fontflags mainfont]
8114 eval font configure mainfontbold [fontflags mainfont 1]
8118 if {$textfont ne $fontpref(textfont)} {
8119 set textfont $fontpref(textfont)
8120 parsefont textfont $textfont
8121 eval font configure textfont [fontflags textfont]
8122 eval font configure textfontbold [fontflags textfont 1]
8124 if {$uifont ne $fontpref(uifont)} {
8125 set uifont $fontpref(uifont)
8126 parsefont uifont $uifont
8127 eval font configure uifont [fontflags uifont]
8130 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8131 if {$showlocalchanges} {
8137 if {$limitdiffs != $oldprefs(limitdiffs)} {
8138 # treediffs elements are limited by path
8139 catch {unset treediffs}
8141 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8142 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8144 } elseif {$showneartags != $oldprefs(showneartags) ||
8145 $limitdiffs != $oldprefs(limitdiffs)} {
8150 proc formatdate {d} {
8151 global datetimeformat
8153 set d [clock format $d -format $datetimeformat]
8158 # This list of encoding names and aliases is distilled from
8159 # http://www.iana.org/assignments/character-sets.
8160 # Not all of them are supported by Tcl.
8161 set encoding_aliases {
8162 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8163 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8164 { ISO-10646-UTF-1 csISO10646UTF1 }
8165 { ISO_646.basic:1983 ref csISO646basic1983 }
8166 { INVARIANT csINVARIANT }
8167 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8168 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8169 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8170 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8171 { NATS-DANO iso-ir-9-1 csNATSDANO }
8172 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8173 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8174 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8175 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8176 { ISO-2022-KR csISO2022KR }
8178 { ISO-2022-JP csISO2022JP }
8179 { ISO-2022-JP-2 csISO2022JP2 }
8180 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8182 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8183 { IT iso-ir-15 ISO646-IT csISO15Italian }
8184 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8185 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8186 { greek7-old iso-ir-18 csISO18Greek7Old }
8187 { latin-greek iso-ir-19 csISO19LatinGreek }
8188 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8189 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8190 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8191 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8192 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8193 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8194 { INIS iso-ir-49 csISO49INIS }
8195 { INIS-8 iso-ir-50 csISO50INIS8 }
8196 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8197 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8198 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8199 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8200 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8201 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8203 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8204 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8205 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8206 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8207 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8208 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8209 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8210 { greek7 iso-ir-88 csISO88Greek7 }
8211 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8212 { iso-ir-90 csISO90 }
8213 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8214 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8215 csISO92JISC62991984b }
8216 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8217 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8218 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8219 csISO95JIS62291984handadd }
8220 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8221 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8222 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8223 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8225 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8226 { T.61-7bit iso-ir-102 csISO102T617bit }
8227 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8228 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8229 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8230 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8231 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8232 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8233 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8234 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8235 arabic csISOLatinArabic }
8236 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8237 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8238 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8239 greek greek8 csISOLatinGreek }
8240 { T.101-G2 iso-ir-128 csISO128T101G2 }
8241 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8243 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8244 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8245 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8246 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8247 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8248 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8249 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8250 csISOLatinCyrillic }
8251 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8252 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8253 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8254 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8255 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8256 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8257 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8258 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8259 { ISO_10367-box iso-ir-155 csISO10367Box }
8260 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8261 { latin-lap lap iso-ir-158 csISO158Lap }
8262 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8263 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8266 { JIS_X0201 X0201 csHalfWidthKatakana }
8267 { KSC5636 ISO646-KR csKSC5636 }
8268 { ISO-10646-UCS-2 csUnicode }
8269 { ISO-10646-UCS-4 csUCS4 }
8270 { DEC-MCS dec csDECMCS }
8271 { hp-roman8 roman8 r8 csHPRoman8 }
8272 { macintosh mac csMacintosh }
8273 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8275 { IBM038 EBCDIC-INT cp038 csIBM038 }
8276 { IBM273 CP273 csIBM273 }
8277 { IBM274 EBCDIC-BE CP274 csIBM274 }
8278 { IBM275 EBCDIC-BR cp275 csIBM275 }
8279 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8280 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8281 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8282 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8283 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8284 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8285 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8286 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8287 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8288 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8289 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8290 { IBM437 cp437 437 csPC8CodePage437 }
8291 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8292 { IBM775 cp775 csPC775Baltic }
8293 { IBM850 cp850 850 csPC850Multilingual }
8294 { IBM851 cp851 851 csIBM851 }
8295 { IBM852 cp852 852 csPCp852 }
8296 { IBM855 cp855 855 csIBM855 }
8297 { IBM857 cp857 857 csIBM857 }
8298 { IBM860 cp860 860 csIBM860 }
8299 { IBM861 cp861 861 cp-is csIBM861 }
8300 { IBM862 cp862 862 csPC862LatinHebrew }
8301 { IBM863 cp863 863 csIBM863 }
8302 { IBM864 cp864 csIBM864 }
8303 { IBM865 cp865 865 csIBM865 }
8304 { IBM866 cp866 866 csIBM866 }
8305 { IBM868 CP868 cp-ar csIBM868 }
8306 { IBM869 cp869 869 cp-gr csIBM869 }
8307 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8308 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8309 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8310 { IBM891 cp891 csIBM891 }
8311 { IBM903 cp903 csIBM903 }
8312 { IBM904 cp904 904 csIBBM904 }
8313 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8314 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8315 { IBM1026 CP1026 csIBM1026 }
8316 { EBCDIC-AT-DE csIBMEBCDICATDE }
8317 { EBCDIC-AT-DE-A csEBCDICATDEA }
8318 { EBCDIC-CA-FR csEBCDICCAFR }
8319 { EBCDIC-DK-NO csEBCDICDKNO }
8320 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8321 { EBCDIC-FI-SE csEBCDICFISE }
8322 { EBCDIC-FI-SE-A csEBCDICFISEA }
8323 { EBCDIC-FR csEBCDICFR }
8324 { EBCDIC-IT csEBCDICIT }
8325 { EBCDIC-PT csEBCDICPT }
8326 { EBCDIC-ES csEBCDICES }
8327 { EBCDIC-ES-A csEBCDICESA }
8328 { EBCDIC-ES-S csEBCDICESS }
8329 { EBCDIC-UK csEBCDICUK }
8330 { EBCDIC-US csEBCDICUS }
8331 { UNKNOWN-8BIT csUnknown8BiT }
8332 { MNEMONIC csMnemonic }
8337 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8338 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8339 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8340 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8341 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8342 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8343 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8344 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8345 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8346 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8347 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8348 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8349 { IBM1047 IBM-1047 }
8350 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8351 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8352 { UNICODE-1-1 csUnicode11 }
8355 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8356 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8358 { ISO-8859-15 ISO_8859-15 Latin-9 }
8359 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8360 { GBK CP936 MS936 windows-936 }
8361 { JIS_Encoding csJISEncoding }
8362 { Shift_JIS MS_Kanji csShiftJIS }
8363 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8365 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8366 { ISO-10646-UCS-Basic csUnicodeASCII }
8367 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8368 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8369 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8370 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8371 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8372 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8373 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8374 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8375 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8376 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8377 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8378 { Ventura-US csVenturaUS }
8379 { Ventura-International csVenturaInternational }
8380 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8381 { PC8-Turkish csPC8Turkish }
8382 { IBM-Symbols csIBMSymbols }
8383 { IBM-Thai csIBMThai }
8384 { HP-Legal csHPLegal }
8385 { HP-Pi-font csHPPiFont }
8386 { HP-Math8 csHPMath8 }
8387 { Adobe-Symbol-Encoding csHPPSMath }
8388 { HP-DeskTop csHPDesktop }
8389 { Ventura-Math csVenturaMath }
8390 { Microsoft-Publishing csMicrosoftPublishing }
8391 { Windows-31J csWindows31J }
8396 proc tcl_encoding {enc} {
8397 global encoding_aliases
8398 set names [encoding names]
8399 set lcnames [string tolower $names]
8400 set enc [string tolower $enc]
8401 set i [lsearch -exact $lcnames $enc]
8403 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8404 if {[regsub {^iso[-_]} $enc iso encx]} {
8405 set i [lsearch -exact $lcnames $encx]
8409 foreach l $encoding_aliases {
8410 set ll [string tolower $l]
8411 if {[lsearch -exact $ll $enc] < 0} continue
8412 # look through the aliases for one that tcl knows about
8414 set i [lsearch -exact $lcnames $e]
8416 if {[regsub {^iso[-_]} $e iso ex]} {
8417 set i [lsearch -exact $lcnames $ex]
8426 return [lindex $names $i]
8431 # First check that Tcl/Tk is recent enough
8432 if {[catch {package require Tk 8.4} err]} {
8433 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8434 Gitk requires at least Tcl/Tk 8.4."]
8440 set wrcomcmd "git diff-tree --stdin -p --pretty"
8444 set gitencoding [exec git config --get i18n.commitencoding]
8446 if {$gitencoding == ""} {
8447 set gitencoding "utf-8"
8449 set tclencoding [tcl_encoding $gitencoding]
8450 if {$tclencoding == {}} {
8451 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8454 set mainfont {Helvetica 9}
8455 set textfont {Courier 9}
8456 set uifont {Helvetica 9 bold}
8458 set findmergefiles 0
8466 set cmitmode "patch"
8467 set wrapcomment "none"
8471 set showlocalchanges 1
8473 set datetimeformat "%Y-%m-%d %H:%M:%S"
8475 set colors {green red blue magenta darkgrey brown orange}
8478 set diffcolors {red "#00a000" blue}
8481 set selectbgcolor gray85
8483 ## For msgcat loading, first locate the installation location.
8484 if { [info exists ::env(GITK_MSGSDIR)] } {
8485 ## Msgsdir was manually set in the environment.
8486 set gitk_msgsdir $::env(GITK_MSGSDIR)
8488 ## Let's guess the prefix from argv0.
8489 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8490 set gitk_libdir [file join $gitk_prefix share gitk lib]
8491 set gitk_msgsdir [file join $gitk_libdir msgs]
8495 ## Internationalization (i18n) through msgcat and gettext. See
8496 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8497 package require msgcat
8498 namespace import ::msgcat::mc
8499 ## And eventually load the actual message catalog
8500 ::msgcat::mcload $gitk_msgsdir
8502 catch {source ~/.gitk}
8504 font create optionfont -family sans-serif -size -12
8506 parsefont mainfont $mainfont
8507 eval font create mainfont [fontflags mainfont]
8508 eval font create mainfontbold [fontflags mainfont 1]
8510 parsefont textfont $textfont
8511 eval font create textfont [fontflags textfont]
8512 eval font create textfontbold [fontflags textfont 1]
8514 parsefont uifont $uifont
8515 eval font create uifont [fontflags uifont]
8519 # check that we can find a .git directory somewhere...
8520 if {[catch {set gitdir [gitdir]}]} {
8521 show_error {} . [mc "Cannot find a git repository here."]
8524 if {![file isdirectory $gitdir]} {
8525 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8531 set cmdline_files {}
8536 "-d" { set datemode 1 }
8539 lappend revtreeargs $arg
8542 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8546 lappend revtreeargs $arg
8552 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8553 # no -- on command line, but some arguments (other than -d)
8555 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8556 set cmdline_files [split $f "\n"]
8557 set n [llength $cmdline_files]
8558 set revtreeargs [lrange $revtreeargs 0 end-$n]
8559 # Unfortunately git rev-parse doesn't produce an error when
8560 # something is both a revision and a filename. To be consistent
8561 # with git log and git rev-list, check revtreeargs for filenames.
8562 foreach arg $revtreeargs {
8563 if {[file exists $arg]} {
8564 show_error {} . [mc "Ambiguous argument '%s': both revision\
8570 # unfortunately we get both stdout and stderr in $err,
8571 # so look for "fatal:".
8572 set i [string first "fatal:" $err]
8574 set err [string range $err [expr {$i + 6}] end]
8576 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8582 # find the list of unmerged files
8586 set fd [open "| git ls-files -u" r]
8588 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8591 while {[gets $fd line] >= 0} {
8592 set i [string first "\t" $line]
8593 if {$i < 0} continue
8594 set fname [string range $line [expr {$i+1}] end]
8595 if {[lsearch -exact $mlist $fname] >= 0} continue
8597 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8598 lappend mlist $fname
8603 if {$nr_unmerged == 0} {
8604 show_error {} . [mc "No files selected: --merge specified but\
8605 no files are unmerged."]
8607 show_error {} . [mc "No files selected: --merge specified but\
8608 no unmerged files are within file limit."]
8612 set cmdline_files $mlist
8615 set nullid "0000000000000000000000000000000000000000"
8616 set nullid2 "0000000000000000000000000000000000000001"
8618 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8625 set highlight_paths {}
8627 set searchdirn -forwards
8631 set markingmatches 0
8632 set linkentercount 0
8633 set need_redisplay 0
8640 set selectedhlview [mc "None"]
8641 set highlight_related [mc "None"]
8642 set highlight_files {}
8656 # wait for the window to become visible
8658 wm title . "[file tail $argv0]: [file tail [pwd]]"
8661 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8662 # create a view for the files/dirs specified on the command line
8666 set viewname(1) [mc "Command line"]
8667 set viewfiles(1) $cmdline_files
8668 set viewargs(1) $revtreeargs
8671 .bar.view entryconf [mc "Edit view..."] -state normal
8672 .bar.view entryconf [mc "Delete view"] -state normal
8675 if {[info exists permviews]} {
8676 foreach v $permviews {
8679 set viewname($n) [lindex $v 0]
8680 set viewfiles($n) [lindex $v 1]
8681 set viewargs($n) [lindex $v 2]