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] {
249 set ids
[string range
$ids 1 end
]
253 if {[string length
$id] != 40} {
261 if {[string length
$shortcmit] > 80} {
262 set shortcmit
"[string range $shortcmit 0 80]..."
264 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
267 set id [lindex $ids 0]
268 if {![info exists ordertok($view,$id)]} {
269 set otok "o[strrep $vnextroot($view)]"
270 incr vnextroot($view)
271 set ordertok($view,$id) $otok
273 set otok $ordertok($view,$id)
274 unset idpending($view,$id)
277 set olds [lrange $ids 1 end]
278 if {[llength $olds] == 1} {
279 set p [lindex $olds 0]
280 lappend children($view,$p) $id
281 if {![info exists ordertok($view,$p)]} {
282 set ordertok($view,$p) $ordertok($view,$id)
283 set idpending($view,$p) 1
288 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
289 lappend children($view,$p) $id
291 if {![info exists ordertok($view,$p)]} {
292 set ordertok($view,$p) "$otok[strrep $i]]"
293 set idpending($view,$p) 1
301 if {![info exists children($view,$id)]} {
302 set children($view,$id) {}
304 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
305 set commitrow($view,$id) $commitidx($view)
306 incr commitidx($view)
307 if {$view == $curview} {
308 lappend parentlist $olds
309 lappend displayorder $id
310 lappend commitlisted $listed
312 lappend vparentlist($view) $olds
313 lappend vdisporder($view) $id
314 lappend vcmitlisted($view) $listed
316 if {[info exists commitinterest($id)]} {
317 foreach script $commitinterest($id) {
318 eval [string map [list "%I" $id] $script]
320 unset commitinterest($id)
325 run chewcommits $view
326 if {$view == $curview} {
327 # update progress bar
328 global progressdirn progresscoords proglastnc
329 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
330 set proglastnc $commitidx($view)
331 set l [lindex $progresscoords 0]
332 set r [lindex $progresscoords 1]
334 set r [expr {$r + $inc}]
340 set l [expr {$r - 0.2}]
343 set l [expr {$l - $inc}]
348 set r [expr {$l + 0.2}]
350 set progresscoords [list $l $r]
357 proc chewcommits {view} {
358 global curview hlview viewcomplete
359 global selectedline pending_select
361 if {$view == $curview} {
363 if {$viewcomplete($view)} {
364 global displayorder commitidx phase
365 global numcommits startmsecs
367 if {[info exists pending_select]} {
368 set row [first_real_row]
371 if {$commitidx($curview) > 0} {
372 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
373 #puts "overall $ms ms for $numcommits commits"
375 show_status [mc "No commits selected"]
381 if {[info exists hlview] && $view == $hlview} {
387 proc readcommit {id} {
388 if {[catch {set contents [exec git cat-file commit $id]}]} return
389 parsecommit $id $contents 0
392 proc updatecommits {} {
393 global viewdata curview phase displayorder ordertok idpending
394 global children commitrow selectedline thickerline showneartags
401 foreach id $displayorder {
402 catch {unset children($n,$id)}
403 catch {unset commitrow($n,$id)}
404 catch {unset ordertok($n,$id)}
406 foreach vid [array names idpending "$n,*"] {
407 unset idpending($vid)
410 catch {unset selectedline}
411 catch {unset thickerline}
412 catch {unset viewdata($n)}
421 proc parsecommit {id contents listed} {
422 global commitinfo cdate
431 set hdrend [string first "\n\n" $contents]
433 # should never happen...
434 set hdrend [string length $contents]
436 set header [string range $contents 0 [expr {$hdrend - 1}]]
437 set comment [string range $contents [expr {$hdrend + 2}] end]
438 foreach line [split $header "\n"] {
439 set tag [lindex $line 0]
440 if {$tag == "author"} {
441 set audate [lindex $line end-1]
442 set auname [lrange $line 1 end-2]
443 } elseif {$tag == "committer"} {
444 set comdate [lindex $line end-1]
445 set comname [lrange $line 1 end-2]
449 # take the first non-blank line of the comment as the headline
450 set headline [string trimleft $comment]
451 set i [string first "\n" $headline]
453 set headline [string range $headline 0 $i]
455 set headline [string trimright $headline]
456 set i [string first "\r" $headline]
458 set headline [string trimright [string range $headline 0 $i]]
461 # git rev-list indents the comment by 4 spaces;
462 # if we got this via git cat-file, add the indentation
464 foreach line [split $comment "\n"] {
465 append newcomment " "
466 append newcomment $line
467 append newcomment "\n"
469 set comment $newcomment
471 if {$comdate != {}} {
472 set cdate($id) $comdate
474 set commitinfo($id) [list $headline $auname $audate \
475 $comname $comdate $comment]
478 proc getcommit {id} {
479 global commitdata commitinfo
481 if {[info exists commitdata($id)]} {
482 parsecommit $id $commitdata($id) 1
485 if {![info exists commitinfo($id)]} {
486 set commitinfo($id) [list [mc "No commit information available"]]
493 global tagids idtags headids idheads tagobjid
494 global otherrefids idotherrefs mainhead mainheadid
496 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
499 set refd [open [list | git show-ref -d] r]
500 while {[gets $refd line] >= 0} {
501 if {[string index $line 40] ne " "} continue
502 set id [string range $line 0 39]
503 set ref [string range $line 41 end]
504 if {![string match "refs/*" $ref]} continue
505 set name [string range $ref 5 end]
506 if {[string match "remotes/*" $name]} {
507 if {![string match "*/HEAD" $name]} {
508 set headids($name) $id
509 lappend idheads($id) $name
511 } elseif {[string match "heads/*" $name]} {
512 set name [string range $name 6 end]
513 set headids($name) $id
514 lappend idheads($id) $name
515 } elseif {[string match "tags/*" $name]} {
516 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
517 # which is what we want since the former is the commit ID
518 set name [string range $name 5 end]
519 if {[string match "*^{}" $name]} {
520 set name [string range $name 0 end-3]
522 set tagobjid($name) $id
524 set tagids($name) $id
525 lappend idtags($id) $name
527 set otherrefids($name) $id
528 lappend idotherrefs($id) $name
535 set thehead [exec git symbolic-ref HEAD]
536 if {[string match "refs/heads/*" $thehead]} {
537 set mainhead [string range $thehead 11 end]
538 if {[info exists headids($mainhead)]} {
539 set mainheadid $headids($mainhead)
545 # skip over fake commits
546 proc first_real_row {} {
547 global nullid nullid2 displayorder numcommits
549 for {set row 0} {$row < $numcommits} {incr row} {
550 set id [lindex $displayorder $row]
551 if {$id ne $nullid && $id ne $nullid2} {
558 # update things for a head moved to a child of its previous location
559 proc movehead {id name} {
560 global headids idheads
562 removehead $headids($name) $name
563 set headids($name) $id
564 lappend idheads($id) $name
567 # update things when a head has been removed
568 proc removehead {id name} {
569 global headids idheads
571 if {$idheads($id) eq $name} {
574 set i [lsearch -exact $idheads($id) $name]
576 set idheads($id) [lreplace $idheads($id) $i $i]
582 proc show_error {w top msg} {
583 message $w.m -text $msg -justify center -aspect 400
584 pack $w.m -side top -fill x -padx 20 -pady 20
585 button $w.ok -text [mc OK] -command "destroy $top"
586 pack $w.ok -side bottom -fill x
587 bind $top <Visibility> "grab $top; focus $top"
588 bind $top <Key-Return> "destroy $top"
592 proc error_popup msg {
596 show_error $w $w $msg
599 proc confirm_popup msg {
605 message $w.m -text $msg -justify center -aspect 400
606 pack $w.m -side top -fill x -padx 20 -pady 20
607 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text [mc Cancel] -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
617 option add *Panedwindow.showHandle 1 startupFile
618 option add *Panedwindow.sashRelief raised startupFile
619 option add *Button.font uifont startupFile
620 option add *Checkbutton.font uifont startupFile
621 option add *Radiobutton.font uifont startupFile
622 option add *Menu.font uifont startupFile
623 option add *Menubutton.font uifont startupFile
624 option add *Label.font uifont startupFile
625 option add *Message.font uifont startupFile
626 option add *Entry.font uifont startupFile
630 global canv canv2 canv3 linespc charspc ctext cflist
632 global findtype findtypemenu findloc findstring fstring geometry
633 global entries sha1entry sha1string sha1but
634 global diffcontextstring diffcontext
636 global maincursor textcursor curtextcursor
637 global rowctxmenu fakerowmenu mergemax wrapcomment
638 global highlight_files gdttype
639 global searchstring sstring
640 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
641 global headctxmenu progresscanv progressitem progresscoords statusw
642 global fprogitem fprogcoord lastprogupdate progupdatepending
643 global rprogitem rprogcoord
647 .bar add cascade -label [mc "File"] -menu .bar.file
649 .bar.file add command -label [mc "Update"] -command updatecommits
650 .bar.file add command -label [mc "Reread references"] -command rereadrefs
651 .bar.file add command -label [mc "List references"] -command showrefs
652 .bar.file add command -label [mc "Quit"] -command doquit
654 .bar add cascade -label [mc "Edit"] -menu .bar.edit
655 .bar.edit add command -label [mc "Preferences"] -command doprefs
658 .bar add cascade -label [mc "View"] -menu .bar.view
659 .bar.view add command -label [mc "New view..."] -command {newview 0}
660 .bar.view add command -label [mc "Edit view..."] -command editview \
662 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
663 .bar.view add separator
664 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
665 -variable selectedview -value 0
668 .bar add cascade -label [mc "Help"] -menu .bar.help
669 .bar.help add command -label [mc "About gitk"] -command about
670 .bar.help add command -label [mc "Key bindings"] -command keys
672 . configure -menu .bar
674 # the gui has upper and lower half, parts of a paned window.
675 panedwindow .ctop -orient vertical
677 # possibly use assumed geometry
678 if {![info exists geometry(pwsash0)]} {
679 set geometry(topheight) [expr {15 * $linespc}]
680 set geometry(topwidth) [expr {80 * $charspc}]
681 set geometry(botheight) [expr {15 * $linespc}]
682 set geometry(botwidth) [expr {50 * $charspc}]
683 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
684 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
687 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
688 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
690 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
692 # create three canvases
693 set cscroll .tf.histframe.csb
694 set canv .tf.histframe.pwclist.canv
696 -selectbackground $selectbgcolor \
697 -background $bgcolor -bd 0 \
698 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
699 .tf.histframe.pwclist add $canv
700 set canv2 .tf.histframe.pwclist.canv2
702 -selectbackground $selectbgcolor \
703 -background $bgcolor -bd 0 -yscrollincr $linespc
704 .tf.histframe.pwclist add $canv2
705 set canv3 .tf.histframe.pwclist.canv3
707 -selectbackground $selectbgcolor \
708 -background $bgcolor -bd 0 -yscrollincr $linespc
709 .tf.histframe.pwclist add $canv3
710 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
711 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
713 # a scroll bar to rule them
714 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
715 pack $cscroll -side right -fill y
716 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
717 lappend bglist $canv $canv2 $canv3
718 pack .tf.histframe.pwclist -fill both -expand 1 -side left
720 # we have two button bars at bottom of top frame. Bar 1
722 frame .tf.lbar -height 15
724 set sha1entry .tf.bar.sha1
725 set entries $sha1entry
726 set sha1but .tf.bar.sha1label
727 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
728 -command gotocommit -width 8
729 $sha1but conf -disabledforeground [$sha1but cget -foreground]
730 pack .tf.bar.sha1label -side left
731 entry $sha1entry -width 40 -font textfont -textvariable sha1string
732 trace add variable sha1string write sha1change
733 pack $sha1entry -side left -pady 2
735 image create bitmap bm-left -data {
736 #define left_width 16
737 #define left_height 16
738 static unsigned char left_bits[] = {
739 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
740 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
741 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
743 image create bitmap bm-right -data {
744 #define right_width 16
745 #define right_height 16
746 static unsigned char right_bits[] = {
747 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
748 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
749 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
751 button .tf.bar.leftbut -image bm-left -command goback \
752 -state disabled -width 26
753 pack .tf.bar.leftbut -side left -fill y
754 button .tf.bar.rightbut -image bm-right -command goforw \
755 -state disabled -width 26
756 pack .tf.bar.rightbut -side left -fill y
758 # Status label and progress bar
759 set statusw .tf.bar.status
760 label $statusw -width 15 -relief sunken
761 pack $statusw -side left -padx 5
762 set h [expr {[font metrics uifont -linespace] + 2}]
763 set progresscanv .tf.bar.progress
764 canvas $progresscanv -relief sunken -height $h -borderwidth 2
765 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
766 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
767 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
768 pack $progresscanv -side right -expand 1 -fill x
769 set progresscoords {0 0}
772 bind $progresscanv <Configure> adjustprogress
773 set lastprogupdate [clock clicks -milliseconds]
774 set progupdatepending 0
776 # build up the bottom bar of upper window
777 label .tf.lbar.flabel -text "[mc "Find"] "
778 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
779 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
780 label .tf.lbar.flab2 -text " [mc "commit"] "
781 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
783 set gdttype [mc "containing:"]
784 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
786 [mc "touching paths:"] \
787 [mc "adding/removing string:"]]
788 trace add variable gdttype write gdttype_change
789 pack .tf.lbar.gdttype -side left -fill y
792 set fstring .tf.lbar.findstring
793 lappend entries $fstring
794 entry $fstring -width 30 -font textfont -textvariable findstring
795 trace add variable findstring write find_change
796 set findtype [mc "Exact"]
797 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
798 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
799 trace add variable findtype write findcom_change
800 set findloc [mc "All fields"]
801 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
802 [mc "Comments"] [mc "Author"] [mc "Committer"]
803 trace add variable findloc write find_change
804 pack .tf.lbar.findloc -side right
805 pack .tf.lbar.findtype -side right
806 pack $fstring -side left -expand 1 -fill x
808 # Finish putting the upper half of the viewer together
809 pack .tf.lbar -in .tf -side bottom -fill x
810 pack .tf.bar -in .tf -side bottom -fill x
811 pack .tf.histframe -fill both -side top -expand 1
813 .ctop paneconfigure .tf -height $geometry(topheight)
814 .ctop paneconfigure .tf -width $geometry(topwidth)
816 # now build up the bottom
817 panedwindow .pwbottom -orient horizontal
819 # lower left, a text box over search bar, scroll bar to the right
820 # if we know window height, then that will set the lower text height, otherwise
821 # we set lower text height which will drive window height
822 if {[info exists geometry(main)]} {
823 frame .bleft -width $geometry(botwidth)
825 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
830 button .bleft.top.search -text [mc "Search"] -command dosearch
831 pack .bleft.top.search -side left -padx 5
832 set sstring .bleft.top.sstring
833 entry $sstring -width 20 -font textfont -textvariable searchstring
834 lappend entries $sstring
835 trace add variable searchstring write incrsearch
836 pack $sstring -side left -expand 1 -fill x
837 radiobutton .bleft.mid.diff -text [mc "Diff"] \
838 -command changediffdisp -variable diffelide -value {0 0}
839 radiobutton .bleft.mid.old -text [mc "Old version"] \
840 -command changediffdisp -variable diffelide -value {0 1}
841 radiobutton .bleft.mid.new -text [mc "New version"] \
842 -command changediffdisp -variable diffelide -value {1 0}
843 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
844 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
845 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
846 -from 1 -increment 1 -to 10000000 \
847 -validate all -validatecommand "diffcontextvalidate %P" \
848 -textvariable diffcontextstring
849 .bleft.mid.diffcontext set $diffcontext
850 trace add variable diffcontextstring write diffcontextchange
851 lappend entries .bleft.mid.diffcontext
852 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
853 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
854 -command changeignorespace -variable ignorespace
855 pack .bleft.mid.ignspace -side left -padx 5
856 set ctext .bleft.ctext
857 text $ctext -background $bgcolor -foreground $fgcolor \
858 -state disabled -font textfont \
859 -yscrollcommand scrolltext -wrap none
861 $ctext conf -tabstyle wordprocessor
863 scrollbar .bleft.sb -command "$ctext yview"
864 pack .bleft.top -side top -fill x
865 pack .bleft.mid -side top -fill x
866 pack .bleft.sb -side right -fill y
867 pack $ctext -side left -fill both -expand 1
868 lappend bglist $ctext
869 lappend fglist $ctext
871 $ctext tag conf comment -wrap $wrapcomment
872 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
873 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
874 $ctext tag conf d0 -fore [lindex $diffcolors 0]
875 $ctext tag conf d1 -fore [lindex $diffcolors 1]
876 $ctext tag conf m0 -fore red
877 $ctext tag conf m1 -fore blue
878 $ctext tag conf m2 -fore green
879 $ctext tag conf m3 -fore purple
880 $ctext tag conf m4 -fore brown
881 $ctext tag conf m5 -fore "#009090"
882 $ctext tag conf m6 -fore magenta
883 $ctext tag conf m7 -fore "#808000"
884 $ctext tag conf m8 -fore "#009000"
885 $ctext tag conf m9 -fore "#ff0080"
886 $ctext tag conf m10 -fore cyan
887 $ctext tag conf m11 -fore "#b07070"
888 $ctext tag conf m12 -fore "#70b0f0"
889 $ctext tag conf m13 -fore "#70f0b0"
890 $ctext tag conf m14 -fore "#f0b070"
891 $ctext tag conf m15 -fore "#ff70b0"
892 $ctext tag conf mmax -fore darkgrey
894 $ctext tag conf mresult -font textfontbold
895 $ctext tag conf msep -font textfontbold
896 $ctext tag conf found -back yellow
899 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
904 radiobutton .bright.mode.patch -text [mc "Patch"] \
905 -command reselectline -variable cmitmode -value "patch"
906 radiobutton .bright.mode.tree -text [mc "Tree"] \
907 -command reselectline -variable cmitmode -value "tree"
908 grid .bright.mode.patch .bright.mode.tree -sticky ew
909 pack .bright.mode -side top -fill x
910 set cflist .bright.cfiles
911 set indent [font measure mainfont "nn"]
913 -selectbackground $selectbgcolor \
914 -background $bgcolor -foreground $fgcolor \
916 -tabs [list $indent [expr {2 * $indent}]] \
917 -yscrollcommand ".bright.sb set" \
918 -cursor [. cget -cursor] \
919 -spacing1 1 -spacing3 1
920 lappend bglist $cflist
921 lappend fglist $cflist
922 scrollbar .bright.sb -command "$cflist yview"
923 pack .bright.sb -side right -fill y
924 pack $cflist -side left -fill both -expand 1
925 $cflist tag configure highlight \
926 -background [$cflist cget -selectbackground]
927 $cflist tag configure bold -font mainfontbold
929 .pwbottom add .bright
932 # restore window position if known
933 if {[info exists geometry(main)]} {
934 wm geometry . "$geometry(main)"
937 if {[tk windowingsystem] eq {aqua}} {
943 bind .pwbottom <Configure> {resizecdetpanes %W %w}
944 pack .ctop -fill both -expand 1
945 bindall <1> {selcanvline %W %x %y}
946 #bindall <B1-Motion> {selcanvline %W %x %y}
947 if {[tk windowingsystem] == "win32"} {
948 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
949 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
951 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
952 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
953 if {[tk windowingsystem] eq "aqua"} {
954 bindall <MouseWheel> {
955 set delta [expr {- (%D)}]
956 allcanvs yview scroll $delta units
960 bindall <2> "canvscan mark %W %x %y"
961 bindall <B2-Motion> "canvscan dragto %W %x %y"
962 bindkey <Home> selfirstline
963 bindkey <End> sellastline
964 bind . <Key-Up> "selnextline -1"
965 bind . <Key-Down> "selnextline 1"
966 bind . <Shift-Key-Up> "dofind -1 0"
967 bind . <Shift-Key-Down> "dofind 1 0"
968 bindkey <Key-Right> "goforw"
969 bindkey <Key-Left> "goback"
970 bind . <Key-Prior> "selnextpage -1"
971 bind . <Key-Next> "selnextpage 1"
972 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
973 bind . <$M1B-End> "allcanvs yview moveto 1.0"
974 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
975 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
976 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
977 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
978 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
979 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
980 bindkey <Key-space> "$ctext yview scroll 1 pages"
981 bindkey p "selnextline -1"
982 bindkey n "selnextline 1"
985 bindkey i "selnextline -1"
986 bindkey k "selnextline 1"
989 bindkey b "$ctext yview scroll -1 pages"
990 bindkey d "$ctext yview scroll 18 units"
991 bindkey u "$ctext yview scroll -18 units"
992 bindkey / {dofind 1 1}
993 bindkey <Key-Return> {dofind 1 1}
994 bindkey ? {dofind -1 1}
996 bindkey <F5> updatecommits
997 bind . <$M1B-q> doquit
998 bind . <$M1B-f> {dofind 1 1}
999 bind . <$M1B-g> {dofind 1 0}
1000 bind . <$M1B-r> dosearchback
1001 bind . <$M1B-s> dosearch
1002 bind . <$M1B-equal> {incrfont 1}
1003 bind . <$M1B-plus> {incrfont 1}
1004 bind . <$M1B-KP_Add> {incrfont 1}
1005 bind . <$M1B-minus> {incrfont -1}
1006 bind . <$M1B-KP_Subtract> {incrfont -1}
1007 wm protocol . WM_DELETE_WINDOW doquit
1008 bind . <Button-1> "click %W"
1009 bind $fstring <Key-Return> {dofind 1 1}
1010 bind $sha1entry <Key-Return> gotocommit
1011 bind $sha1entry <<PasteSelection>> clearsha1
1012 bind $cflist <1> {sel_flist %W %x %y; break}
1013 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1014 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1015 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1017 set maincursor [. cget -cursor]
1018 set textcursor [$ctext cget -cursor]
1019 set curtextcursor $textcursor
1021 set rowctxmenu .rowctxmenu
1022 menu $rowctxmenu -tearoff 0
1023 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1024 -command {diffvssel 0}
1025 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1026 -command {diffvssel 1}
1027 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1028 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1029 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1030 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1031 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1033 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1036 set fakerowmenu .fakerowmenu
1037 menu $fakerowmenu -tearoff 0
1038 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1039 -command {diffvssel 0}
1040 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1041 -command {diffvssel 1}
1042 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1043 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1044 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1045 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1047 set headctxmenu .headctxmenu
1048 menu $headctxmenu -tearoff 0
1049 $headctxmenu add command -label [mc "Check out this branch"] \
1051 $headctxmenu add command -label [mc "Remove this branch"] \
1055 set flist_menu .flistctxmenu
1056 menu $flist_menu -tearoff 0
1057 $flist_menu add command -label [mc "Highlight this too"] \
1058 -command {flist_hl 0}
1059 $flist_menu add command -label [mc "Highlight this only"] \
1060 -command {flist_hl 1}
1063 # Windows sends all mouse wheel events to the current focused window, not
1064 # the one where the mouse hovers, so bind those events here and redirect
1065 # to the correct window
1066 proc windows_mousewheel_redirector {W X Y D} {
1067 global canv canv2 canv3
1068 set w [winfo containing -displayof $W $X $Y]
1070 set u [expr {$D < 0 ? 5 : -5}]
1071 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1072 allcanvs yview scroll $u units
1075 $w yview scroll $u units
1081 # mouse-2 makes all windows scan vertically, but only the one
1082 # the cursor is in scans horizontally
1083 proc canvscan {op w x y} {
1084 global canv canv2 canv3
1085 foreach c [list $canv $canv2 $canv3] {
1094 proc scrollcanv {cscroll f0 f1} {
1095 $cscroll set $f0 $f1
1100 # when we make a key binding for the toplevel, make sure
1101 # it doesn't get triggered when that key is pressed
in the
1102 # find string entry widget.
1103 proc bindkey
{ev
script} {
1106 set escript
[bind Entry
$ev]
1107 if {$escript == {}} {
1108 set escript
[bind Entry
<Key
>]
1110 foreach e
$entries {
1111 bind $e $ev "$escript; break"
1115 # set the focus back to the toplevel for any click outside
1118 global ctext entries
1119 foreach e
[concat
$entries $ctext] {
1120 if {$w == $e} return
1125 # Adjust the progress bar for a change in requested extent or canvas size
1126 proc adjustprogress
{} {
1127 global progresscanv progressitem progresscoords
1128 global fprogitem fprogcoord lastprogupdate progupdatepending
1129 global rprogitem rprogcoord
1131 set w
[expr {[winfo width
$progresscanv] - 4}]
1132 set x0
[expr {$w * [lindex
$progresscoords 0]}]
1133 set x1
[expr {$w * [lindex
$progresscoords 1]}]
1134 set h
[winfo height
$progresscanv]
1135 $progresscanv coords
$progressitem $x0 0 $x1 $h
1136 $progresscanv coords
$fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1137 $progresscanv coords
$rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1138 set now
[clock clicks
-milliseconds]
1139 if {$now >= $lastprogupdate + 100} {
1140 set progupdatepending
0
1142 } elseif
{!$progupdatepending} {
1143 set progupdatepending
1
1144 after
[expr {$lastprogupdate + 100 - $now}] doprogupdate
1148 proc doprogupdate
{} {
1149 global lastprogupdate progupdatepending
1151 if {$progupdatepending} {
1152 set progupdatepending
0
1153 set lastprogupdate
[clock clicks
-milliseconds]
1158 proc savestuff
{w
} {
1159 global canv canv2 canv3 mainfont textfont uifont tabstop
1160 global stuffsaved findmergefiles maxgraphpct
1161 global maxwidth showneartags showlocalchanges
1162 global viewname viewfiles viewargs viewperm nextviewnum
1163 global cmitmode wrapcomment datetimeformat limitdiffs
1164 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1166 if {$stuffsaved} return
1167 if {![winfo viewable .
]} return
1169 set f
[open
"~/.gitk-new" w
]
1170 puts
$f [list
set mainfont
$mainfont]
1171 puts
$f [list
set textfont
$textfont]
1172 puts
$f [list
set uifont
$uifont]
1173 puts
$f [list
set tabstop
$tabstop]
1174 puts
$f [list
set findmergefiles
$findmergefiles]
1175 puts
$f [list
set maxgraphpct
$maxgraphpct]
1176 puts
$f [list
set maxwidth
$maxwidth]
1177 puts
$f [list
set cmitmode
$cmitmode]
1178 puts
$f [list
set wrapcomment
$wrapcomment]
1179 puts
$f [list
set showneartags
$showneartags]
1180 puts
$f [list
set showlocalchanges
$showlocalchanges]
1181 puts
$f [list
set datetimeformat
$datetimeformat]
1182 puts
$f [list
set limitdiffs
$limitdiffs]
1183 puts
$f [list
set bgcolor
$bgcolor]
1184 puts
$f [list
set fgcolor
$fgcolor]
1185 puts
$f [list
set colors
$colors]
1186 puts
$f [list
set diffcolors
$diffcolors]
1187 puts
$f [list
set diffcontext
$diffcontext]
1188 puts
$f [list
set selectbgcolor
$selectbgcolor]
1190 puts
$f "set geometry(main) [wm geometry .]"
1191 puts
$f "set geometry(topwidth) [winfo width .tf]"
1192 puts
$f "set geometry(topheight) [winfo height .tf]"
1193 puts
$f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1194 puts
$f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1195 puts
$f "set geometry(botwidth) [winfo width .bleft]"
1196 puts
$f "set geometry(botheight) [winfo height .bleft]"
1198 puts
-nonewline $f "set permviews {"
1199 for {set v
0} {$v < $nextviewnum} {incr v
} {
1200 if {$viewperm($v)} {
1201 puts
$f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1206 file rename
-force "~/.gitk-new" "~/.gitk"
1211 proc resizeclistpanes
{win w
} {
1213 if {[info exists oldwidth
($win)]} {
1214 set s0
[$win sash coord
0]
1215 set s1
[$win sash coord
1]
1217 set sash0
[expr {int
($w/2 - 2)}]
1218 set sash1
[expr {int
($w*5/6 - 2)}]
1220 set factor [expr {1.0 * $w / $oldwidth($win)}]
1221 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1222 set sash1
[expr {int
($factor * [lindex
$s1 0])}]
1226 if {$sash1 < $sash0 + 20} {
1227 set sash1
[expr {$sash0 + 20}]
1229 if {$sash1 > $w - 10} {
1230 set sash1
[expr {$w - 10}]
1231 if {$sash0 > $sash1 - 20} {
1232 set sash0
[expr {$sash1 - 20}]
1236 $win sash place
0 $sash0 [lindex
$s0 1]
1237 $win sash place
1 $sash1 [lindex
$s1 1]
1239 set oldwidth
($win) $w
1242 proc resizecdetpanes
{win w
} {
1244 if {[info exists oldwidth
($win)]} {
1245 set s0
[$win sash coord
0]
1247 set sash0
[expr {int
($w*3/4 - 2)}]
1249 set factor [expr {1.0 * $w / $oldwidth($win)}]
1250 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1254 if {$sash0 > $w - 15} {
1255 set sash0
[expr {$w - 15}]
1258 $win sash place
0 $sash0 [lindex
$s0 1]
1260 set oldwidth
($win) $w
1263 proc allcanvs args
{
1264 global canv canv2 canv3
1270 proc bindall
{event action
} {
1271 global canv canv2 canv3
1272 bind $canv $event $action
1273 bind $canv2 $event $action
1274 bind $canv3 $event $action
1280 if {[winfo exists
$w]} {
1285 wm title
$w [mc
"About gitk"]
1286 message
$w.m
-text [mc
"
1287 Gitk - a commit viewer for git
1289 Copyright © 2005-2006 Paul Mackerras
1291 Use and redistribute under the terms of the GNU General Public License"] \
1292 -justify center
-aspect 400 -border 2 -bg white
-relief groove
1293 pack
$w.m
-side top
-fill x
-padx 2 -pady 2
1294 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1295 pack
$w.ok
-side bottom
1296 bind $w <Visibility
> "focus $w.ok"
1297 bind $w <Key-Escape
> "destroy $w"
1298 bind $w <Key-Return
> "destroy $w"
1303 if {[winfo exists
$w]} {
1307 if {[tk windowingsystem
] eq
{aqua
}} {
1313 wm title
$w [mc
"Gitk key bindings"]
1314 message
$w.m
-text "
1315 [mc "Gitk key bindings
:"]
1317 [mc "<%s-Q
> Quit
" $M1T]
1318 [mc "<Home
> Move to first commit
"]
1319 [mc "<End
> Move to last commit
"]
1320 [mc "<Up
>, p
, i Move up one commit
"]
1321 [mc "<Down
>, n
, k Move down one commit
"]
1322 [mc "<Left
>, z
, j Go back
in history list
"]
1323 [mc "<Right
>, x
, l Go forward
in history list
"]
1324 [mc "<PageUp
> Move up one page
in commit list
"]
1325 [mc "<PageDown
> Move down one page
in commit list
"]
1326 [mc "<%s-Home
> Scroll to top of commit list
" $M1T]
1327 [mc "<%s-End
> Scroll to bottom of commit list
" $M1T]
1328 [mc "<%s-Up
> Scroll commit list up one line
" $M1T]
1329 [mc "<%s-Down
> Scroll commit list down one line
" $M1T]
1330 [mc "<%s-PageUp
> Scroll commit list up one page
" $M1T]
1331 [mc "<%s-PageDown
> Scroll commit list down one page
" $M1T]
1332 [mc "<Shift-Up
> Find backwards
(upwards
, later commits
)"]
1333 [mc "<Shift-Down
> Find forwards
(downwards
, earlier commits
)"]
1334 [mc "<Delete
>, b Scroll
diff view up one page
"]
1335 [mc "<Backspace
> Scroll
diff view up one page
"]
1336 [mc "<Space
> Scroll
diff view down one page
"]
1337 [mc "u Scroll
diff view up
18 lines
"]
1338 [mc "d Scroll
diff view down
18 lines
"]
1339 [mc "<%s-F
> Find
" $M1T]
1340 [mc "<%s-G
> Move to next
find hit
" $M1T]
1341 [mc "<Return
> Move to next
find hit
"]
1342 [mc "/ Move to next
find hit
, or redo
find"]
1343 [mc "? Move to previous
find hit
"]
1344 [mc "f Scroll
diff view to next
file"]
1345 [mc "<%s-S
> Search
for next hit
in diff view
" $M1T]
1346 [mc "<%s-R
> Search
for previous hit
in diff view
" $M1T]
1347 [mc "<%s-KP
+> Increase font size
" $M1T]
1348 [mc "<%s-plus
> Increase font size
" $M1T]
1349 [mc "<%s-KP-
> Decrease font size
" $M1T]
1350 [mc "<%s-minus
> Decrease font size
" $M1T]
1353 -justify left
-bg white
-border 2 -relief groove
1354 pack
$w.m
-side top
-fill both
-padx 2 -pady 2
1355 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1356 pack
$w.ok
-side bottom
1357 bind $w <Visibility
> "focus $w.ok"
1358 bind $w <Key-Escape
> "destroy $w"
1359 bind $w <Key-Return
> "destroy $w"
1362 # Procedures for manipulating the file list window at the
1363 # bottom right of the overall window.
1365 proc treeview
{w l openlevs
} {
1366 global treecontents treediropen treeheight treeparent treeindex
1376 set treecontents
() {}
1377 $w conf
-state normal
1379 while {[string range
$f 0 $prefixend] ne
$prefix} {
1380 if {$lev <= $openlevs} {
1381 $w mark
set e
:$treeindex($prefix) "end -1c"
1382 $w mark gravity e
:$treeindex($prefix) left
1384 set treeheight
($prefix) $ht
1385 incr ht
[lindex
$htstack end
]
1386 set htstack
[lreplace
$htstack end end
]
1387 set prefixend
[lindex
$prefendstack end
]
1388 set prefendstack
[lreplace
$prefendstack end end
]
1389 set prefix
[string range
$prefix 0 $prefixend]
1392 set tail [string range
$f [expr {$prefixend+1}] end
]
1393 while {[set slash
[string first
"/" $tail]] >= 0} {
1396 lappend prefendstack
$prefixend
1397 incr prefixend
[expr {$slash + 1}]
1398 set d
[string range
$tail 0 $slash]
1399 lappend treecontents
($prefix) $d
1400 set oldprefix
$prefix
1402 set treecontents
($prefix) {}
1403 set treeindex
($prefix) [incr ix
]
1404 set treeparent
($prefix) $oldprefix
1405 set tail [string range
$tail [expr {$slash+1}] end
]
1406 if {$lev <= $openlevs} {
1408 set treediropen
($prefix) [expr {$lev < $openlevs}]
1409 set bm
[expr {$lev == $openlevs?
"tri-rt": "tri-dn"}]
1410 $w mark
set d
:$ix "end -1c"
1411 $w mark gravity d
:$ix left
1413 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1415 $w image create end
-align center
-image $bm -padx 1 \
1417 $w insert end
$d [highlight_tag
$prefix]
1418 $w mark
set s
:$ix "end -1c"
1419 $w mark gravity s
:$ix left
1424 if {$lev <= $openlevs} {
1427 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1429 $w insert end
$tail [highlight_tag
$f]
1431 lappend treecontents
($prefix) $tail
1434 while {$htstack ne
{}} {
1435 set treeheight
($prefix) $ht
1436 incr ht
[lindex
$htstack end
]
1437 set htstack
[lreplace
$htstack end end
]
1438 set prefixend
[lindex
$prefendstack end
]
1439 set prefendstack
[lreplace
$prefendstack end end
]
1440 set prefix
[string range
$prefix 0 $prefixend]
1442 $w conf
-state disabled
1445 proc linetoelt
{l
} {
1446 global treeheight treecontents
1451 foreach e
$treecontents($prefix) {
1456 if {[string index
$e end
] eq
"/"} {
1457 set n
$treeheight($prefix$e)
1469 proc highlight_tree
{y prefix
} {
1470 global treeheight treecontents cflist
1472 foreach e
$treecontents($prefix) {
1474 if {[highlight_tag
$path] ne
{}} {
1475 $cflist tag add bold
$y.0 "$y.0 lineend"
1478 if {[string index
$e end
] eq
"/" && $treeheight($path) > 1} {
1479 set y
[highlight_tree
$y $path]
1485 proc treeclosedir
{w dir
} {
1486 global treediropen treeheight treeparent treeindex
1488 set ix
$treeindex($dir)
1489 $w conf
-state normal
1490 $w delete s
:$ix e
:$ix
1491 set treediropen
($dir) 0
1492 $w image configure a
:$ix -image tri-rt
1493 $w conf
-state disabled
1494 set n
[expr {1 - $treeheight($dir)}]
1495 while {$dir ne
{}} {
1496 incr treeheight
($dir) $n
1497 set dir
$treeparent($dir)
1501 proc treeopendir
{w dir
} {
1502 global treediropen treeheight treeparent treecontents treeindex
1504 set ix
$treeindex($dir)
1505 $w conf
-state normal
1506 $w image configure a
:$ix -image tri-dn
1507 $w mark
set e
:$ix s
:$ix
1508 $w mark gravity e
:$ix right
1511 set n
[llength
$treecontents($dir)]
1512 for {set x
$dir} {$x ne
{}} {set x
$treeparent($x)} {
1515 incr treeheight
($x) $n
1517 foreach e
$treecontents($dir) {
1519 if {[string index
$e end
] eq
"/"} {
1520 set iy
$treeindex($de)
1521 $w mark
set d
:$iy e
:$ix
1522 $w mark gravity d
:$iy left
1523 $w insert e
:$ix $str
1524 set treediropen
($de) 0
1525 $w image create e
:$ix -align center
-image tri-rt
-padx 1 \
1527 $w insert e
:$ix $e [highlight_tag
$de]
1528 $w mark
set s
:$iy e
:$ix
1529 $w mark gravity s
:$iy left
1530 set treeheight
($de) 1
1532 $w insert e
:$ix $str
1533 $w insert e
:$ix $e [highlight_tag
$de]
1536 $w mark gravity e
:$ix left
1537 $w conf
-state disabled
1538 set treediropen
($dir) 1
1539 set top
[lindex
[split [$w index @
0,0] .
] 0]
1540 set ht
[$w cget
-height]
1541 set l
[lindex
[split [$w index s
:$ix] .
] 0]
1544 } elseif
{$l + $n + 1 > $top + $ht} {
1545 set top
[expr {$l + $n + 2 - $ht}]
1553 proc treeclick
{w x y
} {
1554 global treediropen cmitmode ctext cflist cflist_top
1556 if {$cmitmode ne
"tree"} return
1557 if {![info exists cflist_top
]} return
1558 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1559 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1560 $cflist tag add highlight
$l.0 "$l.0 lineend"
1566 set e
[linetoelt
$l]
1567 if {[string index
$e end
] ne
"/"} {
1569 } elseif
{$treediropen($e)} {
1576 proc setfilelist
{id
} {
1577 global treefilelist cflist
1579 treeview
$cflist $treefilelist($id) 0
1582 image create bitmap tri-rt
-background black
-foreground blue
-data {
1583 #define tri-rt_width 13
1584 #define tri-rt_height 13
1585 static unsigned char tri-rt_bits
[] = {
1586 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1587 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1590 #define tri-rt-mask_width 13
1591 #define tri-rt-mask_height 13
1592 static unsigned char tri-rt-mask_bits
[] = {
1593 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1594 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1597 image create bitmap tri-dn
-background black
-foreground blue
-data {
1598 #define tri-dn_width 13
1599 #define tri-dn_height 13
1600 static unsigned char tri-dn_bits
[] = {
1601 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1602 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1605 #define tri-dn-mask_width 13
1606 #define tri-dn-mask_height 13
1607 static unsigned char tri-dn-mask_bits
[] = {
1608 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1609 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1613 image create bitmap reficon-T
-background black
-foreground yellow
-data {
1614 #define tagicon_width 13
1615 #define tagicon_height 9
1616 static unsigned char tagicon_bits
[] = {
1617 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1618 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1620 #define tagicon-mask_width 13
1621 #define tagicon-mask_height 9
1622 static unsigned char tagicon-mask_bits
[] = {
1623 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1624 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1627 #define headicon_width 13
1628 #define headicon_height 9
1629 static unsigned char headicon_bits
[] = {
1630 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1631 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1634 #define headicon-mask_width 13
1635 #define headicon-mask_height 9
1636 static unsigned char headicon-mask_bits
[] = {
1637 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1638 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1640 image create bitmap reficon-H
-background black
-foreground green \
1641 -data $rectdata -maskdata $rectmask
1642 image create bitmap reficon-o
-background black
-foreground "#ddddff" \
1643 -data $rectdata -maskdata $rectmask
1645 proc init_flist
{first
} {
1646 global cflist cflist_top selectedline difffilestart
1648 $cflist conf
-state normal
1649 $cflist delete
0.0 end
1651 $cflist insert end
$first
1653 $cflist tag add highlight
1.0 "1.0 lineend"
1655 catch
{unset cflist_top
}
1657 $cflist conf
-state disabled
1658 set difffilestart
{}
1661 proc highlight_tag
{f
} {
1662 global highlight_paths
1664 foreach p
$highlight_paths {
1665 if {[string match
$p $f]} {
1672 proc highlight_filelist
{} {
1673 global cmitmode cflist
1675 $cflist conf
-state normal
1676 if {$cmitmode ne
"tree"} {
1677 set end
[lindex
[split [$cflist index end
] .
] 0]
1678 for {set l
2} {$l < $end} {incr l
} {
1679 set line
[$cflist get
$l.0 "$l.0 lineend"]
1680 if {[highlight_tag
$line] ne
{}} {
1681 $cflist tag add bold
$l.0 "$l.0 lineend"
1687 $cflist conf
-state disabled
1690 proc unhighlight_filelist
{} {
1693 $cflist conf
-state normal
1694 $cflist tag remove bold
1.0 end
1695 $cflist conf
-state disabled
1698 proc add_flist
{fl
} {
1701 $cflist conf
-state normal
1703 $cflist insert end
"\n"
1704 $cflist insert end
$f [highlight_tag
$f]
1706 $cflist conf
-state disabled
1709 proc sel_flist
{w x y
} {
1710 global ctext difffilestart cflist cflist_top cmitmode
1712 if {$cmitmode eq
"tree"} return
1713 if {![info exists cflist_top
]} return
1714 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1715 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1716 $cflist tag add highlight
$l.0 "$l.0 lineend"
1721 catch
{$ctext yview
[lindex
$difffilestart [expr {$l - 2}]]}
1725 proc pop_flist_menu
{w X Y x y
} {
1726 global ctext cflist cmitmode flist_menu flist_menu_file
1727 global treediffs diffids
1730 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1732 if {$cmitmode eq
"tree"} {
1733 set e
[linetoelt
$l]
1734 if {[string index
$e end
] eq
"/"} return
1736 set e
[lindex
$treediffs($diffids) [expr {$l-2}]]
1738 set flist_menu_file
$e
1739 tk_popup
$flist_menu $X $Y
1742 proc flist_hl
{only
} {
1743 global flist_menu_file findstring gdttype
1745 set x
[shellquote
$flist_menu_file]
1746 if {$only ||
$findstring eq
{} ||
$gdttype ne
[mc
"touching paths:"]} {
1749 append findstring
" " $x
1751 set gdttype
[mc
"touching paths:"]
1754 # Functions for adding and removing shell-type quoting
1756 proc shellquote
{str
} {
1757 if {![string match
"*\['\"\\ \t]*" $str]} {
1760 if {![string match
"*\['\"\\]*" $str]} {
1763 if {![string match
"*'*" $str]} {
1766 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1769 proc shellarglist
{l
} {
1775 append str
[shellquote
$a]
1780 proc shelldequote
{str
} {
1785 if {![regexp
-start $used -indices "\['\"\\\\ \t]" $str first
]} {
1786 append ret
[string range
$str $used end
]
1787 set used
[string length
$str]
1790 set first
[lindex
$first 0]
1791 set ch
[string index
$str $first]
1792 if {$first > $used} {
1793 append ret
[string range
$str $used [expr {$first - 1}]]
1796 if {$ch eq
" " ||
$ch eq
"\t"} break
1799 set first
[string first
"'" $str $used]
1801 error
"unmatched single-quote"
1803 append ret
[string range
$str $used [expr {$first - 1}]]
1808 if {$used >= [string length
$str]} {
1809 error
"trailing backslash"
1811 append ret
[string index
$str $used]
1816 if {![regexp
-start $used -indices "\[\"\\\\]" $str first
]} {
1817 error
"unmatched double-quote"
1819 set first
[lindex
$first 0]
1820 set ch
[string index
$str $first]
1821 if {$first > $used} {
1822 append ret
[string range
$str $used [expr {$first - 1}]]
1825 if {$ch eq
"\""} break
1827 append ret
[string index
$str $used]
1831 return [list
$used $ret]
1834 proc shellsplit
{str
} {
1837 set str
[string trimleft
$str]
1838 if {$str eq
{}} break
1839 set dq
[shelldequote
$str]
1840 set n
[lindex
$dq 0]
1841 set word
[lindex
$dq 1]
1842 set str
[string range
$str $n end
]
1848 # Code to implement multiple views
1850 proc newview
{ishighlight
} {
1851 global nextviewnum newviewname newviewperm newishighlight
1852 global newviewargs revtreeargs
1854 set newishighlight
$ishighlight
1856 if {[winfo exists
$top]} {
1860 set newviewname
($nextviewnum) "View $nextviewnum"
1861 set newviewperm
($nextviewnum) 0
1862 set newviewargs
($nextviewnum) [shellarglist
$revtreeargs]
1863 vieweditor
$top $nextviewnum [mc
"Gitk view definition"]
1868 global viewname viewperm newviewname newviewperm
1869 global viewargs newviewargs
1871 set top .gitkvedit-
$curview
1872 if {[winfo exists
$top]} {
1876 set newviewname
($curview) $viewname($curview)
1877 set newviewperm
($curview) $viewperm($curview)
1878 set newviewargs
($curview) [shellarglist
$viewargs($curview)]
1879 vieweditor
$top $curview "Gitk: edit view $viewname($curview)"
1882 proc vieweditor
{top n title
} {
1883 global newviewname newviewperm viewfiles bgcolor
1886 wm title
$top $title
1887 label
$top.
nl -text [mc
"Name"]
1888 entry
$top.name
-width 20 -textvariable newviewname
($n)
1889 grid
$top.
nl $top.name
-sticky w
-pady 5
1890 checkbutton
$top.perm
-text [mc
"Remember this view"] \
1891 -variable newviewperm
($n)
1892 grid
$top.perm
- -pady 5 -sticky w
1893 message
$top.al
-aspect 1000 \
1894 -text [mc
"Commits to include (arguments to git rev-list):"]
1895 grid
$top.al
- -sticky w
-pady 5
1896 entry
$top.args
-width 50 -textvariable newviewargs
($n) \
1897 -background $bgcolor
1898 grid
$top.args
- -sticky ew
-padx 5
1899 message
$top.l
-aspect 1000 \
1900 -text [mc
"Enter files and directories to include, one per line:"]
1901 grid
$top.l
- -sticky w
1902 text
$top.t
-width 40 -height 10 -background $bgcolor -font uifont
1903 if {[info exists viewfiles
($n)]} {
1904 foreach f
$viewfiles($n) {
1905 $top.t insert end
$f
1906 $top.t insert end
"\n"
1908 $top.t delete
{end
- 1c
} end
1909 $top.t mark
set insert
0.0
1911 grid
$top.t
- -sticky ew
-padx 5
1913 button
$top.buts.ok
-text [mc
"OK"] -command [list newviewok
$top $n]
1914 button
$top.buts.can
-text [mc
"Cancel"] -command [list destroy
$top]
1915 grid
$top.buts.ok
$top.buts.can
1916 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
1917 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
1918 grid
$top.buts
- -pady 10 -sticky ew
1922 proc doviewmenu
{m first cmd op argv
} {
1923 set nmenu
[$m index end
]
1924 for {set i
$first} {$i <= $nmenu} {incr i
} {
1925 if {[$m entrycget
$i -command] eq
$cmd} {
1926 eval $m $op $i $argv
1932 proc allviewmenus
{n op args
} {
1935 doviewmenu .bar.view
5 [list showview
$n] $op $args
1936 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1939 proc newviewok
{top n
} {
1940 global nextviewnum newviewperm newviewname newishighlight
1941 global viewname viewfiles viewperm selectedview curview
1942 global viewargs newviewargs viewhlmenu
1945 set newargs
[shellsplit
$newviewargs($n)]
1947 error_popup
"[mc "Error
in commit selection arguments
:"] $err"
1953 foreach f
[split [$top.t get
0.0 end
] "\n"] {
1954 set ft
[string trim
$f]
1959 if {![info exists viewfiles
($n)]} {
1960 # creating a new view
1962 set viewname
($n) $newviewname($n)
1963 set viewperm
($n) $newviewperm($n)
1964 set viewfiles
($n) $files
1965 set viewargs
($n) $newargs
1967 if {!$newishighlight} {
1970 run addvhighlight
$n
1973 # editing an existing view
1974 set viewperm
($n) $newviewperm($n)
1975 if {$newviewname($n) ne
$viewname($n)} {
1976 set viewname
($n) $newviewname($n)
1977 doviewmenu .bar.view
5 [list showview
$n] \
1978 entryconf
[list
-label $viewname($n)]
1979 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1980 # entryconf [list -label $viewname($n) -value $viewname($n)]
1982 if {$files ne
$viewfiles($n) ||
$newargs ne
$viewargs($n)} {
1983 set viewfiles
($n) $files
1984 set viewargs
($n) $newargs
1985 if {$curview == $n} {
1990 catch
{destroy
$top}
1994 global curview viewdata viewperm hlview selectedhlview
1996 if {$curview == 0} return
1997 if {[info exists hlview
] && $hlview == $curview} {
1998 set selectedhlview
[mc
"None"]
2001 allviewmenus
$curview delete
2002 set viewdata
($curview) {}
2003 set viewperm
($curview) 0
2007 proc addviewmenu
{n
} {
2008 global viewname viewhlmenu
2010 .bar.view add radiobutton
-label $viewname($n) \
2011 -command [list showview
$n] -variable selectedview
-value $n
2012 #$viewhlmenu add radiobutton -label $viewname($n) \
2013 # -command [list addvhighlight $n] -variable selectedhlview
2016 proc flatten
{var
} {
2020 foreach i
[array names
$var] {
2021 lappend ret
$i [set $var\
($i\
)]
2026 proc unflatten
{var l
} {
2036 global curview viewdata viewfiles
2037 global displayorder parentlist rowidlist rowisopt rowfinal
2038 global colormap rowtextx commitrow nextcolor canvxmax
2039 global numcommits commitlisted
2040 global selectedline currentid canv canvy0
2042 global pending_select phase
2045 global selectedview selectfirst
2046 global vparentlist vdisporder vcmitlisted
2047 global hlview selectedhlview commitinterest
2049 if {$n == $curview} return
2051 if {[info exists selectedline
]} {
2052 set selid
$currentid
2053 set y
[yc
$selectedline]
2054 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2055 set span
[$canv yview
]
2056 set ytop
[expr {[lindex
$span 0] * $ymax}]
2057 set ybot
[expr {[lindex
$span 1] * $ymax}]
2058 if {$ytop < $y && $y < $ybot} {
2059 set yscreen
[expr {$y - $ytop}]
2061 set yscreen
[expr {($ybot - $ytop) / 2}]
2063 } elseif
{[info exists pending_select
]} {
2064 set selid
$pending_select
2065 unset pending_select
2069 if {$curview >= 0} {
2070 set vparentlist
($curview) $parentlist
2071 set vdisporder
($curview) $displayorder
2072 set vcmitlisted
($curview) $commitlisted
2074 ![info exists viewdata
($curview)] ||
2075 [lindex
$viewdata($curview) 0] ne
{}} {
2076 set viewdata
($curview) \
2077 [list
$phase $rowidlist $rowisopt $rowfinal]
2080 catch
{unset treediffs
}
2082 if {[info exists hlview
] && $hlview == $n} {
2084 set selectedhlview
[mc
"None"]
2086 catch
{unset commitinterest
}
2090 .bar.view entryconf
[mc
"Edit view..."] -state [expr {$n == 0?
"disabled": "normal"}]
2091 .bar.view entryconf
[mc
"Delete view"] -state [expr {$n == 0?
"disabled": "normal"}]
2094 if {![info exists viewdata
($n)]} {
2096 set pending_select
$selid
2103 set phase
[lindex
$v 0]
2104 set displayorder
$vdisporder($n)
2105 set parentlist
$vparentlist($n)
2106 set commitlisted
$vcmitlisted($n)
2107 set rowidlist
[lindex
$v 1]
2108 set rowisopt
[lindex
$v 2]
2109 set rowfinal
[lindex
$v 3]
2110 set numcommits
$commitidx($n)
2112 catch
{unset colormap
}
2113 catch
{unset rowtextx
}
2115 set canvxmax
[$canv cget
-width]
2122 if {$selid ne
{} && [info exists commitrow
($n,$selid)]} {
2123 set row
$commitrow($n,$selid)
2124 # try to get the selected row in the same position on the screen
2125 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2126 set ytop
[expr {[yc
$row] - $yscreen}]
2130 set yf
[expr {$ytop * 1.0 / $ymax}]
2132 allcanvs yview moveto
$yf
2136 } elseif
{$selid ne
{}} {
2137 set pending_select
$selid
2139 set row
[first_real_row
]
2140 if {$row < $numcommits} {
2147 if {$phase eq
"getcommits"} {
2148 show_status
[mc
"Reading commits..."]
2151 } elseif
{$numcommits == 0} {
2152 show_status
[mc
"No commits selected"]
2156 # Stuff relating to the highlighting facility
2158 proc ishighlighted
{row
} {
2159 global vhighlights fhighlights nhighlights rhighlights
2161 if {[info exists nhighlights
($row)] && $nhighlights($row) > 0} {
2162 return $nhighlights($row)
2164 if {[info exists vhighlights
($row)] && $vhighlights($row) > 0} {
2165 return $vhighlights($row)
2167 if {[info exists fhighlights
($row)] && $fhighlights($row) > 0} {
2168 return $fhighlights($row)
2170 if {[info exists rhighlights
($row)] && $rhighlights($row) > 0} {
2171 return $rhighlights($row)
2176 proc bolden
{row font
} {
2177 global canv linehtag selectedline boldrows
2179 lappend boldrows
$row
2180 $canv itemconf
$linehtag($row) -font $font
2181 if {[info exists selectedline
] && $row == $selectedline} {
2183 set t
[eval $canv create rect
[$canv bbox
$linehtag($row)] \
2184 -outline {{}} -tags secsel \
2185 -fill [$canv cget
-selectbackground]]
2190 proc bolden_name
{row font
} {
2191 global canv2 linentag selectedline boldnamerows
2193 lappend boldnamerows
$row
2194 $canv2 itemconf
$linentag($row) -font $font
2195 if {[info exists selectedline
] && $row == $selectedline} {
2196 $canv2 delete secsel
2197 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($row)] \
2198 -outline {{}} -tags secsel \
2199 -fill [$canv2 cget
-selectbackground]]
2208 foreach row
$boldrows {
2209 if {![ishighlighted
$row]} {
2210 bolden
$row mainfont
2212 lappend stillbold
$row
2215 set boldrows
$stillbold
2218 proc addvhighlight
{n
} {
2219 global hlview curview viewdata vhl_done vhighlights commitidx
2221 if {[info exists hlview
]} {
2225 if {$n != $curview && ![info exists viewdata
($n)]} {
2226 set viewdata
($n) [list getcommits
{{}} 0 0 0]
2227 set vparentlist
($n) {}
2228 set vdisporder
($n) {}
2229 set vcmitlisted
($n) {}
2232 set vhl_done
$commitidx($hlview)
2233 if {$vhl_done > 0} {
2238 proc delvhighlight
{} {
2239 global hlview vhighlights
2241 if {![info exists hlview
]} return
2243 catch
{unset vhighlights
}
2247 proc vhighlightmore
{} {
2248 global hlview vhl_done commitidx vhighlights
2249 global displayorder vdisporder curview
2251 set max
$commitidx($hlview)
2252 if {$hlview == $curview} {
2253 set disp
$displayorder
2255 set disp
$vdisporder($hlview)
2257 set vr
[visiblerows
]
2258 set r0
[lindex
$vr 0]
2259 set r1
[lindex
$vr 1]
2260 for {set i
$vhl_done} {$i < $max} {incr i
} {
2261 set id
[lindex
$disp $i]
2262 if {[info exists commitrow
($curview,$id)]} {
2263 set row
$commitrow($curview,$id)
2264 if {$r0 <= $row && $row <= $r1} {
2265 if {![highlighted
$row]} {
2266 bolden
$row mainfontbold
2268 set vhighlights
($row) 1
2275 proc askvhighlight
{row id
} {
2276 global hlview vhighlights commitrow iddrawn
2278 if {[info exists commitrow
($hlview,$id)]} {
2279 if {[info exists iddrawn
($id)] && ![ishighlighted
$row]} {
2280 bolden
$row mainfontbold
2282 set vhighlights
($row) 1
2284 set vhighlights
($row) 0
2288 proc hfiles_change
{} {
2289 global highlight_files filehighlight fhighlights fh_serial
2290 global highlight_paths gdttype
2292 if {[info exists filehighlight
]} {
2293 # delete previous highlights
2294 catch
{close
$filehighlight}
2296 catch
{unset fhighlights
}
2298 unhighlight_filelist
2300 set highlight_paths
{}
2301 after cancel do_file_hl
$fh_serial
2303 if {$highlight_files ne
{}} {
2304 after
300 do_file_hl
$fh_serial
2308 proc gdttype_change
{name ix op
} {
2309 global gdttype highlight_files findstring findpattern
2312 if {$findstring ne
{}} {
2313 if {$gdttype eq
[mc
"containing:"]} {
2314 if {$highlight_files ne
{}} {
2315 set highlight_files
{}
2320 if {$findpattern ne
{}} {
2324 set highlight_files
$findstring
2329 # enable/disable findtype/findloc menus too
2332 proc find_change
{name ix op
} {
2333 global gdttype findstring highlight_files
2336 if {$gdttype eq
[mc
"containing:"]} {
2339 if {$highlight_files ne
$findstring} {
2340 set highlight_files
$findstring
2347 proc findcom_change args
{
2348 global nhighlights boldnamerows
2349 global findpattern findtype findstring gdttype
2352 # delete previous highlights, if any
2353 foreach row
$boldnamerows {
2354 bolden_name
$row mainfont
2357 catch
{unset nhighlights
}
2360 if {$gdttype ne
[mc
"containing:"] ||
$findstring eq
{}} {
2362 } elseif
{$findtype eq
[mc
"Regexp"]} {
2363 set findpattern
$findstring
2365 set e
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2367 set findpattern
"*$e*"
2371 proc makepatterns
{l
} {
2374 set ee
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2375 if {[string index
$ee end
] eq
"/"} {
2385 proc do_file_hl
{serial
} {
2386 global highlight_files filehighlight highlight_paths gdttype fhl_list
2388 if {$gdttype eq
[mc
"touching paths:"]} {
2389 if {[catch
{set paths
[shellsplit
$highlight_files]}]} return
2390 set highlight_paths
[makepatterns
$paths]
2392 set gdtargs
[concat
-- $paths]
2393 } elseif
{$gdttype eq
[mc
"adding/removing string:"]} {
2394 set gdtargs
[list
"-S$highlight_files"]
2396 # must be "containing:", i.e. we're searching commit info
2399 set cmd
[concat | git diff-tree
-r -s --stdin $gdtargs]
2400 set filehighlight
[open
$cmd r
+]
2401 fconfigure
$filehighlight -blocking 0
2402 filerun
$filehighlight readfhighlight
2408 proc flushhighlights
{} {
2409 global filehighlight fhl_list
2411 if {[info exists filehighlight
]} {
2413 puts
$filehighlight ""
2414 flush
$filehighlight
2418 proc askfilehighlight
{row id
} {
2419 global filehighlight fhighlights fhl_list
2421 lappend fhl_list
$id
2422 set fhighlights
($row) -1
2423 puts
$filehighlight $id
2426 proc readfhighlight
{} {
2427 global filehighlight fhighlights commitrow curview iddrawn
2428 global fhl_list find_dirn
2430 if {![info exists filehighlight
]} {
2434 while {[incr nr
] <= 100 && [gets
$filehighlight line
] >= 0} {
2435 set line
[string trim
$line]
2436 set i
[lsearch
-exact $fhl_list $line]
2437 if {$i < 0} continue
2438 for {set j
0} {$j < $i} {incr j
} {
2439 set id
[lindex
$fhl_list $j]
2440 if {[info exists commitrow
($curview,$id)]} {
2441 set fhighlights
($commitrow($curview,$id)) 0
2444 set fhl_list
[lrange
$fhl_list [expr {$i+1}] end
]
2445 if {$line eq
{}} continue
2446 if {![info exists commitrow
($curview,$line)]} continue
2447 set row
$commitrow($curview,$line)
2448 if {[info exists iddrawn
($line)] && ![ishighlighted
$row]} {
2449 bolden
$row mainfontbold
2451 set fhighlights
($row) 1
2453 if {[eof
$filehighlight]} {
2455 puts
"oops, git diff-tree died"
2456 catch
{close
$filehighlight}
2460 if {[info exists find_dirn
]} {
2466 proc doesmatch
{f
} {
2467 global findtype findpattern
2469 if {$findtype eq
[mc
"Regexp"]} {
2470 return [regexp
$findpattern $f]
2471 } elseif
{$findtype eq
[mc
"IgnCase"]} {
2472 return [string match
-nocase $findpattern $f]
2474 return [string match
$findpattern $f]
2478 proc askfindhighlight
{row id
} {
2479 global nhighlights commitinfo iddrawn
2481 global markingmatches
2483 if {![info exists commitinfo
($id)]} {
2486 set info
$commitinfo($id)
2488 set fldtypes
[list
[mc Headline
] [mc Author
] [mc Date
] [mc Committer
] [mc CDate
] [mc Comments
]]
2489 foreach f
$info ty
$fldtypes {
2490 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
2492 if {$ty eq
[mc
"Author"]} {
2499 if {$isbold && [info exists iddrawn
($id)]} {
2500 if {![ishighlighted
$row]} {
2501 bolden
$row mainfontbold
2503 bolden_name
$row mainfontbold
2506 if {$markingmatches} {
2507 markrowmatches
$row $id
2510 set nhighlights
($row) $isbold
2513 proc markrowmatches
{row id
} {
2514 global canv canv2 linehtag linentag commitinfo findloc
2516 set headline
[lindex
$commitinfo($id) 0]
2517 set author
[lindex
$commitinfo($id) 1]
2518 $canv delete match
$row
2519 $canv2 delete match
$row
2520 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Headline"]} {
2521 set m
[findmatches
$headline]
2523 markmatches
$canv $row $headline $linehtag($row) $m \
2524 [$canv itemcget
$linehtag($row) -font] $row
2527 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Author"]} {
2528 set m
[findmatches
$author]
2530 markmatches
$canv2 $row $author $linentag($row) $m \
2531 [$canv2 itemcget
$linentag($row) -font] $row
2536 proc vrel_change
{name ix op
} {
2537 global highlight_related
2540 if {$highlight_related ne
[mc
"None"]} {
2545 # prepare for testing whether commits are descendents or ancestors of a
2546 proc rhighlight_sel
{a
} {
2547 global descendent desc_todo ancestor anc_todo
2548 global highlight_related rhighlights
2550 catch
{unset descendent
}
2551 set desc_todo
[list
$a]
2552 catch
{unset ancestor
}
2553 set anc_todo
[list
$a]
2554 if {$highlight_related ne
[mc
"None"]} {
2560 proc rhighlight_none
{} {
2563 catch
{unset rhighlights
}
2567 proc is_descendent
{a
} {
2568 global curview children commitrow descendent desc_todo
2571 set la
$commitrow($v,$a)
2575 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2576 set do [lindex
$todo $i]
2577 if {$commitrow($v,$do) < $la} {
2578 lappend leftover
$do
2581 foreach nk
$children($v,$do) {
2582 if {![info exists descendent
($nk)]} {
2583 set descendent
($nk) 1
2591 set desc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2595 set descendent
($a) 0
2596 set desc_todo
$leftover
2599 proc is_ancestor
{a
} {
2600 global curview parentlist commitrow ancestor anc_todo
2603 set la
$commitrow($v,$a)
2607 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2608 set do [lindex
$todo $i]
2609 if {![info exists commitrow
($v,$do)] ||
$commitrow($v,$do) > $la} {
2610 lappend leftover
$do
2613 foreach np
[lindex
$parentlist $commitrow($v,$do)] {
2614 if {![info exists ancestor
($np)]} {
2623 set anc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2628 set anc_todo
$leftover
2631 proc askrelhighlight
{row id
} {
2632 global descendent highlight_related iddrawn rhighlights
2633 global selectedline ancestor
2635 if {![info exists selectedline
]} return
2637 if {$highlight_related eq
[mc
"Descendant"] ||
2638 $highlight_related eq
[mc
"Not descendant"]} {
2639 if {![info exists descendent
($id)]} {
2642 if {$descendent($id) == ($highlight_related eq
[mc
"Descendant"])} {
2645 } elseif
{$highlight_related eq
[mc
"Ancestor"] ||
2646 $highlight_related eq
[mc
"Not ancestor"]} {
2647 if {![info exists ancestor
($id)]} {
2650 if {$ancestor($id) == ($highlight_related eq
[mc
"Ancestor"])} {
2654 if {[info exists iddrawn
($id)]} {
2655 if {$isbold && ![ishighlighted
$row]} {
2656 bolden
$row mainfontbold
2659 set rhighlights
($row) $isbold
2662 # Graph layout functions
2664 proc shortids
{ids
} {
2667 if {[llength
$id] > 1} {
2668 lappend res
[shortids
$id]
2669 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $id]} {
2670 lappend res
[string range
$id 0 7]
2681 for {set mask
1} {$mask <= $n} {incr mask
$mask} {
2682 if {($n & $mask) != 0} {
2683 set ret
[concat
$ret $o]
2685 set o
[concat
$o $o]
2690 # Work out where id should go in idlist so that order-token
2691 # values increase from left to right
2692 proc idcol
{idlist id
{i
0}} {
2693 global ordertok curview
2695 set t
$ordertok($curview,$id)
2696 if {$i >= [llength
$idlist] ||
2697 $t < $ordertok($curview,[lindex
$idlist $i])} {
2698 if {$i > [llength
$idlist]} {
2699 set i
[llength
$idlist]
2701 while {[incr i
-1] >= 0 &&
2702 $t < $ordertok($curview,[lindex
$idlist $i])} {}
2705 if {$t > $ordertok($curview,[lindex
$idlist $i])} {
2706 while {[incr i
] < [llength
$idlist] &&
2707 $t >= $ordertok($curview,[lindex
$idlist $i])} {}
2713 proc initlayout
{} {
2714 global rowidlist rowisopt rowfinal displayorder commitlisted
2715 global numcommits canvxmax canv
2718 global colormap rowtextx
2729 set canvxmax
[$canv cget
-width]
2730 catch
{unset colormap
}
2731 catch
{unset rowtextx
}
2735 proc setcanvscroll
{} {
2736 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2738 set ymax
[expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2739 $canv conf
-scrollregion [list
0 0 $canvxmax $ymax]
2740 $canv2 conf
-scrollregion [list
0 0 0 $ymax]
2741 $canv3 conf
-scrollregion [list
0 0 0 $ymax]
2744 proc visiblerows
{} {
2745 global canv numcommits linespc
2747 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2748 if {$ymax eq
{} ||
$ymax == 0} return
2750 set y0
[expr {int
([lindex
$f 0] * $ymax)}]
2751 set r0
[expr {int
(($y0 - 3) / $linespc) - 1}]
2755 set y1
[expr {int
([lindex
$f 1] * $ymax)}]
2756 set r1
[expr {int
(($y1 - 3) / $linespc) + 1}]
2757 if {$r1 >= $numcommits} {
2758 set r1
[expr {$numcommits - 1}]
2760 return [list
$r0 $r1]
2763 proc layoutmore
{} {
2764 global commitidx viewcomplete numcommits
2765 global uparrowlen downarrowlen mingaplen curview
2767 set show
$commitidx($curview)
2768 if {$show > $numcommits ||
$viewcomplete($curview)} {
2769 showstuff
$show $viewcomplete($curview)
2773 proc showstuff
{canshow last
} {
2774 global numcommits commitrow pending_select selectedline curview
2775 global mainheadid displayorder selectfirst
2776 global lastscrollset commitinterest
2778 if {$numcommits == 0} {
2780 set phase
"incrdraw"
2784 set prev
$numcommits
2785 set numcommits
$canshow
2786 set t
[clock clicks
-milliseconds]
2787 if {$prev < 100 ||
$last ||
$t - $lastscrollset > 500} {
2788 set lastscrollset
$t
2791 set rows
[visiblerows
]
2792 set r1
[lindex
$rows 1]
2793 if {$r1 >= $canshow} {
2794 set r1
[expr {$canshow - 1}]
2799 if {[info exists pending_select
] &&
2800 [info exists commitrow
($curview,$pending_select)] &&
2801 $commitrow($curview,$pending_select) < $numcommits} {
2802 selectline
$commitrow($curview,$pending_select) 1
2805 if {[info exists selectedline
] ||
[info exists pending_select
]} {
2808 set l
[first_real_row
]
2815 proc doshowlocalchanges
{} {
2816 global curview mainheadid phase commitrow
2818 if {[info exists commitrow
($curview,$mainheadid)] &&
2819 ($phase eq
{} ||
$commitrow($curview,$mainheadid) < $numcommits - 1)} {
2821 } elseif
{$phase ne
{}} {
2822 lappend commitinterest
($mainheadid) {}
2826 proc dohidelocalchanges
{} {
2827 global localfrow localirow lserial
2829 if {$localfrow >= 0} {
2830 removerow
$localfrow
2832 if {$localirow > 0} {
2836 if {$localirow >= 0} {
2837 removerow
$localirow
2843 # spawn off a process to do git diff-index --cached HEAD
2844 proc dodiffindex
{} {
2845 global localirow localfrow lserial showlocalchanges
2847 if {!$showlocalchanges} return
2851 set fd
[open
"|git diff-index --cached HEAD" r
]
2852 fconfigure
$fd -blocking 0
2853 filerun
$fd [list readdiffindex
$fd $lserial]
2856 proc readdiffindex
{fd serial
} {
2857 global localirow commitrow mainheadid nullid2 curview
2858 global commitinfo commitdata lserial
2861 if {[gets
$fd line
] < 0} {
2867 # we only need to see one line and we don't really care what it says...
2870 # now see if there are any local changes not checked in to the index
2871 if {$serial == $lserial} {
2872 set fd
[open
"|git diff-files" r
]
2873 fconfigure
$fd -blocking 0
2874 filerun
$fd [list readdifffiles
$fd $serial]
2877 if {$isdiff && $serial == $lserial && $localirow == -1} {
2878 # add the line for the changes in the index to the graph
2879 set localirow
$commitrow($curview,$mainheadid)
2880 set hl
[mc
"Local changes checked in to index but not committed"]
2881 set commitinfo
($nullid2) [list
$hl {} {} {} {} " $hl\n"]
2882 set commitdata
($nullid2) "\n $hl\n"
2883 insertrow
$localirow $nullid2
2888 proc readdifffiles
{fd serial
} {
2889 global localirow localfrow commitrow mainheadid nullid curview
2890 global commitinfo commitdata lserial
2893 if {[gets
$fd line
] < 0} {
2899 # we only need to see one line and we don't really care what it says...
2902 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2903 # add the line for the local diff to the graph
2904 if {$localirow >= 0} {
2905 set localfrow
$localirow
2908 set localfrow
$commitrow($curview,$mainheadid)
2910 set hl
[mc
"Local uncommitted changes, not checked in to index"]
2911 set commitinfo
($nullid) [list
$hl {} {} {} {} " $hl\n"]
2912 set commitdata
($nullid) "\n $hl\n"
2913 insertrow
$localfrow $nullid
2918 proc nextuse
{id row
} {
2919 global commitrow curview children
2921 if {[info exists children
($curview,$id)]} {
2922 foreach kid
$children($curview,$id) {
2923 if {![info exists commitrow
($curview,$kid)]} {
2926 if {$commitrow($curview,$kid) > $row} {
2927 return $commitrow($curview,$kid)
2931 if {[info exists commitrow
($curview,$id)]} {
2932 return $commitrow($curview,$id)
2937 proc prevuse
{id row
} {
2938 global commitrow curview children
2941 if {[info exists children
($curview,$id)]} {
2942 foreach kid
$children($curview,$id) {
2943 if {![info exists commitrow
($curview,$kid)]} break
2944 if {$commitrow($curview,$kid) < $row} {
2945 set ret
$commitrow($curview,$kid)
2952 proc make_idlist
{row
} {
2953 global displayorder parentlist uparrowlen downarrowlen mingaplen
2954 global commitidx curview ordertok children commitrow
2956 set r
[expr {$row - $mingaplen - $downarrowlen - 1}]
2960 set ra
[expr {$row - $downarrowlen}]
2964 set rb
[expr {$row + $uparrowlen}]
2965 if {$rb > $commitidx($curview)} {
2966 set rb
$commitidx($curview)
2969 for {} {$r < $ra} {incr r
} {
2970 set nextid
[lindex
$displayorder [expr {$r + 1}]]
2971 foreach p
[lindex
$parentlist $r] {
2972 if {$p eq
$nextid} continue
2973 set rn
[nextuse
$p $r]
2975 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2976 lappend ids
[list
$ordertok($curview,$p) $p]
2980 for {} {$r < $row} {incr r
} {
2981 set nextid
[lindex
$displayorder [expr {$r + 1}]]
2982 foreach p
[lindex
$parentlist $r] {
2983 if {$p eq
$nextid} continue
2984 set rn
[nextuse
$p $r]
2985 if {$rn < 0 ||
$rn >= $row} {
2986 lappend ids
[list
$ordertok($curview,$p) $p]
2990 set id
[lindex
$displayorder $row]
2991 lappend ids
[list
$ordertok($curview,$id) $id]
2993 foreach p
[lindex
$parentlist $r] {
2994 set firstkid
[lindex
$children($curview,$p) 0]
2995 if {$commitrow($curview,$firstkid) < $row} {
2996 lappend ids
[list
$ordertok($curview,$p) $p]
3000 set id
[lindex
$displayorder $r]
3002 set firstkid
[lindex
$children($curview,$id) 0]
3003 if {$firstkid ne
{} && $commitrow($curview,$firstkid) < $row} {
3004 lappend ids
[list
$ordertok($curview,$id) $id]
3009 foreach idx
[lsort
-unique $ids] {
3010 lappend idlist
[lindex
$idx 1]
3015 proc rowsequal
{a b
} {
3016 while {[set i
[lsearch
-exact $a {}]] >= 0} {
3017 set a
[lreplace
$a $i $i]
3019 while {[set i
[lsearch
-exact $b {}]] >= 0} {
3020 set b
[lreplace
$b $i $i]
3022 return [expr {$a eq
$b}]
3025 proc makeupline
{id row rend
col} {
3026 global rowidlist uparrowlen downarrowlen mingaplen
3028 for {set r
$rend} {1} {set r
$rstart} {
3029 set rstart
[prevuse
$id $r]
3030 if {$rstart < 0} return
3031 if {$rstart < $row} break
3033 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3034 set rstart
[expr {$rend - $uparrowlen - 1}]
3036 for {set r
$rstart} {[incr r
] <= $row} {} {
3037 set idlist
[lindex
$rowidlist $r]
3038 if {$idlist ne
{} && [lsearch
-exact $idlist $id] < 0} {
3039 set col [idcol
$idlist $id $col]
3040 lset rowidlist
$r [linsert
$idlist $col $id]
3046 proc layoutrows
{row endrow
} {
3047 global rowidlist rowisopt rowfinal displayorder
3048 global uparrowlen downarrowlen maxwidth mingaplen
3049 global children parentlist
3050 global commitidx viewcomplete curview commitrow
3054 set rm1
[expr {$row - 1}]
3055 foreach id
[lindex
$rowidlist $rm1] {
3060 set final
[lindex
$rowfinal $rm1]
3062 for {} {$row < $endrow} {incr row
} {
3063 set rm1
[expr {$row - 1}]
3064 if {$rm1 < 0 ||
$idlist eq
{}} {
3065 set idlist
[make_idlist
$row]
3068 set id
[lindex
$displayorder $rm1]
3069 set col [lsearch
-exact $idlist $id]
3070 set idlist
[lreplace
$idlist $col $col]
3071 foreach p
[lindex
$parentlist $rm1] {
3072 if {[lsearch
-exact $idlist $p] < 0} {
3073 set col [idcol
$idlist $p $col]
3074 set idlist
[linsert
$idlist $col $p]
3075 # if not the first child, we have to insert a line going up
3076 if {$id ne
[lindex
$children($curview,$p) 0]} {
3077 makeupline
$p $rm1 $row $col
3081 set id
[lindex
$displayorder $row]
3082 if {$row > $downarrowlen} {
3083 set termrow
[expr {$row - $downarrowlen - 1}]
3084 foreach p
[lindex
$parentlist $termrow] {
3085 set i
[lsearch
-exact $idlist $p]
3086 if {$i < 0} continue
3087 set nr
[nextuse
$p $termrow]
3088 if {$nr < 0 ||
$nr >= $row + $mingaplen + $uparrowlen} {
3089 set idlist
[lreplace
$idlist $i $i]
3093 set col [lsearch
-exact $idlist $id]
3095 set col [idcol
$idlist $id]
3096 set idlist
[linsert
$idlist $col $id]
3097 if {$children($curview,$id) ne
{}} {
3098 makeupline
$id $rm1 $row $col
3101 set r
[expr {$row + $uparrowlen - 1}]
3102 if {$r < $commitidx($curview)} {
3104 foreach p
[lindex
$parentlist $r] {
3105 if {[lsearch
-exact $idlist $p] >= 0} continue
3106 set fk
[lindex
$children($curview,$p) 0]
3107 if {$commitrow($curview,$fk) < $row} {
3108 set x
[idcol
$idlist $p $x]
3109 set idlist
[linsert
$idlist $x $p]
3112 if {[incr r
] < $commitidx($curview)} {
3113 set p
[lindex
$displayorder $r]
3114 if {[lsearch
-exact $idlist $p] < 0} {
3115 set fk
[lindex
$children($curview,$p) 0]
3116 if {$fk ne
{} && $commitrow($curview,$fk) < $row} {
3117 set x
[idcol
$idlist $p $x]
3118 set idlist
[linsert
$idlist $x $p]
3124 if {$final && !$viewcomplete($curview) &&
3125 $row + $uparrowlen + $mingaplen + $downarrowlen
3126 >= $commitidx($curview)} {
3129 set l
[llength
$rowidlist]
3131 lappend rowidlist
$idlist
3133 lappend rowfinal
$final
3134 } elseif
{$row < $l} {
3135 if {![rowsequal
$idlist [lindex
$rowidlist $row]]} {
3136 lset rowidlist
$row $idlist
3139 lset rowfinal
$row $final
3141 set pad
[ntimes
[expr {$row - $l}] {}]
3142 set rowidlist
[concat
$rowidlist $pad]
3143 lappend rowidlist
$idlist
3144 set rowfinal
[concat
$rowfinal $pad]
3145 lappend rowfinal
$final
3146 set rowisopt
[concat
$rowisopt [ntimes
[expr {$row - $l + 1}] 0]]
3152 proc changedrow
{row
} {
3153 global displayorder iddrawn rowisopt need_redisplay
3155 set l
[llength
$rowisopt]
3157 lset rowisopt
$row 0
3158 if {$row + 1 < $l} {
3159 lset rowisopt
[expr {$row + 1}] 0
3160 if {$row + 2 < $l} {
3161 lset rowisopt
[expr {$row + 2}] 0
3165 set id
[lindex
$displayorder $row]
3166 if {[info exists iddrawn
($id)]} {
3167 set need_redisplay
1
3171 proc insert_pad
{row
col npad
} {
3174 set pad
[ntimes
$npad {}]
3175 set idlist
[lindex
$rowidlist $row]
3176 set bef
[lrange
$idlist 0 [expr {$col - 1}]]
3177 set aft
[lrange
$idlist $col end
]
3178 set i
[lsearch
-exact $aft {}]
3180 set aft
[lreplace
$aft $i $i]
3182 lset rowidlist
$row [concat
$bef $pad $aft]
3186 proc optimize_rows
{row
col endrow
} {
3187 global rowidlist rowisopt displayorder curview children
3192 for {} {$row < $endrow} {incr row
; set col 0} {
3193 if {[lindex
$rowisopt $row]} continue
3195 set y0
[expr {$row - 1}]
3196 set ym
[expr {$row - 2}]
3197 set idlist
[lindex
$rowidlist $row]
3198 set previdlist
[lindex
$rowidlist $y0]
3199 if {$idlist eq
{} ||
$previdlist eq
{}} continue
3201 set pprevidlist
[lindex
$rowidlist $ym]
3202 if {$pprevidlist eq
{}} continue
3208 for {} {$col < [llength
$idlist]} {incr
col} {
3209 set id
[lindex
$idlist $col]
3210 if {[lindex
$previdlist $col] eq
$id} continue
3215 set x0
[lsearch
-exact $previdlist $id]
3216 if {$x0 < 0} continue
3217 set z
[expr {$x0 - $col}]
3221 set xm
[lsearch
-exact $pprevidlist $id]
3223 set z0
[expr {$xm - $x0}]
3227 # if row y0 is the first child of $id then it's not an arrow
3228 if {[lindex
$children($curview,$id) 0] ne
3229 [lindex
$displayorder $y0]} {
3233 if {!$isarrow && $id ne
[lindex
$displayorder $row] &&
3234 [lsearch
-exact [lindex
$rowidlist [expr {$row+1}]] $id] < 0} {
3237 # Looking at lines from this row to the previous row,
3238 # make them go straight up if they end in an arrow on
3239 # the previous row; otherwise make them go straight up
3241 if {$z < -1 ||
($z < 0 && $isarrow)} {
3242 # Line currently goes left too much;
3243 # insert pads in the previous row, then optimize it
3244 set npad
[expr {-1 - $z + $isarrow}]
3245 insert_pad
$y0 $x0 $npad
3247 optimize_rows
$y0 $x0 $row
3249 set previdlist
[lindex
$rowidlist $y0]
3250 set x0
[lsearch
-exact $previdlist $id]
3251 set z
[expr {$x0 - $col}]
3253 set pprevidlist
[lindex
$rowidlist $ym]
3254 set xm
[lsearch
-exact $pprevidlist $id]
3255 set z0
[expr {$xm - $x0}]
3257 } elseif
{$z > 1 ||
($z > 0 && $isarrow)} {
3258 # Line currently goes right too much;
3259 # insert pads in this line
3260 set npad
[expr {$z - 1 + $isarrow}]
3261 insert_pad
$row $col $npad
3262 set idlist
[lindex
$rowidlist $row]
3264 set z
[expr {$x0 - $col}]
3267 if {$z0 eq
{} && !$isarrow && $ym >= 0} {
3268 # this line links to its first child on row $row-2
3269 set id
[lindex
$displayorder $ym]
3270 set xc
[lsearch
-exact $pprevidlist $id]
3272 set z0
[expr {$xc - $x0}]
3275 # avoid lines jigging left then immediately right
3276 if {$z0 ne
{} && $z < 0 && $z0 > 0} {
3277 insert_pad
$y0 $x0 1
3279 optimize_rows
$y0 $x0 $row
3280 set previdlist
[lindex
$rowidlist $y0]
3284 # Find the first column that doesn't have a line going right
3285 for {set col [llength
$idlist]} {[incr
col -1] >= 0} {} {
3286 set id
[lindex
$idlist $col]
3287 if {$id eq
{}} break
3288 set x0
[lsearch
-exact $previdlist $id]
3290 # check if this is the link to the first child
3291 set kid
[lindex
$displayorder $y0]
3292 if {[lindex
$children($curview,$id) 0] eq
$kid} {
3293 # it is, work out offset to child
3294 set x0
[lsearch
-exact $previdlist $kid]
3297 if {$x0 <= $col} break
3299 # Insert a pad at that column as long as it has a line and
3300 # isn't the last column
3301 if {$x0 >= 0 && [incr
col] < [llength
$idlist]} {
3302 set idlist
[linsert
$idlist $col {}]
3303 lset rowidlist
$row $idlist
3311 global canvx0 linespc
3312 return [expr {$canvx0 + $col * $linespc}]
3316 global canvy0 linespc
3317 return [expr {$canvy0 + $row * $linespc}]
3320 proc linewidth
{id
} {
3321 global thickerline lthickness
3324 if {[info exists thickerline
] && $id eq
$thickerline} {
3325 set wid
[expr {2 * $lthickness}]
3330 proc rowranges
{id
} {
3331 global commitrow curview children uparrowlen downarrowlen
3334 set kids
$children($curview,$id)
3340 foreach child
$kids {
3341 if {![info exists commitrow
($curview,$child)]} break
3342 set row
$commitrow($curview,$child)
3343 if {![info exists prev
]} {
3344 lappend ret
[expr {$row + 1}]
3346 if {$row <= $prevrow} {
3347 puts
"oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3349 # see if the line extends the whole way from prevrow to row
3350 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3351 [lsearch
-exact [lindex
$rowidlist \
3352 [expr {int
(($row + $prevrow) / 2)}]] $id] < 0} {
3353 # it doesn't, see where it ends
3354 set r
[expr {$prevrow + $downarrowlen}]
3355 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3356 while {[incr r
-1] > $prevrow &&
3357 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3359 while {[incr r
] <= $row &&
3360 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3364 # see where it starts up again
3365 set r
[expr {$row - $uparrowlen}]
3366 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3367 while {[incr r
] < $row &&
3368 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3370 while {[incr r
-1] >= $prevrow &&
3371 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3377 if {$child eq
$id} {
3386 proc drawlineseg
{id row endrow arrowlow
} {
3387 global rowidlist displayorder iddrawn linesegs
3388 global canv colormap linespc curview maxlinelen parentlist
3390 set cols
[list
[lsearch
-exact [lindex
$rowidlist $row] $id]]
3391 set le
[expr {$row + 1}]
3394 set c
[lsearch
-exact [lindex
$rowidlist $le] $id]
3400 set x
[lindex
$displayorder $le]
3405 if {[info exists iddrawn
($x)] ||
$le == $endrow} {
3406 set c
[lsearch
-exact [lindex
$rowidlist [expr {$le+1}]] $id]
3422 if {[info exists linesegs
($id)]} {
3423 set lines
$linesegs($id)
3425 set r0
[lindex
$li 0]
3427 if {$r0 == $le && [lindex
$li 1] - $row <= $maxlinelen} {
3437 set li
[lindex
$lines [expr {$i-1}]]
3438 set r1
[lindex
$li 1]
3439 if {$r1 == $row && $le - [lindex
$li 0] <= $maxlinelen} {
3444 set x
[lindex
$cols [expr {$le - $row}]]
3445 set xp
[lindex
$cols [expr {$le - 1 - $row}]]
3446 set dir
[expr {$xp - $x}]
3448 set ith
[lindex
$lines $i 2]
3449 set coords
[$canv coords
$ith]
3450 set ah
[$canv itemcget
$ith -arrow]
3451 set arrowhigh
[expr {$ah eq
"first" ||
$ah eq
"both"}]
3452 set x2
[lindex
$cols [expr {$le + 1 - $row}]]
3453 if {$x2 ne
{} && $x - $x2 == $dir} {
3454 set coords
[lrange
$coords 0 end-2
]
3457 set coords
[list
[xc
$le $x] [yc
$le]]
3460 set itl
[lindex
$lines [expr {$i-1}] 2]
3461 set al
[$canv itemcget
$itl -arrow]
3462 set arrowlow
[expr {$al eq
"last" ||
$al eq
"both"}]
3463 } elseif
{$arrowlow} {
3464 if {[lsearch
-exact [lindex
$rowidlist [expr {$row-1}]] $id] >= 0 ||
3465 [lsearch
-exact [lindex
$parentlist [expr {$row-1}]] $id] >= 0} {
3469 set arrow
[lindex
{none first last both
} [expr {$arrowhigh + 2*$arrowlow}]]
3470 for {set y
$le} {[incr y
-1] > $row} {} {
3472 set xp
[lindex
$cols [expr {$y - 1 - $row}]]
3473 set ndir
[expr {$xp - $x}]
3474 if {$dir != $ndir ||
$xp < 0} {
3475 lappend coords
[xc
$y $x] [yc
$y]
3481 # join parent line to first child
3482 set ch
[lindex
$displayorder $row]
3483 set xc
[lsearch
-exact [lindex
$rowidlist $row] $ch]
3485 puts
"oops: drawlineseg: child $ch not on row $row"
3486 } elseif
{$xc != $x} {
3487 if {($arrowhigh && $le == $row + 1) ||
$dir == 0} {
3488 set d
[expr {int
(0.5 * $linespc)}]
3491 set x2
[expr {$x1 - $d}]
3493 set x2
[expr {$x1 + $d}]
3496 set y1
[expr {$y2 + $d}]
3497 lappend coords
$x1 $y1 $x2 $y2
3498 } elseif
{$xc < $x - 1} {
3499 lappend coords
[xc
$row [expr {$x-1}]] [yc
$row]
3500 } elseif
{$xc > $x + 1} {
3501 lappend coords
[xc
$row [expr {$x+1}]] [yc
$row]
3505 lappend coords
[xc
$row $x] [yc
$row]
3507 set xn
[xc
$row $xp]
3509 lappend coords
$xn $yn
3513 set t
[$canv create line
$coords -width [linewidth
$id] \
3514 -fill $colormap($id) -tags lines.
$id -arrow $arrow]
3517 set lines
[linsert
$lines $i [list
$row $le $t]]
3519 $canv coords
$ith $coords
3520 if {$arrow ne
$ah} {
3521 $canv itemconf
$ith -arrow $arrow
3523 lset lines
$i 0 $row
3526 set xo
[lsearch
-exact [lindex
$rowidlist [expr {$row - 1}]] $id]
3527 set ndir
[expr {$xo - $xp}]
3528 set clow
[$canv coords
$itl]
3529 if {$dir == $ndir} {
3530 set clow
[lrange
$clow 2 end
]
3532 set coords
[concat
$coords $clow]
3534 lset lines
[expr {$i-1}] 1 $le
3536 # coalesce two pieces
3538 set b
[lindex
$lines [expr {$i-1}] 0]
3539 set e
[lindex
$lines $i 1]
3540 set lines
[lreplace
$lines [expr {$i-1}] $i [list
$b $e $itl]]
3542 $canv coords
$itl $coords
3543 if {$arrow ne
$al} {
3544 $canv itemconf
$itl -arrow $arrow
3548 set linesegs
($id) $lines
3552 proc drawparentlinks
{id row
} {
3553 global rowidlist canv colormap curview parentlist
3554 global idpos linespc
3556 set rowids
[lindex
$rowidlist $row]
3557 set col [lsearch
-exact $rowids $id]
3558 if {$col < 0} return
3559 set olds
[lindex
$parentlist $row]
3560 set row2
[expr {$row + 1}]
3561 set x
[xc
$row $col]
3564 set d
[expr {int
(0.5 * $linespc)}]
3565 set ymid
[expr {$y + $d}]
3566 set ids
[lindex
$rowidlist $row2]
3567 # rmx = right-most X coord used
3570 set i
[lsearch
-exact $ids $p]
3572 puts
"oops, parent $p of $id not in list"
3575 set x2
[xc
$row2 $i]
3579 set j
[lsearch
-exact $rowids $p]
3581 # drawlineseg will do this one for us
3585 # should handle duplicated parents here...
3586 set coords
[list
$x $y]
3588 # if attaching to a vertical segment, draw a smaller
3589 # slant for visual distinctness
3592 lappend coords
[expr {$x2 + $d}] $y $x2 $ymid
3594 lappend coords
[expr {$x2 - $d}] $y $x2 $ymid
3596 } elseif
{$i < $col && $i < $j} {
3597 # segment slants towards us already
3598 lappend coords
[xc
$row $j] $y
3600 if {$i < $col - 1} {
3601 lappend coords
[expr {$x2 + $linespc}] $y
3602 } elseif
{$i > $col + 1} {
3603 lappend coords
[expr {$x2 - $linespc}] $y
3605 lappend coords
$x2 $y2
3608 lappend coords
$x2 $y2
3610 set t
[$canv create line
$coords -width [linewidth
$p] \
3611 -fill $colormap($p) -tags lines.
$p]
3615 if {$rmx > [lindex
$idpos($id) 1]} {
3616 lset idpos
($id) 1 $rmx
3621 proc drawlines
{id
} {
3624 $canv itemconf lines.
$id -width [linewidth
$id]
3627 proc drawcmittext
{id row
col} {
3628 global linespc canv canv2 canv3 canvy0 fgcolor curview
3629 global commitlisted commitinfo rowidlist parentlist
3630 global rowtextx idpos idtags idheads idotherrefs
3631 global linehtag linentag linedtag selectedline
3632 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3634 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3635 set listed
[lindex
$commitlisted $row]
3636 if {$id eq
$nullid} {
3638 } elseif
{$id eq
$nullid2} {
3641 set ofill
[expr {$listed != 0?
"blue": "white"}]
3643 set x
[xc
$row $col]
3645 set orad
[expr {$linespc / 3}]
3647 set t
[$canv create oval
[expr {$x - $orad}] [expr {$y - $orad}] \
3648 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3649 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3650 } elseif
{$listed == 2} {
3651 # triangle pointing left for left-side commits
3652 set t
[$canv create polygon \
3653 [expr {$x - $orad}] $y \
3654 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3655 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3656 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3658 # triangle pointing right for right-side commits
3659 set t
[$canv create polygon \
3660 [expr {$x + $orad - 1}] $y \
3661 [expr {$x - $orad}] [expr {$y - $orad}] \
3662 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3663 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3666 $canv bind $t <1> {selcanvline
{} %x
%y
}
3667 set rmx
[llength
[lindex
$rowidlist $row]]
3668 set olds
[lindex
$parentlist $row]
3670 set nextids
[lindex
$rowidlist [expr {$row + 1}]]
3672 set i
[lsearch
-exact $nextids $p]
3678 set xt
[xc
$row $rmx]
3679 set rowtextx
($row) $xt
3680 set idpos
($id) [list
$x $xt $y]
3681 if {[info exists idtags
($id)] ||
[info exists idheads
($id)]
3682 ||
[info exists idotherrefs
($id)]} {
3683 set xt
[drawtags
$id $x $xt $y]
3685 set headline
[lindex
$commitinfo($id) 0]
3686 set name
[lindex
$commitinfo($id) 1]
3687 set date [lindex
$commitinfo($id) 2]
3688 set date [formatdate
$date]
3691 set isbold
[ishighlighted
$row]
3693 lappend boldrows
$row
3694 set font mainfontbold
3696 lappend boldnamerows
$row
3697 set nfont mainfontbold
3700 set linehtag
($row) [$canv create text
$xt $y -anchor w
-fill $fgcolor \
3701 -text $headline -font $font -tags text
]
3702 $canv bind $linehtag($row) <Button-3
> "rowmenu %X %Y $id"
3703 set linentag
($row) [$canv2 create text
3 $y -anchor w
-fill $fgcolor \
3704 -text $name -font $nfont -tags text
]
3705 set linedtag
($row) [$canv3 create text
3 $y -anchor w
-fill $fgcolor \
3706 -text $date -font mainfont
-tags text
]
3707 if {[info exists selectedline
] && $selectedline == $row} {
3710 set xr
[expr {$xt + [font measure
$font $headline]}]
3711 if {$xr > $canvxmax} {
3717 proc drawcmitrow
{row
} {
3718 global displayorder rowidlist nrows_drawn
3719 global iddrawn markingmatches
3720 global commitinfo parentlist numcommits
3721 global filehighlight fhighlights findpattern nhighlights
3722 global hlview vhighlights
3723 global highlight_related rhighlights
3725 if {$row >= $numcommits} return
3727 set id
[lindex
$displayorder $row]
3728 if {[info exists hlview
] && ![info exists vhighlights
($row)]} {
3729 askvhighlight
$row $id
3731 if {[info exists filehighlight
] && ![info exists fhighlights
($row)]} {
3732 askfilehighlight
$row $id
3734 if {$findpattern ne
{} && ![info exists nhighlights
($row)]} {
3735 askfindhighlight
$row $id
3737 if {$highlight_related ne
[mc
"None"] && ![info exists rhighlights
($row)]} {
3738 askrelhighlight
$row $id
3740 if {![info exists iddrawn
($id)]} {
3741 set col [lsearch
-exact [lindex
$rowidlist $row] $id]
3743 puts
"oops, row $row id $id not in list"
3746 if {![info exists commitinfo
($id)]} {
3750 drawcmittext
$id $row $col
3754 if {$markingmatches} {
3755 markrowmatches
$row $id
3759 proc drawcommits
{row
{endrow
{}}} {
3760 global numcommits iddrawn displayorder curview need_redisplay
3761 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3766 if {$endrow eq
{}} {
3769 if {$endrow >= $numcommits} {
3770 set endrow
[expr {$numcommits - 1}]
3773 set rl1
[expr {$row - $downarrowlen - 3}]
3777 set ro1
[expr {$row - 3}]
3781 set r2
[expr {$endrow + $uparrowlen + 3}]
3782 if {$r2 > $numcommits} {
3785 for {set r
$rl1} {$r < $r2} {incr r
} {
3786 if {[lindex
$rowidlist $r] ne
{} && [lindex
$rowfinal $r]} {
3790 set rl1
[expr {$r + 1}]
3796 optimize_rows
$ro1 0 $r2
3797 if {$need_redisplay ||
$nrows_drawn > 2000} {
3802 # make the lines join to already-drawn rows either side
3803 set r
[expr {$row - 1}]
3804 if {$r < 0 ||
![info exists iddrawn
([lindex
$displayorder $r])]} {
3807 set er
[expr {$endrow + 1}]
3808 if {$er >= $numcommits ||
3809 ![info exists iddrawn
([lindex
$displayorder $er])]} {
3812 for {} {$r <= $er} {incr r
} {
3813 set id
[lindex
$displayorder $r]
3814 set wasdrawn
[info exists iddrawn
($id)]
3816 if {$r == $er} break
3817 set nextid
[lindex
$displayorder [expr {$r + 1}]]
3818 if {$wasdrawn && [info exists iddrawn
($nextid)]} continue
3819 drawparentlinks
$id $r
3821 set rowids
[lindex
$rowidlist $r]
3822 foreach lid
$rowids {
3823 if {$lid eq
{}} continue
3824 if {[info exists lineend
($lid)] && $lineend($lid) > $r} continue
3826 # see if this is the first child of any of its parents
3827 foreach p
[lindex
$parentlist $r] {
3828 if {[lsearch
-exact $rowids $p] < 0} {
3829 # make this line extend up to the child
3830 set lineend
($p) [drawlineseg
$p $r $er 0]
3834 set lineend
($lid) [drawlineseg
$lid $r $er 1]
3840 proc drawfrac
{f0 f1
} {
3843 set ymax
[lindex
[$canv cget
-scrollregion] 3]
3844 if {$ymax eq
{} ||
$ymax == 0} return
3845 set y0
[expr {int
($f0 * $ymax)}]
3846 set row
[expr {int
(($y0 - 3) / $linespc) - 1}]
3847 set y1
[expr {int
($f1 * $ymax)}]
3848 set endrow
[expr {int
(($y1 - 3) / $linespc) + 1}]
3849 drawcommits
$row $endrow
3852 proc drawvisible
{} {
3854 eval drawfrac
[$canv yview
]
3857 proc clear_display
{} {
3858 global iddrawn linesegs need_redisplay nrows_drawn
3859 global vhighlights fhighlights nhighlights rhighlights
3862 catch
{unset iddrawn
}
3863 catch
{unset linesegs
}
3864 catch
{unset vhighlights
}
3865 catch
{unset fhighlights
}
3866 catch
{unset nhighlights
}
3867 catch
{unset rhighlights
}
3868 set need_redisplay
0
3872 proc findcrossings
{id
} {
3873 global rowidlist parentlist numcommits displayorder
3877 foreach
{s e
} [rowranges
$id] {
3878 if {$e >= $numcommits} {
3879 set e
[expr {$numcommits - 1}]
3881 if {$e <= $s} continue
3882 for {set row
$e} {[incr row
-1] >= $s} {} {
3883 set x
[lsearch
-exact [lindex
$rowidlist $row] $id]
3885 set olds
[lindex
$parentlist $row]
3886 set kid
[lindex
$displayorder $row]
3887 set kidx
[lsearch
-exact [lindex
$rowidlist $row] $kid]
3888 if {$kidx < 0} continue
3889 set nextrow
[lindex
$rowidlist [expr {$row + 1}]]
3891 set px
[lsearch
-exact $nextrow $p]
3892 if {$px < 0} continue
3893 if {($kidx < $x && $x < $px) ||
($px < $x && $x < $kidx)} {
3894 if {[lsearch
-exact $ccross $p] >= 0} continue
3895 if {$x == $px + ($kidx < $px?
-1: 1)} {
3897 } elseif
{[lsearch
-exact $cross $p] < 0} {
3904 return [concat
$ccross {{}} $cross]
3907 proc assigncolor
{id
} {
3908 global colormap colors nextcolor
3909 global commitrow parentlist children children curview
3911 if {[info exists colormap
($id)]} return
3912 set ncolors
[llength
$colors]
3913 if {[info exists children
($curview,$id)]} {
3914 set kids
$children($curview,$id)
3918 if {[llength
$kids] == 1} {
3919 set child
[lindex
$kids 0]
3920 if {[info exists colormap
($child)]
3921 && [llength
[lindex
$parentlist $commitrow($curview,$child)]] == 1} {
3922 set colormap
($id) $colormap($child)
3928 foreach x
[findcrossings
$id] {
3930 # delimiter between corner crossings and other crossings
3931 if {[llength
$badcolors] >= $ncolors - 1} break
3932 set origbad
$badcolors
3934 if {[info exists colormap
($x)]
3935 && [lsearch
-exact $badcolors $colormap($x)] < 0} {
3936 lappend badcolors
$colormap($x)
3939 if {[llength
$badcolors] >= $ncolors} {
3940 set badcolors
$origbad
3942 set origbad
$badcolors
3943 if {[llength
$badcolors] < $ncolors - 1} {
3944 foreach child
$kids {
3945 if {[info exists colormap
($child)]
3946 && [lsearch
-exact $badcolors $colormap($child)] < 0} {
3947 lappend badcolors
$colormap($child)
3949 foreach p
[lindex
$parentlist $commitrow($curview,$child)] {
3950 if {[info exists colormap
($p)]
3951 && [lsearch
-exact $badcolors $colormap($p)] < 0} {
3952 lappend badcolors
$colormap($p)
3956 if {[llength
$badcolors] >= $ncolors} {
3957 set badcolors
$origbad
3960 for {set i
0} {$i <= $ncolors} {incr i
} {
3961 set c
[lindex
$colors $nextcolor]
3962 if {[incr nextcolor
] >= $ncolors} {
3965 if {[lsearch
-exact $badcolors $c]} break
3967 set colormap
($id) $c
3970 proc bindline
{t id
} {
3973 $canv bind $t <Enter
> "lineenter %x %y $id"
3974 $canv bind $t <Motion
> "linemotion %x %y $id"
3975 $canv bind $t <Leave
> "lineleave $id"
3976 $canv bind $t <Button-1
> "lineclick %x %y $id 1"
3979 proc drawtags
{id x xt y1
} {
3980 global idtags idheads idotherrefs mainhead
3981 global linespc lthickness
3982 global canv commitrow rowtextx curview fgcolor bgcolor
3987 if {[info exists idtags
($id)]} {
3988 set marks
$idtags($id)
3989 set ntags
[llength
$marks]
3991 if {[info exists idheads
($id)]} {
3992 set marks
[concat
$marks $idheads($id)]
3993 set nheads
[llength
$idheads($id)]
3995 if {[info exists idotherrefs
($id)]} {
3996 set marks
[concat
$marks $idotherrefs($id)]
4002 set delta
[expr {int
(0.5 * ($linespc - $lthickness))}]
4003 set yt
[expr {$y1 - 0.5 * $linespc}]
4004 set yb
[expr {$yt + $linespc - 1}]
4008 foreach tag
$marks {
4010 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq
$mainhead} {
4011 set wid
[font measure mainfontbold
$tag]
4013 set wid
[font measure mainfont
$tag]
4017 set xt
[expr {$xt + $delta + $wid + $lthickness + $linespc}]
4019 set t
[$canv create line
$x $y1 [lindex
$xvals end
] $y1 \
4020 -width $lthickness -fill black
-tags tag.
$id]
4022 foreach tag
$marks x
$xvals wid
$wvals {
4023 set xl
[expr {$x + $delta}]
4024 set xr
[expr {$x + $delta + $wid + $lthickness}]
4026 if {[incr ntags
-1] >= 0} {
4028 set t
[$canv create polygon
$x [expr {$yt + $delta}] $xl $yt \
4029 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4030 -width 1 -outline black
-fill yellow
-tags tag.
$id]
4031 $canv bind $t <1> [list showtag
$tag 1]
4032 set rowtextx
($commitrow($curview,$id)) [expr {$xr + $linespc}]
4034 # draw a head or other ref
4035 if {[incr nheads
-1] >= 0} {
4037 if {$tag eq
$mainhead} {
4038 set font mainfontbold
4043 set xl
[expr {$xl - $delta/2}]
4044 $canv create polygon
$x $yt $xr $yt $xr $yb $x $yb \
4045 -width 1 -outline black
-fill $col -tags tag.
$id
4046 if {[regexp
{^
(remotes
/.
*/|remotes
/)} $tag match remoteprefix
]} {
4047 set rwid
[font measure mainfont
$remoteprefix]
4048 set xi
[expr {$x + 1}]
4049 set yti
[expr {$yt + 1}]
4050 set xri
[expr {$x + $rwid}]
4051 $canv create polygon
$xi $yti $xri $yti $xri $yb $xi $yb \
4052 -width 0 -fill "#ffddaa" -tags tag.
$id
4055 set t
[$canv create text
$xl $y1 -anchor w
-text $tag -fill $fgcolor \
4056 -font $font -tags [list tag.
$id text
]]
4058 $canv bind $t <1> [list showtag
$tag 1]
4059 } elseif
{$nheads >= 0} {
4060 $canv bind $t <Button-3
> [list headmenu
%X
%Y
$id $tag]
4066 proc xcoord
{i level
ln} {
4067 global canvx0 xspc1 xspc2
4069 set x
[expr {$canvx0 + $i * $xspc1($ln)}]
4070 if {$i > 0 && $i == $level} {
4071 set x
[expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4072 } elseif
{$i > $level} {
4073 set x
[expr {$x + $xspc2 - $xspc1($ln)}]
4078 proc show_status
{msg
} {
4082 $canv create text
3 3 -anchor nw
-text $msg -font mainfont \
4083 -tags text
-fill $fgcolor
4086 # Insert a new commit as the child of the commit on row $row.
4087 # The new commit will be displayed on row $row and the commits
4088 # on that row and below will move down one row.
4089 proc insertrow
{row newcmit
} {
4090 global displayorder parentlist commitlisted children
4091 global commitrow curview rowidlist rowisopt rowfinal numcommits
4093 global selectedline commitidx ordertok
4095 if {$row >= $numcommits} {
4096 puts
"oops, inserting new row $row but only have $numcommits rows"
4099 set p
[lindex
$displayorder $row]
4100 set displayorder
[linsert
$displayorder $row $newcmit]
4101 set parentlist
[linsert
$parentlist $row $p]
4102 set kids
$children($curview,$p)
4103 lappend kids
$newcmit
4104 set children
($curview,$p) $kids
4105 set children
($curview,$newcmit) {}
4106 set commitlisted
[linsert
$commitlisted $row 1]
4107 set l
[llength
$displayorder]
4108 for {set r
$row} {$r < $l} {incr r
} {
4109 set id
[lindex
$displayorder $r]
4110 set commitrow
($curview,$id) $r
4112 incr commitidx
($curview)
4113 set ordertok
($curview,$newcmit) $ordertok($curview,$p)
4115 if {$row < [llength
$rowidlist]} {
4116 set idlist
[lindex
$rowidlist $row]
4117 if {$idlist ne
{}} {
4118 if {[llength
$kids] == 1} {
4119 set col [lsearch
-exact $idlist $p]
4120 lset idlist
$col $newcmit
4122 set col [llength
$idlist]
4123 lappend idlist
$newcmit
4126 set rowidlist
[linsert
$rowidlist $row $idlist]
4127 set rowisopt
[linsert
$rowisopt $row 0]
4128 set rowfinal
[linsert
$rowfinal $row [lindex
$rowfinal $row]]
4133 if {[info exists selectedline
] && $selectedline >= $row} {
4139 # Remove a commit that was inserted with insertrow on row $row.
4140 proc removerow
{row
} {
4141 global displayorder parentlist commitlisted children
4142 global commitrow curview rowidlist rowisopt rowfinal numcommits
4144 global linesegends selectedline commitidx
4146 if {$row >= $numcommits} {
4147 puts
"oops, removing row $row but only have $numcommits rows"
4150 set rp1
[expr {$row + 1}]
4151 set id
[lindex
$displayorder $row]
4152 set p
[lindex
$parentlist $row]
4153 set displayorder
[lreplace
$displayorder $row $row]
4154 set parentlist
[lreplace
$parentlist $row $row]
4155 set commitlisted
[lreplace
$commitlisted $row $row]
4156 set kids
$children($curview,$p)
4157 set i
[lsearch
-exact $kids $id]
4159 set kids
[lreplace
$kids $i $i]
4160 set children
($curview,$p) $kids
4162 set l
[llength
$displayorder]
4163 for {set r
$row} {$r < $l} {incr r
} {
4164 set id
[lindex
$displayorder $r]
4165 set commitrow
($curview,$id) $r
4167 incr commitidx
($curview) -1
4169 if {$row < [llength
$rowidlist]} {
4170 set rowidlist
[lreplace
$rowidlist $row $row]
4171 set rowisopt
[lreplace
$rowisopt $row $row]
4172 set rowfinal
[lreplace
$rowfinal $row $row]
4177 if {[info exists selectedline
] && $selectedline > $row} {
4178 incr selectedline
-1
4183 # Don't change the text pane cursor if it is currently the hand cursor,
4184 # showing that we are over a sha1 ID link.
4185 proc settextcursor
{c
} {
4186 global ctext curtextcursor
4188 if {[$ctext cget
-cursor] == $curtextcursor} {
4189 $ctext config
-cursor $c
4191 set curtextcursor
$c
4194 proc nowbusy
{what
{name
{}}} {
4195 global isbusy busyname statusw
4197 if {[array names isbusy
] eq
{}} {
4198 . config
-cursor watch
4202 set busyname
($what) $name
4204 $statusw conf
-text $name
4208 proc notbusy
{what
} {
4209 global isbusy maincursor textcursor busyname statusw
4213 if {$busyname($what) ne
{} &&
4214 [$statusw cget
-text] eq
$busyname($what)} {
4215 $statusw conf
-text {}
4218 if {[array names isbusy
] eq
{}} {
4219 . config
-cursor $maincursor
4220 settextcursor
$textcursor
4224 proc findmatches
{f
} {
4225 global findtype findstring
4226 if {$findtype == [mc
"Regexp"]} {
4227 set matches
[regexp
-indices -all -inline $findstring $f]
4230 if {$findtype == [mc
"IgnCase"]} {
4231 set f
[string tolower
$f]
4232 set fs
[string tolower
$fs]
4236 set l
[string length
$fs]
4237 while {[set j
[string first
$fs $f $i]] >= 0} {
4238 lappend matches
[list
$j [expr {$j+$l-1}]]
4239 set i
[expr {$j + $l}]
4245 proc dofind
{{dirn
1} {wrap
1}} {
4246 global findstring findstartline findcurline selectedline numcommits
4247 global gdttype filehighlight fh_serial find_dirn findallowwrap
4249 if {[info exists find_dirn
]} {
4250 if {$find_dirn == $dirn} return
4254 if {$findstring eq
{} ||
$numcommits == 0} return
4255 if {![info exists selectedline
]} {
4256 set findstartline
[lindex
[visiblerows
] [expr {$dirn < 0}]]
4258 set findstartline
$selectedline
4260 set findcurline
$findstartline
4261 nowbusy finding
[mc
"Searching"]
4262 if {$gdttype ne
[mc
"containing:"] && ![info exists filehighlight
]} {
4263 after cancel do_file_hl
$fh_serial
4264 do_file_hl
$fh_serial
4267 set findallowwrap
$wrap
4271 proc stopfinding
{} {
4272 global find_dirn findcurline fprogcoord
4274 if {[info exists find_dirn
]} {
4284 global commitdata commitinfo numcommits findpattern findloc
4285 global findstartline findcurline displayorder
4286 global find_dirn gdttype fhighlights fprogcoord
4287 global findallowwrap
4289 if {![info exists find_dirn
]} {
4292 set fldtypes
[list
[mc
"Headline"] [mc
"Author"] [mc
"Date"] [mc
"Committer"] [mc
"CDate"] [mc
"Comments"]]
4295 if {$find_dirn > 0} {
4297 if {$l >= $numcommits} {
4300 if {$l <= $findstartline} {
4301 set lim
[expr {$findstartline + 1}]
4304 set moretodo
$findallowwrap
4311 if {$l >= $findstartline} {
4312 set lim
[expr {$findstartline - 1}]
4315 set moretodo
$findallowwrap
4318 set n
[expr {($lim - $l) * $find_dirn}]
4325 if {$gdttype eq
[mc
"containing:"]} {
4326 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4327 set id
[lindex
$displayorder $l]
4328 # shouldn't happen unless git log doesn't give all the commits...
4329 if {![info exists commitdata
($id)]} continue
4330 if {![doesmatch
$commitdata($id)]} continue
4331 if {![info exists commitinfo
($id)]} {
4334 set info
$commitinfo($id)
4335 foreach f
$info ty
$fldtypes {
4336 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
4345 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4346 set id
[lindex
$displayorder $l]
4347 if {![info exists fhighlights
($l)]} {
4348 askfilehighlight
$l $id
4351 set findcurline
[expr {$l - $find_dirn}]
4353 } elseif
{$fhighlights($l)} {
4359 if {$found ||
($domore && !$moretodo)} {
4375 set findcurline
[expr {$l - $find_dirn}]
4377 set n
[expr {($findcurline - $findstartline) * $find_dirn - 1}]
4381 set fprogcoord
[expr {$n * 1.0 / $numcommits}]
4386 proc findselectline
{l
} {
4387 global findloc commentend ctext findcurline markingmatches gdttype
4389 set markingmatches
1
4392 if {$findloc == [mc
"All fields"] ||
$findloc == [mc
"Comments"]} {
4393 # highlight the matches in the comments
4394 set f
[$ctext get
1.0 $commentend]
4395 set matches
[findmatches
$f]
4396 foreach match
$matches {
4397 set start
[lindex
$match 0]
4398 set end
[expr {[lindex
$match 1] + 1}]
4399 $ctext tag add found
"1.0 + $start c" "1.0 + $end c"
4405 # mark the bits of a headline or author that match a find string
4406 proc markmatches
{canv l str tag matches font row
} {
4409 set bbox
[$canv bbox
$tag]
4410 set x0
[lindex
$bbox 0]
4411 set y0
[lindex
$bbox 1]
4412 set y1
[lindex
$bbox 3]
4413 foreach match
$matches {
4414 set start
[lindex
$match 0]
4415 set end
[lindex
$match 1]
4416 if {$start > $end} continue
4417 set xoff
[font measure
$font [string range
$str 0 [expr {$start-1}]]]
4418 set xlen
[font measure
$font [string range
$str 0 [expr {$end}]]]
4419 set t
[$canv create rect
[expr {$x0+$xoff}] $y0 \
4420 [expr {$x0+$xlen+2}] $y1 \
4421 -outline {} -tags [list match
$l matches
] -fill yellow
]
4423 if {[info exists selectedline
] && $row == $selectedline} {
4424 $canv raise
$t secsel
4429 proc unmarkmatches
{} {
4430 global markingmatches
4432 allcanvs delete matches
4433 set markingmatches
0
4437 proc selcanvline
{w x y
} {
4438 global canv canvy0 ctext linespc
4440 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4441 if {$ymax == {}} return
4442 set yfrac
[lindex
[$canv yview
] 0]
4443 set y
[expr {$y + $yfrac * $ymax}]
4444 set l
[expr {int
(($y - $canvy0) / $linespc + 0.5)}]
4449 if {![info exists rowtextx
($l)] ||
$x < $rowtextx($l)} return
4455 proc commit_descriptor
{p
} {
4457 if {![info exists commitinfo
($p)]} {
4461 if {[llength
$commitinfo($p)] > 1} {
4462 set l
[lindex
$commitinfo($p) 0]
4467 # append some text to the ctext widget, and make any SHA1 ID
4468 # that we know about be a clickable link.
4469 proc appendwithlinks
{text tags
} {
4470 global ctext commitrow linknum curview pendinglinks
4472 set start
[$ctext index
"end - 1c"]
4473 $ctext insert end
$text $tags
4474 set links
[regexp
-indices -all -inline {[0-9a-f]{40}} $text]
4478 set linkid
[string range
$text $s $e]
4480 $ctext tag delete link
$linknum
4481 $ctext tag add link
$linknum "$start + $s c" "$start + $e c"
4482 setlink
$linkid link
$linknum
4487 proc setlink
{id lk
} {
4488 global curview commitrow ctext pendinglinks commitinterest
4490 if {[info exists commitrow
($curview,$id)]} {
4491 $ctext tag conf
$lk -foreground blue
-underline 1
4492 $ctext tag
bind $lk <1> [list selectline
$commitrow($curview,$id) 1]
4493 $ctext tag
bind $lk <Enter
> {linkcursor
%W
1}
4494 $ctext tag
bind $lk <Leave
> {linkcursor
%W
-1}
4496 lappend pendinglinks
($id) $lk
4497 lappend commitinterest
($id) {makelink
%I
}
4501 proc makelink
{id
} {
4504 if {![info exists pendinglinks
($id)]} return
4505 foreach lk
$pendinglinks($id) {
4508 unset pendinglinks
($id)
4511 proc linkcursor
{w inc
} {
4512 global linkentercount curtextcursor
4514 if {[incr linkentercount
$inc] > 0} {
4515 $w configure
-cursor hand2
4517 $w configure
-cursor $curtextcursor
4518 if {$linkentercount < 0} {
4519 set linkentercount
0
4524 proc viewnextline
{dir
} {
4528 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4529 set wnow
[$canv yview
]
4530 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4531 set newtop
[expr {$wtop + $dir * $linespc}]
4534 } elseif
{$newtop > $ymax} {
4537 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4540 # add a list of tag or branch names at position pos
4541 # returns the number of names inserted
4542 proc appendrefs
{pos ids var
} {
4543 global ctext commitrow linknum curview
$var maxrefs
4545 if {[catch
{$ctext index
$pos}]} {
4548 $ctext conf
-state normal
4549 $ctext delete
$pos "$pos lineend"
4552 foreach tag
[set $var\
($id\
)] {
4553 lappend tags
[list
$tag $id]
4556 if {[llength
$tags] > $maxrefs} {
4557 $ctext insert
$pos "many ([llength $tags])"
4559 set tags
[lsort
-index 0 -decreasing $tags]
4562 set id
[lindex
$ti 1]
4565 $ctext tag delete
$lk
4566 $ctext insert
$pos $sep
4567 $ctext insert
$pos [lindex
$ti 0] $lk
4572 $ctext conf
-state disabled
4573 return [llength
$tags]
4576 # called when we have finished computing the nearby tags
4577 proc dispneartags
{delay
} {
4578 global selectedline currentid showneartags tagphase
4580 if {![info exists selectedline
] ||
!$showneartags} return
4581 after cancel dispnexttag
4583 after
200 dispnexttag
4586 after idle dispnexttag
4591 proc dispnexttag
{} {
4592 global selectedline currentid showneartags tagphase ctext
4594 if {![info exists selectedline
] ||
!$showneartags} return
4595 switch
-- $tagphase {
4597 set dtags
[desctags
$currentid]
4599 appendrefs precedes
$dtags idtags
4603 set atags
[anctags
$currentid]
4605 appendrefs follows
$atags idtags
4609 set dheads
[descheads
$currentid]
4610 if {$dheads ne
{}} {
4611 if {[appendrefs branch
$dheads idheads
] > 1
4612 && [$ctext get
"branch -3c"] eq
"h"} {
4613 # turn "Branch" into "Branches"
4614 $ctext conf
-state normal
4615 $ctext insert
"branch -2c" "es"
4616 $ctext conf
-state disabled
4621 if {[incr tagphase
] <= 2} {
4622 after idle dispnexttag
4626 proc make_secsel
{l
} {
4627 global linehtag linentag linedtag canv canv2 canv3
4629 if {![info exists linehtag
($l)]} return
4631 set t
[eval $canv create rect
[$canv bbox
$linehtag($l)] -outline {{}} \
4632 -tags secsel
-fill [$canv cget
-selectbackground]]
4634 $canv2 delete secsel
4635 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($l)] -outline {{}} \
4636 -tags secsel
-fill [$canv2 cget
-selectbackground]]
4638 $canv3 delete secsel
4639 set t
[eval $canv3 create rect
[$canv3 bbox
$linedtag($l)] -outline {{}} \
4640 -tags secsel
-fill [$canv3 cget
-selectbackground]]
4644 proc selectline
{l isnew
} {
4645 global canv ctext commitinfo selectedline
4647 global canvy0 linespc parentlist children curview
4648 global currentid sha1entry
4649 global commentend idtags linknum
4650 global mergemax numcommits pending_select
4651 global cmitmode showneartags allcommits
4653 catch
{unset pending_select
}
4658 if {$l < 0 ||
$l >= $numcommits} return
4659 set y
[expr {$canvy0 + $l * $linespc}]
4660 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4661 set ytop
[expr {$y - $linespc - 1}]
4662 set ybot
[expr {$y + $linespc + 1}]
4663 set wnow
[$canv yview
]
4664 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4665 set wbot
[expr {[lindex
$wnow 1] * $ymax}]
4666 set wh
[expr {$wbot - $wtop}]
4668 if {$ytop < $wtop} {
4669 if {$ybot < $wtop} {
4670 set newtop
[expr {$y - $wh / 2.0}]
4673 if {$newtop > $wtop - $linespc} {
4674 set newtop
[expr {$wtop - $linespc}]
4677 } elseif
{$ybot > $wbot} {
4678 if {$ytop > $wbot} {
4679 set newtop
[expr {$y - $wh / 2.0}]
4681 set newtop
[expr {$ybot - $wh}]
4682 if {$newtop < $wtop + $linespc} {
4683 set newtop
[expr {$wtop + $linespc}]
4687 if {$newtop != $wtop} {
4691 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4698 addtohistory
[list selectline
$l 0]
4703 set id
[lindex
$displayorder $l]
4705 $sha1entry delete
0 end
4706 $sha1entry insert
0 $id
4707 $sha1entry selection from
0
4708 $sha1entry selection to end
4711 $ctext conf
-state normal
4714 set info
$commitinfo($id)
4715 set date [formatdate
[lindex
$info 2]]
4716 $ctext insert end
"[mc "Author
"]: [lindex $info 1] $date\n"
4717 set date [formatdate
[lindex
$info 4]]
4718 $ctext insert end
"[mc "Committer
"]: [lindex $info 3] $date\n"
4719 if {[info exists idtags
($id)]} {
4720 $ctext insert end
[mc
"Tags:"]
4721 foreach tag
$idtags($id) {
4722 $ctext insert end
" $tag"
4724 $ctext insert end
"\n"
4728 set olds
[lindex
$parentlist $l]
4729 if {[llength
$olds] > 1} {
4732 if {$np >= $mergemax} {
4737 $ctext insert end
"[mc "Parent
"]: " $tag
4738 appendwithlinks
[commit_descriptor
$p] {}
4743 append headers
"[mc "Parent
"]: [commit_descriptor $p]"
4747 foreach c
$children($curview,$id) {
4748 append headers
"[mc "Child
"]: [commit_descriptor $c]"
4751 # make anything that looks like a SHA1 ID be a clickable link
4752 appendwithlinks
$headers {}
4753 if {$showneartags} {
4754 if {![info exists allcommits
]} {
4757 $ctext insert end
"[mc "Branch
"]: "
4758 $ctext mark
set branch
"end -1c"
4759 $ctext mark gravity branch left
4760 $ctext insert end
"\n[mc "Follows
"]: "
4761 $ctext mark
set follows
"end -1c"
4762 $ctext mark gravity follows left
4763 $ctext insert end
"\n[mc "Precedes
"]: "
4764 $ctext mark
set precedes
"end -1c"
4765 $ctext mark gravity precedes left
4766 $ctext insert end
"\n"
4769 $ctext insert end
"\n"
4770 set comment
[lindex
$info 5]
4771 if {[string first
"\r" $comment] >= 0} {
4772 set comment
[string map
{"\r" "\n "} $comment]
4774 appendwithlinks
$comment {comment
}
4776 $ctext tag remove found
1.0 end
4777 $ctext conf
-state disabled
4778 set commentend
[$ctext index
"end - 1c"]
4780 init_flist
[mc
"Comments"]
4781 if {$cmitmode eq
"tree"} {
4783 } elseif
{[llength
$olds] <= 1} {
4790 proc selfirstline
{} {
4795 proc sellastline
{} {
4798 set l
[expr {$numcommits - 1}]
4802 proc selnextline
{dir
} {
4805 if {![info exists selectedline
]} return
4806 set l
[expr {$selectedline + $dir}]
4811 proc selnextpage
{dir
} {
4812 global canv linespc selectedline numcommits
4814 set lpp
[expr {([winfo height
$canv] - 2) / $linespc}]
4818 allcanvs yview scroll
[expr {$dir * $lpp}] units
4820 if {![info exists selectedline
]} return
4821 set l
[expr {$selectedline + $dir * $lpp}]
4824 } elseif
{$l >= $numcommits} {
4825 set l
[expr $numcommits - 1]
4831 proc unselectline
{} {
4832 global selectedline currentid
4834 catch
{unset selectedline
}
4835 catch
{unset currentid
}
4836 allcanvs delete secsel
4840 proc reselectline
{} {
4843 if {[info exists selectedline
]} {
4844 selectline
$selectedline 0
4848 proc addtohistory
{cmd
} {
4849 global
history historyindex curview
4851 set elt
[list
$curview $cmd]
4852 if {$historyindex > 0
4853 && [lindex
$history [expr {$historyindex - 1}]] == $elt} {
4857 if {$historyindex < [llength
$history]} {
4858 set history [lreplace
$history $historyindex end
$elt]
4860 lappend
history $elt
4863 if {$historyindex > 1} {
4864 .tf.bar.leftbut conf
-state normal
4866 .tf.bar.leftbut conf
-state disabled
4868 .tf.bar.rightbut conf
-state disabled
4874 set view
[lindex
$elt 0]
4875 set cmd
[lindex
$elt 1]
4876 if {$curview != $view} {
4883 global
history historyindex
4886 if {$historyindex > 1} {
4887 incr historyindex
-1
4888 godo
[lindex
$history [expr {$historyindex - 1}]]
4889 .tf.bar.rightbut conf
-state normal
4891 if {$historyindex <= 1} {
4892 .tf.bar.leftbut conf
-state disabled
4897 global
history historyindex
4900 if {$historyindex < [llength
$history]} {
4901 set cmd
[lindex
$history $historyindex]
4904 .tf.bar.leftbut conf
-state normal
4906 if {$historyindex >= [llength
$history]} {
4907 .tf.bar.rightbut conf
-state disabled
4912 global treefilelist treeidlist diffids diffmergeid treepending
4913 global nullid nullid2
4916 catch
{unset diffmergeid
}
4917 if {![info exists treefilelist
($id)]} {
4918 if {![info exists treepending
]} {
4919 if {$id eq
$nullid} {
4920 set cmd
[list | git ls-files
]
4921 } elseif
{$id eq
$nullid2} {
4922 set cmd
[list | git ls-files
--stage -t]
4924 set cmd
[list | git ls-tree
-r $id]
4926 if {[catch
{set gtf
[open
$cmd r
]}]} {
4930 set treefilelist
($id) {}
4931 set treeidlist
($id) {}
4932 fconfigure
$gtf -blocking 0
4933 filerun
$gtf [list gettreeline
$gtf $id]
4940 proc gettreeline
{gtf id
} {
4941 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4944 while {[incr
nl] <= 1000 && [gets
$gtf line
] >= 0} {
4945 if {$diffids eq
$nullid} {
4948 if {$diffids ne
$nullid2 && [lindex
$line 1] ne
"blob"} continue
4949 set i
[string first
"\t" $line]
4950 if {$i < 0} continue
4951 set sha1
[lindex
$line 2]
4952 set fname
[string range
$line [expr {$i+1}] end
]
4953 if {[string index
$fname 0] eq
"\""} {
4954 set fname
[lindex
$fname 0]
4956 lappend treeidlist
($id) $sha1
4958 lappend treefilelist
($id) $fname
4961 return [expr {$nl >= 1000?
2: 1}]
4965 if {$cmitmode ne
"tree"} {
4966 if {![info exists diffmergeid
]} {
4967 gettreediffs
$diffids
4969 } elseif
{$id ne
$diffids} {
4978 global treefilelist treeidlist diffids nullid nullid2
4979 global ctext commentend
4981 set i
[lsearch
-exact $treefilelist($diffids) $f]
4983 puts
"oops, $f not in list for id $diffids"
4986 if {$diffids eq
$nullid} {
4987 if {[catch
{set bf
[open
$f r
]} err
]} {
4988 puts
"oops, can't read $f: $err"
4992 set blob
[lindex
$treeidlist($diffids) $i]
4993 if {[catch
{set bf
[open
[concat | git cat-file blob
$blob] r
]} err
]} {
4994 puts
"oops, error reading blob $blob: $err"
4998 fconfigure
$bf -blocking 0
4999 filerun
$bf [list getblobline
$bf $diffids]
5000 $ctext config
-state normal
5001 clear_ctext
$commentend
5002 $ctext insert end
"\n"
5003 $ctext insert end
"$f\n" filesep
5004 $ctext config
-state disabled
5005 $ctext yview
$commentend
5009 proc getblobline
{bf id
} {
5010 global diffids cmitmode ctext
5012 if {$id ne
$diffids ||
$cmitmode ne
"tree"} {
5016 $ctext config
-state normal
5018 while {[incr
nl] <= 1000 && [gets
$bf line
] >= 0} {
5019 $ctext insert end
"$line\n"
5022 # delete last newline
5023 $ctext delete
"end - 2c" "end - 1c"
5027 $ctext config
-state disabled
5028 return [expr {$nl >= 1000?
2: 1}]
5031 proc mergediff
{id l
} {
5032 global diffmergeid mdifffd
5035 global limitdiffs viewfiles curview
5039 # this doesn't seem to actually affect anything...
5040 set cmd
[concat | git diff-tree
--no-commit-id --cc $id]
5041 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5042 set cmd
[concat
$cmd -- $viewfiles($curview)]
5044 if {[catch
{set mdf
[open
$cmd r
]} err
]} {
5045 error_popup
"[mc "Error getting merge diffs
:"] $err"
5048 fconfigure
$mdf -blocking 0
5049 set mdifffd
($id) $mdf
5050 set np
[llength
[lindex
$parentlist $l]]
5052 filerun
$mdf [list getmergediffline
$mdf $id $np]
5055 proc getmergediffline
{mdf id np
} {
5056 global diffmergeid ctext cflist mergemax
5057 global difffilestart mdifffd
5059 $ctext conf
-state normal
5061 while {[incr nr
] <= 1000 && [gets
$mdf line
] >= 0} {
5062 if {![info exists diffmergeid
] ||
$id != $diffmergeid
5063 ||
$mdf != $mdifffd($id)} {
5067 if {[regexp
{^
diff --cc (.
*)} $line match fname
]} {
5068 # start of a new file
5069 $ctext insert end
"\n"
5070 set here
[$ctext index
"end - 1c"]
5071 lappend difffilestart
$here
5072 add_flist
[list
$fname]
5073 set l
[expr {(78 - [string length
$fname]) / 2}]
5074 set pad
[string range
"----------------------------------------" 1 $l]
5075 $ctext insert end
"$pad $fname $pad\n" filesep
5076 } elseif
{[regexp
{^@@
} $line]} {
5077 $ctext insert end
"$line\n" hunksep
5078 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $line] ||
[regexp
{^index
} $line]} {
5081 # parse the prefix - one ' ', '-' or '+' for each parent
5086 for {set j
0} {$j < $np} {incr j
} {
5087 set c
[string range
$line $j $j]
5090 } elseif
{$c == "-"} {
5092 } elseif
{$c == "+"} {
5101 if {!$isbad && $minuses ne
{} && $pluses eq
{}} {
5102 # line doesn't appear in result, parents in $minuses have the line
5103 set num
[lindex
$minuses 0]
5104 } elseif
{!$isbad && $pluses ne
{} && $minuses eq
{}} {
5105 # line appears in result, parents in $pluses don't have the line
5106 lappend tags mresult
5107 set num
[lindex
$spaces 0]
5110 if {$num >= $mergemax} {
5115 $ctext insert end
"$line\n" $tags
5118 $ctext conf
-state disabled
5123 return [expr {$nr >= 1000?
2: 1}]
5126 proc startdiff
{ids
} {
5127 global treediffs diffids treepending diffmergeid nullid nullid2
5131 catch
{unset diffmergeid
}
5132 if {![info exists treediffs
($ids)] ||
5133 [lsearch
-exact $ids $nullid] >= 0 ||
5134 [lsearch
-exact $ids $nullid2] >= 0} {
5135 if {![info exists treepending
]} {
5143 proc path_filter
{filter name
} {
5145 set l
[string length
$p]
5146 if {[string index
$p end
] eq
"/"} {
5147 if {[string compare
-length $l $p $name] == 0} {
5151 if {[string compare
-length $l $p $name] == 0 &&
5152 ([string length
$name] == $l ||
5153 [string index
$name $l] eq
"/")} {
5161 proc addtocflist
{ids
} {
5164 add_flist
$treediffs($ids)
5168 proc diffcmd
{ids flags
} {
5169 global nullid nullid2
5171 set i
[lsearch
-exact $ids $nullid]
5172 set j
[lsearch
-exact $ids $nullid2]
5174 if {[llength
$ids] > 1 && $j < 0} {
5175 # comparing working directory with some specific revision
5176 set cmd
[concat | git diff-index
$flags]
5178 lappend cmd
-R [lindex
$ids 1]
5180 lappend cmd
[lindex
$ids 0]
5183 # comparing working directory with index
5184 set cmd
[concat | git diff-files
$flags]
5189 } elseif
{$j >= 0} {
5190 set cmd
[concat | git diff-index
--cached $flags]
5191 if {[llength
$ids] > 1} {
5192 # comparing index with specific revision
5194 lappend cmd
-R [lindex
$ids 1]
5196 lappend cmd
[lindex
$ids 0]
5199 # comparing index with HEAD
5203 set cmd
[concat | git diff-tree
-r $flags $ids]
5208 proc gettreediffs
{ids
} {
5209 global treediff treepending
5211 set treepending
$ids
5213 if {[catch
{set gdtf
[open
[diffcmd
$ids {--no-commit-id}] r
]}]} return
5214 fconfigure
$gdtf -blocking 0
5215 filerun
$gdtf [list gettreediffline
$gdtf $ids]
5218 proc gettreediffline
{gdtf ids
} {
5219 global treediff treediffs treepending diffids diffmergeid
5220 global cmitmode viewfiles curview limitdiffs
5223 while {[incr nr
] <= 1000 && [gets
$gdtf line
] >= 0} {
5224 set i
[string first
"\t" $line]
5226 set file [string range
$line [expr {$i+1}] end
]
5227 if {[string index
$file 0] eq
"\""} {
5228 set file [lindex
$file 0]
5230 lappend treediff
$file
5234 return [expr {$nr >= 1000?
2: 1}]
5237 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5239 foreach f
$treediff {
5240 if {[path_filter
$viewfiles($curview) $f]} {
5244 set treediffs
($ids) $flist
5246 set treediffs
($ids) $treediff
5249 if {$cmitmode eq
"tree"} {
5251 } elseif
{$ids != $diffids} {
5252 if {![info exists diffmergeid
]} {
5253 gettreediffs
$diffids
5261 # empty string or positive integer
5262 proc diffcontextvalidate
{v
} {
5263 return [regexp
{^
(|
[1-9][0-9]*)$
} $v]
5266 proc diffcontextchange
{n1 n2 op
} {
5267 global diffcontextstring diffcontext
5269 if {[string is integer
-strict $diffcontextstring]} {
5270 if {$diffcontextstring > 0} {
5271 set diffcontext
$diffcontextstring
5277 proc changeignorespace
{} {
5281 proc getblobdiffs
{ids
} {
5282 global blobdifffd diffids env
5283 global diffinhdr treediffs
5286 global limitdiffs viewfiles curview
5288 set cmd
[diffcmd
$ids "-p -C --no-commit-id -U$diffcontext"]
5292 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5293 set cmd
[concat
$cmd -- $viewfiles($curview)]
5295 if {[catch
{set bdf
[open
$cmd r
]} err
]} {
5296 puts
"error getting diffs: $err"
5300 fconfigure
$bdf -blocking 0
5301 set blobdifffd
($ids) $bdf
5302 filerun
$bdf [list getblobdiffline
$bdf $diffids]
5305 proc setinlist
{var i val
} {
5308 while {[llength
[set $var]] < $i} {
5311 if {[llength
[set $var]] == $i} {
5318 proc makediffhdr
{fname ids
} {
5319 global ctext curdiffstart treediffs
5321 set i
[lsearch
-exact $treediffs($ids) $fname]
5323 setinlist difffilestart
$i $curdiffstart
5325 set l
[expr {(78 - [string length
$fname]) / 2}]
5326 set pad
[string range
"----------------------------------------" 1 $l]
5327 $ctext insert
$curdiffstart "$pad $fname $pad" filesep
5330 proc getblobdiffline
{bdf ids
} {
5331 global diffids blobdifffd ctext curdiffstart
5332 global diffnexthead diffnextnote difffilestart
5333 global diffinhdr treediffs
5336 $ctext conf
-state normal
5337 while {[incr nr
] <= 1000 && [gets
$bdf line
] >= 0} {
5338 if {$ids != $diffids ||
$bdf != $blobdifffd($ids)} {
5342 if {![string compare
-length 11 "diff --git " $line]} {
5343 # trim off "diff --git "
5344 set line
[string range
$line 11 end
]
5346 # start of a new file
5347 $ctext insert end
"\n"
5348 set curdiffstart
[$ctext index
"end - 1c"]
5349 $ctext insert end
"\n" filesep
5350 # If the name hasn't changed the length will be odd,
5351 # the middle char will be a space, and the two bits either
5352 # side will be a/name and b/name, or "a/name" and "b/name".
5353 # If the name has changed we'll get "rename from" and
5354 # "rename to" or "copy from" and "copy to" lines following this,
5355 # and we'll use them to get the filenames.
5356 # This complexity is necessary because spaces in the filename(s)
5357 # don't get escaped.
5358 set l
[string length
$line]
5359 set i
[expr {$l / 2}]
5360 if {!(($l & 1) && [string index
$line $i] eq
" " &&
5361 [string range
$line 2 [expr {$i - 1}]] eq \
5362 [string range
$line [expr {$i + 3}] end
])} {
5365 # unescape if quoted and chop off the a/ from the front
5366 if {[string index
$line 0] eq
"\""} {
5367 set fname
[string range
[lindex
$line 0] 2 end
]
5369 set fname
[string range
$line 2 [expr {$i - 1}]]
5371 makediffhdr
$fname $ids
5373 } elseif
{[regexp
{^@@
-([0-9]+)(,[0-9]+)? \
+([0-9]+)(,[0-9]+)? @@
(.
*)} \
5374 $line match f1l f1c f2l f2c rest
]} {
5375 $ctext insert end
"$line\n" hunksep
5378 } elseif
{$diffinhdr} {
5379 if {![string compare
-length 12 "rename from " $line]} {
5380 set fname
[string range
$line [expr 6 + [string first
" from " $line] ] end
]
5381 if {[string index
$fname 0] eq
"\""} {
5382 set fname
[lindex
$fname 0]
5384 set i
[lsearch
-exact $treediffs($ids) $fname]
5386 setinlist difffilestart
$i $curdiffstart
5388 } elseif
{![string compare
-length 10 $line "rename to "] ||
5389 ![string compare
-length 8 $line "copy to "]} {
5390 set fname
[string range
$line [expr 4 + [string first
" to " $line] ] end
]
5391 if {[string index
$fname 0] eq
"\""} {
5392 set fname
[lindex
$fname 0]
5394 makediffhdr
$fname $ids
5395 } elseif
{[string compare
-length 3 $line "---"] == 0} {
5398 } elseif
{[string compare
-length 3 $line "+++"] == 0} {
5402 $ctext insert end
"$line\n" filesep
5405 set x
[string range
$line 0 0]
5406 if {$x == "-" ||
$x == "+"} {
5407 set tag
[expr {$x == "+"}]
5408 $ctext insert end
"$line\n" d
$tag
5409 } elseif
{$x == " "} {
5410 $ctext insert end
"$line\n"
5412 # "\ No newline at end of file",
5413 # or something else we don't recognize
5414 $ctext insert end
"$line\n" hunksep
5418 $ctext conf
-state disabled
5423 return [expr {$nr >= 1000?
2: 1}]
5426 proc changediffdisp
{} {
5427 global ctext diffelide
5429 $ctext tag conf d0
-elide [lindex
$diffelide 0]
5430 $ctext tag conf d1
-elide [lindex
$diffelide 1]
5434 global difffilestart ctext
5435 set prev
[lindex
$difffilestart 0]
5436 set here
[$ctext index @
0,0]
5437 foreach loc
$difffilestart {
5438 if {[$ctext compare
$loc >= $here]} {
5448 global difffilestart ctext
5449 set here
[$ctext index @
0,0]
5450 foreach loc
$difffilestart {
5451 if {[$ctext compare
$loc > $here]} {
5458 proc clear_ctext
{{first
1.0}} {
5459 global ctext smarktop smarkbot
5462 set l
[lindex
[split $first .
] 0]
5463 if {![info exists smarktop
] ||
[$ctext compare
$first < $smarktop.0]} {
5466 if {![info exists smarkbot
] ||
[$ctext compare
$first < $smarkbot.0]} {
5469 $ctext delete
$first end
5470 if {$first eq
"1.0"} {
5471 catch
{unset pendinglinks
}
5475 proc settabs
{{firstab
{}}} {
5476 global firsttabstop tabstop ctext have_tk85
5478 if {$firstab ne
{} && $have_tk85} {
5479 set firsttabstop
$firstab
5481 set w
[font measure textfont
"0"]
5482 if {$firsttabstop != 0} {
5483 $ctext conf
-tabs [list
[expr {($firsttabstop + $tabstop) * $w}] \
5484 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5485 } elseif
{$have_tk85 ||
$tabstop != 8} {
5486 $ctext conf
-tabs [expr {$tabstop * $w}]
5488 $ctext conf
-tabs {}
5492 proc incrsearch
{name ix op
} {
5493 global ctext searchstring searchdirn
5495 $ctext tag remove found
1.0 end
5496 if {[catch
{$ctext index anchor
}]} {
5497 # no anchor set, use start of selection, or of visible area
5498 set sel
[$ctext tag ranges sel
]
5500 $ctext mark
set anchor
[lindex
$sel 0]
5501 } elseif
{$searchdirn eq
"-forwards"} {
5502 $ctext mark
set anchor @
0,0
5504 $ctext mark
set anchor @
0,[winfo height
$ctext]
5507 if {$searchstring ne
{}} {
5508 set here
[$ctext search
$searchdirn -- $searchstring anchor
]
5517 global sstring ctext searchstring searchdirn
5520 $sstring icursor end
5521 set searchdirn
-forwards
5522 if {$searchstring ne
{}} {
5523 set sel
[$ctext tag ranges sel
]
5525 set start
"[lindex $sel 0] + 1c"
5526 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5529 set match
[$ctext search
-count mlen
-- $searchstring $start]
5530 $ctext tag remove sel
1.0 end
5536 set mend
"$match + $mlen c"
5537 $ctext tag add sel
$match $mend
5538 $ctext mark
unset anchor
5542 proc dosearchback
{} {
5543 global sstring ctext searchstring searchdirn
5546 $sstring icursor end
5547 set searchdirn
-backwards
5548 if {$searchstring ne
{}} {
5549 set sel
[$ctext tag ranges sel
]
5551 set start
[lindex
$sel 0]
5552 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5553 set start @
0,[winfo height
$ctext]
5555 set match
[$ctext search
-backwards -count ml
-- $searchstring $start]
5556 $ctext tag remove sel
1.0 end
5562 set mend
"$match + $ml c"
5563 $ctext tag add sel
$match $mend
5564 $ctext mark
unset anchor
5568 proc searchmark
{first last
} {
5569 global ctext searchstring
5573 set match
[$ctext search
-count mlen
-- $searchstring $mend $last.end
]
5574 if {$match eq
{}} break
5575 set mend
"$match + $mlen c"
5576 $ctext tag add found
$match $mend
5580 proc searchmarkvisible
{doall
} {
5581 global ctext smarktop smarkbot
5583 set topline
[lindex
[split [$ctext index @
0,0] .
] 0]
5584 set botline
[lindex
[split [$ctext index @
0,[winfo height
$ctext]] .
] 0]
5585 if {$doall ||
$botline < $smarktop ||
$topline > $smarkbot} {
5586 # no overlap with previous
5587 searchmark
$topline $botline
5588 set smarktop
$topline
5589 set smarkbot
$botline
5591 if {$topline < $smarktop} {
5592 searchmark
$topline [expr {$smarktop-1}]
5593 set smarktop
$topline
5595 if {$botline > $smarkbot} {
5596 searchmark
[expr {$smarkbot+1}] $botline
5597 set smarkbot
$botline
5602 proc scrolltext
{f0 f1
} {
5605 .bleft.sb
set $f0 $f1
5606 if {$searchstring ne
{}} {
5612 global linespc charspc canvx0 canvy0
5613 global xspc1 xspc2 lthickness
5615 set linespc
[font metrics mainfont
-linespace]
5616 set charspc
[font measure mainfont
"m"]
5617 set canvy0
[expr {int
(3 + 0.5 * $linespc)}]
5618 set canvx0
[expr {int
(3 + 0.5 * $linespc)}]
5619 set lthickness
[expr {int
($linespc / 9) + 1}]
5620 set xspc1
(0) $linespc
5628 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5629 if {$ymax eq
{} ||
$ymax == 0} return
5630 set span
[$canv yview
]
5633 allcanvs yview moveto
[lindex
$span 0]
5635 if {[info exists selectedline
]} {
5636 selectline
$selectedline 0
5637 allcanvs yview moveto
[lindex
$span 0]
5641 proc parsefont
{f n
} {
5644 set fontattr
($f,family
) [lindex
$n 0]
5646 if {$s eq
{} ||
$s == 0} {
5649 set s
[expr {int
(-$s / [winfo fpixels .
1p
] + 0.5)}]
5651 set fontattr
($f,size
) $s
5652 set fontattr
($f,weight
) normal
5653 set fontattr
($f,slant
) roman
5654 foreach style
[lrange
$n 2 end
] {
5657 "bold" {set fontattr
($f,weight
) $style}
5659 "italic" {set fontattr
($f,slant
) $style}
5664 proc fontflags
{f
{isbold
0}} {
5667 return [list
-family $fontattr($f,family
) -size $fontattr($f,size
) \
5668 -weight [expr {$isbold?
"bold": $fontattr($f,weight
)}] \
5669 -slant $fontattr($f,slant
)]
5675 set n
[list
$fontattr($f,family
) $fontattr($f,size
)]
5676 if {$fontattr($f,weight
) eq
"bold"} {
5679 if {$fontattr($f,slant
) eq
"italic"} {
5685 proc incrfont
{inc
} {
5686 global mainfont textfont ctext canv phase cflist showrefstop
5687 global stopped entries fontattr
5690 set s
$fontattr(mainfont
,size
)
5695 set fontattr
(mainfont
,size
) $s
5696 font config mainfont
-size $s
5697 font config mainfontbold
-size $s
5698 set mainfont
[fontname mainfont
]
5699 set s
$fontattr(textfont
,size
)
5704 set fontattr
(textfont
,size
) $s
5705 font config textfont
-size $s
5706 font config textfontbold
-size $s
5707 set textfont
[fontname textfont
]
5714 global sha1entry sha1string
5715 if {[string length
$sha1string] == 40} {
5716 $sha1entry delete
0 end
5720 proc sha1change
{n1 n2 op
} {
5721 global sha1string currentid sha1but
5722 if {$sha1string == {}
5723 ||
([info exists currentid
] && $sha1string == $currentid)} {
5728 if {[$sha1but cget
-state] == $state} return
5729 if {$state == "normal"} {
5730 $sha1but conf
-state normal
-relief raised
-text "[mc "Goto
:"] "
5732 $sha1but conf
-state disabled
-relief flat
-text "[mc "SHA1 ID
:"] "
5736 proc gotocommit
{} {
5737 global sha1string currentid commitrow tagids headids
5738 global displayorder numcommits curview
5740 if {$sha1string == {}
5741 ||
([info exists currentid
] && $sha1string == $currentid)} return
5742 if {[info exists tagids
($sha1string)]} {
5743 set id
$tagids($sha1string)
5744 } elseif
{[info exists headids
($sha1string)]} {
5745 set id
$headids($sha1string)
5747 set id
[string tolower
$sha1string]
5748 if {[regexp
{^
[0-9a-f]{4,39}$
} $id]} {
5750 foreach i
$displayorder {
5751 if {[string match
$id* $i]} {
5755 if {$matches ne
{}} {
5756 if {[llength
$matches] > 1} {
5757 error_popup
[mc
"Short SHA1 id %s is ambiguous" $id]
5760 set id
[lindex
$matches 0]
5764 if {[info exists commitrow
($curview,$id)]} {
5765 selectline
$commitrow($curview,$id) 1
5768 if {[regexp
{^
[0-9a-fA-F]{4,}$
} $sha1string]} {
5769 set msg
[mc
"SHA1 id %s is not known" $sha1string]
5771 set msg
[mc
"Tag/Head %s is not known" $sha1string]
5776 proc lineenter
{x y id
} {
5777 global hoverx hovery hoverid hovertimer
5778 global commitinfo canv
5780 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5784 if {[info exists hovertimer
]} {
5785 after cancel
$hovertimer
5787 set hovertimer
[after
500 linehover
]
5791 proc linemotion
{x y id
} {
5792 global hoverx hovery hoverid hovertimer
5794 if {[info exists hoverid
] && $id == $hoverid} {
5797 if {[info exists hovertimer
]} {
5798 after cancel
$hovertimer
5800 set hovertimer
[after
500 linehover
]
5804 proc lineleave
{id
} {
5805 global hoverid hovertimer canv
5807 if {[info exists hoverid
] && $id == $hoverid} {
5809 if {[info exists hovertimer
]} {
5810 after cancel
$hovertimer
5818 global hoverx hovery hoverid hovertimer
5819 global canv linespc lthickness
5822 set text
[lindex
$commitinfo($hoverid) 0]
5823 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5824 if {$ymax == {}} return
5825 set yfrac
[lindex
[$canv yview
] 0]
5826 set x
[expr {$hoverx + 2 * $linespc}]
5827 set y
[expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5828 set x0
[expr {$x - 2 * $lthickness}]
5829 set y0
[expr {$y - 2 * $lthickness}]
5830 set x1
[expr {$x + [font measure mainfont
$text] + 2 * $lthickness}]
5831 set y1
[expr {$y + $linespc + 2 * $lthickness}]
5832 set t
[$canv create rectangle
$x0 $y0 $x1 $y1 \
5833 -fill \
#ffff80 -outline black -width 1 -tags hover]
5835 set t
[$canv create text
$x $y -anchor nw
-text $text -tags hover \
5840 proc clickisonarrow
{id y
} {
5843 set ranges
[rowranges
$id]
5844 set thresh
[expr {2 * $lthickness + 6}]
5845 set n
[expr {[llength
$ranges] - 1}]
5846 for {set i
1} {$i < $n} {incr i
} {
5847 set row
[lindex
$ranges $i]
5848 if {abs
([yc
$row] - $y) < $thresh} {
5855 proc arrowjump
{id n y
} {
5858 # 1 <-> 2, 3 <-> 4, etc...
5859 set n
[expr {(($n - 1) ^
1) + 1}]
5860 set row
[lindex
[rowranges
$id] $n]
5862 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5863 if {$ymax eq
{} ||
$ymax <= 0} return
5864 set view
[$canv yview
]
5865 set yspan
[expr {[lindex
$view 1] - [lindex
$view 0]}]
5866 set yfrac
[expr {$yt / $ymax - $yspan / 2}]
5870 allcanvs yview moveto
$yfrac
5873 proc lineclick
{x y id isnew
} {
5874 global ctext commitinfo children canv thickerline curview commitrow
5876 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5881 # draw this line thicker than normal
5885 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5886 if {$ymax eq
{}} return
5887 set yfrac
[lindex
[$canv yview
] 0]
5888 set y
[expr {$y + $yfrac * $ymax}]
5890 set dirn
[clickisonarrow
$id $y]
5892 arrowjump
$id $dirn $y
5897 addtohistory
[list lineclick
$x $y $id 0]
5899 # fill the details pane with info about this line
5900 $ctext conf
-state normal
5903 $ctext insert end
"[mc "Parent
"]:\t"
5904 $ctext insert end
$id link0
5906 set info
$commitinfo($id)
5907 $ctext insert end
"\n\t[lindex $info 0]\n"
5908 $ctext insert end
"\t[mc "Author
"]:\t[lindex $info 1]\n"
5909 set date [formatdate
[lindex
$info 2]]
5910 $ctext insert end
"\t[mc "Date
"]:\t$date\n"
5911 set kids
$children($curview,$id)
5913 $ctext insert end
"\n[mc "Children
"]:"
5915 foreach child
$kids {
5917 if {![info exists commitinfo
($child)] && ![getcommit
$child]} continue
5918 set info
$commitinfo($child)
5919 $ctext insert end
"\n\t"
5920 $ctext insert end
$child link
$i
5921 setlink
$child link
$i
5922 $ctext insert end
"\n\t[lindex $info 0]"
5923 $ctext insert end
"\n\t[mc "Author
"]:\t[lindex $info 1]"
5924 set date [formatdate
[lindex
$info 2]]
5925 $ctext insert end
"\n\t[mc "Date
"]:\t$date\n"
5928 $ctext conf
-state disabled
5932 proc normalline
{} {
5934 if {[info exists thickerline
]} {
5942 global commitrow curview
5943 if {[info exists commitrow
($curview,$id)]} {
5944 selectline
$commitrow($curview,$id) 1
5950 if {![info exists startmstime
]} {
5951 set startmstime
[clock clicks
-milliseconds]
5953 return [format
"%.3f" [expr {([clock click
-milliseconds] - $startmstime) / 1000.0}]]
5956 proc rowmenu
{x y id
} {
5957 global rowctxmenu commitrow selectedline rowmenuid curview
5958 global nullid nullid2 fakerowmenu mainhead
5962 if {![info exists selectedline
]
5963 ||
$commitrow($curview,$id) eq
$selectedline} {
5968 if {$id ne
$nullid && $id ne
$nullid2} {
5969 set menu
$rowctxmenu
5970 $menu entryconfigure
7 -label [mc
"Reset %s branch to here" $mainhead]
5972 set menu
$fakerowmenu
5974 $menu entryconfigure
[mc
"Diff this -> selected"] -state $state
5975 $menu entryconfigure
[mc
"Diff selected -> this"] -state $state
5976 $menu entryconfigure
[mc
"Make patch"] -state $state
5977 tk_popup
$menu $x $y
5980 proc diffvssel
{dirn
} {
5981 global rowmenuid selectedline displayorder
5983 if {![info exists selectedline
]} return
5985 set oldid
[lindex
$displayorder $selectedline]
5986 set newid
$rowmenuid
5988 set oldid
$rowmenuid
5989 set newid
[lindex
$displayorder $selectedline]
5991 addtohistory
[list doseldiff
$oldid $newid]
5992 doseldiff
$oldid $newid
5995 proc doseldiff
{oldid newid
} {
5999 $ctext conf
-state normal
6001 init_flist
[mc
"Top"]
6002 $ctext insert end
"[mc "From
"] "
6003 $ctext insert end
$oldid link0
6004 setlink
$oldid link0
6005 $ctext insert end
"\n "
6006 $ctext insert end
[lindex
$commitinfo($oldid) 0]
6007 $ctext insert end
"\n\n[mc "To
"] "
6008 $ctext insert end
$newid link1
6009 setlink
$newid link1
6010 $ctext insert end
"\n "
6011 $ctext insert end
[lindex
$commitinfo($newid) 0]
6012 $ctext insert end
"\n"
6013 $ctext conf
-state disabled
6014 $ctext tag remove found
1.0 end
6015 startdiff
[list
$oldid $newid]
6019 global rowmenuid currentid commitinfo patchtop patchnum
6021 if {![info exists currentid
]} return
6022 set oldid
$currentid
6023 set oldhead
[lindex
$commitinfo($oldid) 0]
6024 set newid
$rowmenuid
6025 set newhead
[lindex
$commitinfo($newid) 0]
6028 catch
{destroy
$top}
6030 label
$top.title
-text [mc
"Generate patch"]
6031 grid
$top.title
- -pady 10
6032 label
$top.from
-text [mc
"From:"]
6033 entry
$top.fromsha1
-width 40 -relief flat
6034 $top.fromsha1 insert
0 $oldid
6035 $top.fromsha1 conf
-state readonly
6036 grid
$top.from
$top.fromsha1
-sticky w
6037 entry
$top.fromhead
-width 60 -relief flat
6038 $top.fromhead insert
0 $oldhead
6039 $top.fromhead conf
-state readonly
6040 grid x
$top.fromhead
-sticky w
6041 label
$top.to
-text [mc
"To:"]
6042 entry
$top.tosha1
-width 40 -relief flat
6043 $top.tosha1 insert
0 $newid
6044 $top.tosha1 conf
-state readonly
6045 grid
$top.to
$top.tosha1
-sticky w
6046 entry
$top.tohead
-width 60 -relief flat
6047 $top.tohead insert
0 $newhead
6048 $top.tohead conf
-state readonly
6049 grid x
$top.tohead
-sticky w
6050 button
$top.
rev -text [mc
"Reverse"] -command mkpatchrev
-padx 5
6051 grid
$top.
rev x
-pady 10
6052 label
$top.flab
-text [mc
"Output file:"]
6053 entry
$top.fname
-width 60
6054 $top.fname insert
0 [file normalize
"patch$patchnum.patch"]
6056 grid
$top.flab
$top.fname
-sticky w
6058 button
$top.buts.gen
-text [mc
"Generate"] -command mkpatchgo
6059 button
$top.buts.can
-text [mc
"Cancel"] -command mkpatchcan
6060 grid
$top.buts.gen
$top.buts.can
6061 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6062 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6063 grid
$top.buts
- -pady 10 -sticky ew
6067 proc mkpatchrev
{} {
6070 set oldid
[$patchtop.fromsha1 get
]
6071 set oldhead
[$patchtop.fromhead get
]
6072 set newid
[$patchtop.tosha1 get
]
6073 set newhead
[$patchtop.tohead get
]
6074 foreach e
[list fromsha1 fromhead tosha1 tohead
] \
6075 v
[list
$newid $newhead $oldid $oldhead] {
6076 $patchtop.
$e conf
-state normal
6077 $patchtop.
$e delete
0 end
6078 $patchtop.
$e insert
0 $v
6079 $patchtop.
$e conf
-state readonly
6084 global patchtop nullid nullid2
6086 set oldid
[$patchtop.fromsha1 get
]
6087 set newid
[$patchtop.tosha1 get
]
6088 set fname
[$patchtop.fname get
]
6089 set cmd
[diffcmd
[list
$oldid $newid] -p]
6090 # trim off the initial "|"
6091 set cmd
[lrange
$cmd 1 end
]
6092 lappend cmd
>$fname &
6093 if {[catch
{eval exec $cmd} err
]} {
6094 error_popup
"[mc "Error creating
patch:"] $err"
6096 catch
{destroy
$patchtop}
6100 proc mkpatchcan
{} {
6103 catch
{destroy
$patchtop}
6108 global rowmenuid mktagtop commitinfo
6112 catch
{destroy
$top}
6114 label
$top.title
-text [mc
"Create tag"]
6115 grid
$top.title
- -pady 10
6116 label
$top.id
-text [mc
"ID:"]
6117 entry
$top.sha1
-width 40 -relief flat
6118 $top.sha1 insert
0 $rowmenuid
6119 $top.sha1 conf
-state readonly
6120 grid
$top.id
$top.sha1
-sticky w
6121 entry
$top.
head -width 60 -relief flat
6122 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6123 $top.
head conf
-state readonly
6124 grid x
$top.
head -sticky w
6125 label
$top.tlab
-text [mc
"Tag name:"]
6126 entry
$top.tag
-width 60
6127 grid
$top.tlab
$top.tag
-sticky w
6129 button
$top.buts.gen
-text [mc
"Create"] -command mktaggo
6130 button
$top.buts.can
-text [mc
"Cancel"] -command mktagcan
6131 grid
$top.buts.gen
$top.buts.can
6132 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6133 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6134 grid
$top.buts
- -pady 10 -sticky ew
6139 global mktagtop env tagids idtags
6141 set id
[$mktagtop.sha1 get
]
6142 set tag
[$mktagtop.tag get
]
6144 error_popup
[mc
"No tag name specified"]
6147 if {[info exists tagids
($tag)]} {
6148 error_popup
[mc
"Tag \"%s\" already exists" $tag]
6152 exec git tag
$tag $id
6154 error_popup
"[mc "Error creating tag
:"] $err"
6158 set tagids
($tag) $id
6159 lappend idtags
($id) $tag
6166 proc redrawtags
{id
} {
6167 global canv linehtag commitrow idpos selectedline curview
6168 global canvxmax iddrawn
6170 if {![info exists commitrow
($curview,$id)]} return
6171 if {![info exists iddrawn
($id)]} return
6172 drawcommits
$commitrow($curview,$id)
6173 $canv delete tag.
$id
6174 set xt
[eval drawtags
$id $idpos($id)]
6175 $canv coords
$linehtag($commitrow($curview,$id)) $xt [lindex
$idpos($id) 2]
6176 set text
[$canv itemcget
$linehtag($commitrow($curview,$id)) -text]
6177 set xr
[expr {$xt + [font measure mainfont
$text]}]
6178 if {$xr > $canvxmax} {
6182 if {[info exists selectedline
]
6183 && $selectedline == $commitrow($curview,$id)} {
6184 selectline
$selectedline 0
6191 catch
{destroy
$mktagtop}
6200 proc writecommit
{} {
6201 global rowmenuid wrcomtop commitinfo wrcomcmd
6203 set top .writecommit
6205 catch
{destroy
$top}
6207 label
$top.title
-text [mc
"Write commit to file"]
6208 grid
$top.title
- -pady 10
6209 label
$top.id
-text [mc
"ID:"]
6210 entry
$top.sha1
-width 40 -relief flat
6211 $top.sha1 insert
0 $rowmenuid
6212 $top.sha1 conf
-state readonly
6213 grid
$top.id
$top.sha1
-sticky w
6214 entry
$top.
head -width 60 -relief flat
6215 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6216 $top.
head conf
-state readonly
6217 grid x
$top.
head -sticky w
6218 label
$top.clab
-text [mc
"Command:"]
6219 entry
$top.cmd
-width 60 -textvariable wrcomcmd
6220 grid
$top.clab
$top.cmd
-sticky w
-pady 10
6221 label
$top.flab
-text [mc
"Output file:"]
6222 entry
$top.fname
-width 60
6223 $top.fname insert
0 [file normalize
"commit-[string range $rowmenuid 0 6]"]
6224 grid
$top.flab
$top.fname
-sticky w
6226 button
$top.buts.gen
-text [mc
"Write"] -command wrcomgo
6227 button
$top.buts.can
-text [mc
"Cancel"] -command wrcomcan
6228 grid
$top.buts.gen
$top.buts.can
6229 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6230 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6231 grid
$top.buts
- -pady 10 -sticky ew
6238 set id
[$wrcomtop.sha1 get
]
6239 set cmd
"echo $id | [$wrcomtop.cmd get]"
6240 set fname
[$wrcomtop.fname get
]
6241 if {[catch
{exec sh
-c $cmd >$fname &} err
]} {
6242 error_popup
"[mc "Error writing commit
:"] $err"
6244 catch
{destroy
$wrcomtop}
6251 catch
{destroy
$wrcomtop}
6256 global rowmenuid mkbrtop
6259 catch
{destroy
$top}
6261 label
$top.title
-text [mc
"Create new branch"]
6262 grid
$top.title
- -pady 10
6263 label
$top.id
-text [mc
"ID:"]
6264 entry
$top.sha1
-width 40 -relief flat
6265 $top.sha1 insert
0 $rowmenuid
6266 $top.sha1 conf
-state readonly
6267 grid
$top.id
$top.sha1
-sticky w
6268 label
$top.nlab
-text [mc
"Name:"]
6269 entry
$top.name
-width 40
6270 grid
$top.nlab
$top.name
-sticky w
6272 button
$top.buts.go
-text [mc
"Create"] -command [list mkbrgo
$top]
6273 button
$top.buts.can
-text [mc
"Cancel"] -command "catch {destroy $top}"
6274 grid
$top.buts.go
$top.buts.can
6275 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6276 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6277 grid
$top.buts
- -pady 10 -sticky ew
6282 global headids idheads
6284 set name
[$top.name get
]
6285 set id
[$top.sha1 get
]
6287 error_popup
[mc
"Please specify a name for the new branch"]
6290 catch
{destroy
$top}
6294 exec git branch
$name $id
6299 set headids
($name) $id
6300 lappend idheads
($id) $name
6309 proc cherrypick
{} {
6310 global rowmenuid curview commitrow
6313 set oldhead
[exec git rev-parse HEAD
]
6314 set dheads
[descheads
$rowmenuid]
6315 if {$dheads ne
{} && [lsearch
-exact $dheads $oldhead] >= 0} {
6316 set ok
[confirm_popup
[mc
"Commit %s is already\
6317 included in branch %s -- really re-apply it?" \
6318 [string range
$rowmenuid 0 7] $mainhead]]
6321 nowbusy cherrypick
[mc
"Cherry-picking"]
6323 # Unfortunately git-cherry-pick writes stuff to stderr even when
6324 # no error occurs, and exec takes that as an indication of error...
6325 if {[catch
{exec sh
-c "git cherry-pick -r $rowmenuid 2>&1"} err
]} {
6330 set newhead
[exec git rev-parse HEAD
]
6331 if {$newhead eq
$oldhead} {
6333 error_popup
[mc
"No changes committed"]
6336 addnewchild
$newhead $oldhead
6337 if {[info exists commitrow
($curview,$oldhead)]} {
6338 insertrow
$commitrow($curview,$oldhead) $newhead
6339 if {$mainhead ne
{}} {
6340 movehead
$newhead $mainhead
6341 movedhead
$newhead $mainhead
6350 global mainheadid mainhead rowmenuid confirm_ok resettype
6353 set w
".confirmreset"
6356 wm title
$w [mc
"Confirm reset"]
6357 message
$w.m
-text \
6358 [mc
"Reset branch %s to %s?" $mainhead [string range
$rowmenuid 0 7]] \
6359 -justify center
-aspect 1000
6360 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
6361 frame
$w.f
-relief sunken
-border 2
6362 message
$w.f.rt
-text [mc
"Reset type:"] -aspect 1000
6363 grid
$w.f.rt
-sticky w
6365 radiobutton
$w.f.soft
-value soft
-variable resettype
-justify left \
6366 -text [mc
"Soft: Leave working tree and index untouched"]
6367 grid
$w.f.soft
-sticky w
6368 radiobutton
$w.f.mixed
-value mixed
-variable resettype
-justify left \
6369 -text [mc
"Mixed: Leave working tree untouched, reset index"]
6370 grid
$w.f.mixed
-sticky w
6371 radiobutton
$w.f.hard
-value hard
-variable resettype
-justify left \
6372 -text [mc
"Hard: Reset working tree and index\n(discard ALL local changes)"]
6373 grid
$w.f.hard
-sticky w
6374 pack
$w.f
-side top
-fill x
6375 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
6376 pack
$w.ok
-side left
-fill x
-padx 20 -pady 20
6377 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
6378 pack
$w.cancel
-side right
-fill x
-padx 20 -pady 20
6379 bind $w <Visibility
> "grab $w; focus $w"
6381 if {!$confirm_ok} return
6382 if {[catch
{set fd
[open \
6383 [list | sh
-c "git reset --$resettype $rowmenuid 2>&1"] r
]} err
]} {
6387 filerun
$fd [list readresetstat
$fd]
6388 nowbusy
reset [mc
"Resetting"]
6392 proc readresetstat
{fd
} {
6393 global mainhead mainheadid showlocalchanges rprogcoord
6395 if {[gets
$fd line
] >= 0} {
6396 if {[regexp
{([0-9]+)% \
(([0-9]+)/([0-9]+)\
)} $line match p m n
]} {
6397 set rprogcoord
[expr {1.0 * $m / $n}]
6405 if {[catch
{close
$fd} err
]} {
6408 set oldhead
$mainheadid
6409 set newhead
[exec git rev-parse HEAD
]
6410 if {$newhead ne
$oldhead} {
6411 movehead
$newhead $mainhead
6412 movedhead
$newhead $mainhead
6413 set mainheadid
$newhead
6417 if {$showlocalchanges} {
6423 # context menu for a head
6424 proc headmenu
{x y id
head} {
6425 global headmenuid headmenuhead headctxmenu mainhead
6429 set headmenuhead
$head
6431 if {$head eq
$mainhead} {
6434 $headctxmenu entryconfigure
0 -state $state
6435 $headctxmenu entryconfigure
1 -state $state
6436 tk_popup
$headctxmenu $x $y
6440 global headmenuid headmenuhead mainhead headids
6441 global showlocalchanges mainheadid
6443 # check the tree is clean first??
6444 set oldmainhead
$mainhead
6445 nowbusy checkout
[mc
"Checking out"]
6449 exec git checkout
-q $headmenuhead
6455 set mainhead
$headmenuhead
6456 set mainheadid
$headmenuid
6457 if {[info exists headids
($oldmainhead)]} {
6458 redrawtags
$headids($oldmainhead)
6460 redrawtags
$headmenuid
6462 if {$showlocalchanges} {
6468 global headmenuid headmenuhead mainhead
6471 set head $headmenuhead
6473 # this check shouldn't be needed any more...
6474 if {$head eq
$mainhead} {
6475 error_popup
[mc
"Cannot delete the currently checked-out branch"]
6478 set dheads
[descheads
$id]
6479 if {[llength
$dheads] == 1 && $idheads($dheads) eq
$head} {
6480 # the stuff on this branch isn't on any other branch
6481 if {![confirm_popup
[mc
"The commits on branch %s aren't on any other\
6482 branch.\nReally delete branch %s?" $head $head]]} return
6486 if {[catch
{exec git branch
-D $head} err
]} {
6491 removehead
$id $head
6492 removedhead
$id $head
6499 # Display a list of tags and heads
6501 global showrefstop bgcolor fgcolor selectbgcolor
6502 global bglist fglist reflistfilter reflist maincursor
6505 set showrefstop
$top
6506 if {[winfo exists
$top]} {
6512 wm title
$top [mc
"Tags and heads: %s" [file tail [pwd]]]
6513 text
$top.list
-background $bgcolor -foreground $fgcolor \
6514 -selectbackground $selectbgcolor -font mainfont \
6515 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6516 -width 30 -height 20 -cursor $maincursor \
6517 -spacing1 1 -spacing3 1 -state disabled
6518 $top.list tag configure highlight
-background $selectbgcolor
6519 lappend bglist
$top.list
6520 lappend fglist
$top.list
6521 scrollbar
$top.ysb
-command "$top.list yview" -orient vertical
6522 scrollbar
$top.xsb
-command "$top.list xview" -orient horizontal
6523 grid
$top.list
$top.ysb
-sticky nsew
6524 grid
$top.xsb x
-sticky ew
6526 label
$top.f.l
-text "[mc "Filter
"]: "
6527 entry
$top.f.e
-width 20 -textvariable reflistfilter
6528 set reflistfilter
"*"
6529 trace add variable reflistfilter
write reflistfilter_change
6530 pack
$top.f.e
-side right
-fill x
-expand 1
6531 pack
$top.f.l
-side left
6532 grid
$top.f
- -sticky ew
-pady 2
6533 button
$top.close
-command [list destroy
$top] -text [mc
"Close"]
6535 grid columnconfigure
$top 0 -weight 1
6536 grid rowconfigure
$top 0 -weight 1
6537 bind $top.list
<1> {break}
6538 bind $top.list
<B1-Motion
> {break}
6539 bind $top.list
<ButtonRelease-1
> {sel_reflist
%W
%x
%y
; break}
6544 proc sel_reflist
{w x y
} {
6545 global showrefstop reflist headids tagids otherrefids
6547 if {![winfo exists
$showrefstop]} return
6548 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
6549 set ref
[lindex
$reflist [expr {$l-1}]]
6550 set n
[lindex
$ref 0]
6551 switch
-- [lindex
$ref 1] {
6552 "H" {selbyid
$headids($n)}
6553 "T" {selbyid
$tagids($n)}
6554 "o" {selbyid
$otherrefids($n)}
6556 $showrefstop.list tag add highlight
$l.0 "$l.0 lineend"
6559 proc unsel_reflist
{} {
6562 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6563 $showrefstop.list tag remove highlight
0.0 end
6566 proc reflistfilter_change
{n1 n2 op
} {
6567 global reflistfilter
6569 after cancel refill_reflist
6570 after
200 refill_reflist
6573 proc refill_reflist
{} {
6574 global reflist reflistfilter showrefstop headids tagids otherrefids
6575 global commitrow curview commitinterest
6577 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6579 foreach n
[array names headids
] {
6580 if {[string match
$reflistfilter $n]} {
6581 if {[info exists commitrow
($curview,$headids($n))]} {
6582 lappend refs
[list
$n H
]
6584 set commitinterest
($headids($n)) {run refill_reflist
}
6588 foreach n
[array names tagids
] {
6589 if {[string match
$reflistfilter $n]} {
6590 if {[info exists commitrow
($curview,$tagids($n))]} {
6591 lappend refs
[list
$n T
]
6593 set commitinterest
($tagids($n)) {run refill_reflist
}
6597 foreach n
[array names otherrefids
] {
6598 if {[string match
$reflistfilter $n]} {
6599 if {[info exists commitrow
($curview,$otherrefids($n))]} {
6600 lappend refs
[list
$n o
]
6602 set commitinterest
($otherrefids($n)) {run refill_reflist
}
6606 set refs
[lsort
-index 0 $refs]
6607 if {$refs eq
$reflist} return
6609 # Update the contents of $showrefstop.list according to the
6610 # differences between $reflist (old) and $refs (new)
6611 $showrefstop.list conf
-state normal
6612 $showrefstop.list insert end
"\n"
6615 while {$i < [llength
$reflist] ||
$j < [llength
$refs]} {
6616 if {$i < [llength
$reflist]} {
6617 if {$j < [llength
$refs]} {
6618 set cmp [string compare
[lindex
$reflist $i 0] \
6619 [lindex
$refs $j 0]]
6621 set cmp [string compare
[lindex
$reflist $i 1] \
6622 [lindex
$refs $j 1]]
6632 $showrefstop.list delete
"[expr {$j+1}].0" "[expr {$j+2}].0"
6640 set l
[expr {$j + 1}]
6641 $showrefstop.list image create
$l.0 -align baseline \
6642 -image reficon-
[lindex
$refs $j 1] -padx 2
6643 $showrefstop.list insert
$l.1 "[lindex $refs $j 0]\n"
6649 # delete last newline
6650 $showrefstop.list delete end-2c end-1c
6651 $showrefstop.list conf
-state disabled
6654 # Stuff for finding nearby tags
6655 proc getallcommits
{} {
6656 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6657 global idheads idtags idotherrefs allparents tagobjid
6659 if {![info exists allcommits
]} {
6665 set allccache
[file join [gitdir
] "gitk.cache"]
6667 set f
[open
$allccache r
]
6676 set cmd
[list | git rev-list
--parents]
6677 set allcupdate
[expr {$seeds ne
{}}]
6681 set refs
[concat
[array names idheads
] [array names idtags
] \
6682 [array names idotherrefs
]]
6685 foreach name
[array names tagobjid
] {
6686 lappend tagobjs
$tagobjid($name)
6688 foreach id
[lsort
-unique $refs] {
6689 if {![info exists allparents
($id)] &&
6690 [lsearch
-exact $tagobjs $id] < 0} {
6701 set fd
[open
[concat
$cmd $ids] r
]
6702 fconfigure
$fd -blocking 0
6705 filerun
$fd [list getallclines
$fd]
6711 # Since most commits have 1 parent and 1 child, we group strings of
6712 # such commits into "arcs" joining branch/merge points (BMPs), which
6713 # are commits that either don't have 1 parent or don't have 1 child.
6715 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6716 # arcout(id) - outgoing arcs for BMP
6717 # arcids(a) - list of IDs on arc including end but not start
6718 # arcstart(a) - BMP ID at start of arc
6719 # arcend(a) - BMP ID at end of arc
6720 # growing(a) - arc a is still growing
6721 # arctags(a) - IDs out of arcids (excluding end) that have tags
6722 # archeads(a) - IDs out of arcids (excluding end) that have heads
6723 # The start of an arc is at the descendent end, so "incoming" means
6724 # coming from descendents, and "outgoing" means going towards ancestors.
6726 proc getallclines
{fd
} {
6727 global allparents allchildren idtags idheads nextarc
6728 global arcnos arcids arctags arcout arcend arcstart archeads growing
6729 global seeds allcommits cachedarcs allcupdate
6732 while {[incr nid
] <= 1000 && [gets
$fd line
] >= 0} {
6733 set id
[lindex
$line 0]
6734 if {[info exists allparents
($id)]} {
6739 set olds
[lrange
$line 1 end
]
6740 set allparents
($id) $olds
6741 if {![info exists allchildren
($id)]} {
6742 set allchildren
($id) {}
6747 if {[llength
$olds] == 1 && [llength
$a] == 1} {
6748 lappend arcids
($a) $id
6749 if {[info exists idtags
($id)]} {
6750 lappend arctags
($a) $id
6752 if {[info exists idheads
($id)]} {
6753 lappend archeads
($a) $id
6755 if {[info exists allparents
($olds)]} {
6756 # seen parent already
6757 if {![info exists arcout
($olds)]} {
6760 lappend arcids
($a) $olds
6761 set arcend
($a) $olds
6764 lappend allchildren
($olds) $id
6765 lappend arcnos
($olds) $a
6769 foreach a
$arcnos($id) {
6770 lappend arcids
($a) $id
6777 lappend allchildren
($p) $id
6778 set a
[incr nextarc
]
6779 set arcstart
($a) $id
6786 if {[info exists allparents
($p)]} {
6787 # seen it already, may need to make a new branch
6788 if {![info exists arcout
($p)]} {
6791 lappend arcids
($a) $p
6795 lappend arcnos
($p) $a
6800 global cached_dheads cached_dtags cached_atags
6801 catch
{unset cached_dheads
}
6802 catch
{unset cached_dtags
}
6803 catch
{unset cached_atags
}
6806 return [expr {$nid >= 1000?
2: 1}]
6810 fconfigure
$fd -blocking 1
6813 # got an error reading the list of commits
6814 # if we were updating, try rereading the whole thing again
6820 error_popup
"[mc "Error reading commit topology information
;\
6821 branch and preceding
/following tag information\
6822 will be incomplete.
"]\n($err)"
6825 if {[incr allcommits
-1] == 0} {
6835 proc recalcarc
{a
} {
6836 global arctags archeads arcids idtags idheads
6840 foreach id
[lrange
$arcids($a) 0 end-1
] {
6841 if {[info exists idtags
($id)]} {
6844 if {[info exists idheads
($id)]} {
6849 set archeads
($a) $ah
6853 global arcnos arcids nextarc arctags archeads idtags idheads
6854 global arcstart arcend arcout allparents growing
6857 if {[llength
$a] != 1} {
6858 puts
"oops splitarc called but [llength $a] arcs already"
6862 set i
[lsearch
-exact $arcids($a) $p]
6864 puts
"oops splitarc $p not in arc $a"
6867 set na
[incr nextarc
]
6868 if {[info exists arcend
($a)]} {
6869 set arcend
($na) $arcend($a)
6871 set l
[lindex
$allparents([lindex
$arcids($a) end
]) 0]
6872 set j
[lsearch
-exact $arcnos($l) $a]
6873 set arcnos
($l) [lreplace
$arcnos($l) $j $j $na]
6875 set tail [lrange
$arcids($a) [expr {$i+1}] end
]
6876 set arcids
($a) [lrange
$arcids($a) 0 $i]
6878 set arcstart
($na) $p
6880 set arcids
($na) $tail
6881 if {[info exists growing
($a)]} {
6887 if {[llength
$arcnos($id)] == 1} {
6890 set j
[lsearch
-exact $arcnos($id) $a]
6891 set arcnos
($id) [lreplace
$arcnos($id) $j $j $na]
6895 # reconstruct tags and heads lists
6896 if {$arctags($a) ne
{} ||
$archeads($a) ne
{}} {
6901 set archeads
($na) {}
6905 # Update things for a new commit added that is a child of one
6906 # existing commit. Used when cherry-picking.
6907 proc addnewchild
{id p
} {
6908 global allparents allchildren idtags nextarc
6909 global arcnos arcids arctags arcout arcend arcstart archeads growing
6910 global seeds allcommits
6912 if {![info exists allcommits
] ||
![info exists arcnos
($p)]} return
6913 set allparents
($id) [list
$p]
6914 set allchildren
($id) {}
6917 lappend allchildren
($p) $id
6918 set a
[incr nextarc
]
6919 set arcstart
($a) $id
6922 set arcids
($a) [list
$p]
6924 if {![info exists arcout
($p)]} {
6927 lappend arcnos
($p) $a
6928 set arcout
($id) [list
$a]
6931 # This implements a cache for the topology information.
6932 # The cache saves, for each arc, the start and end of the arc,
6933 # the ids on the arc, and the outgoing arcs from the end.
6934 proc readcache
{f
} {
6935 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6936 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6941 if {$lim - $a > 500} {
6942 set lim
[expr {$a + 500}]
6946 # finish reading the cache and setting up arctags, etc.
6948 if {$line ne
"1"} {error
"bad final version"}
6950 foreach id
[array names idtags
] {
6951 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
6952 [llength
$allparents($id)] == 1} {
6953 set a
[lindex
$arcnos($id) 0]
6954 if {$arctags($a) eq
{}} {
6959 foreach id
[array names idheads
] {
6960 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
6961 [llength
$allparents($id)] == 1} {
6962 set a
[lindex
$arcnos($id) 0]
6963 if {$archeads($a) eq
{}} {
6968 foreach id
[lsort
-unique $possible_seeds] {
6969 if {$arcnos($id) eq
{}} {
6975 while {[incr a
] <= $lim} {
6977 if {[llength
$line] != 3} {error
"bad line"}
6978 set s
[lindex
$line 0]
6980 lappend arcout
($s) $a
6981 if {![info exists arcnos
($s)]} {
6982 lappend possible_seeds
$s
6985 set e
[lindex
$line 1]
6990 if {![info exists arcout
($e)]} {
6994 set arcids
($a) [lindex
$line 2]
6995 foreach id
$arcids($a) {
6996 lappend allparents
($s) $id
6998 lappend arcnos
($id) $a
7000 if {![info exists allparents
($s)]} {
7001 set allparents
($s) {}
7006 set nextarc
[expr {$a - 1}]
7019 global nextarc cachedarcs possible_seeds
7023 if {[llength
$line] != 2 ||
[lindex
$line 0] ne
"1"} {error
"bad version"}
7024 # make sure it's an integer
7025 set cachedarcs
[expr {int
([lindex
$line 1])}]
7026 if {$cachedarcs < 0} {error
"bad number of arcs"}
7028 set possible_seeds
{}
7036 proc dropcache
{err
} {
7037 global allcwait nextarc cachedarcs seeds
7039 #puts "dropping cache ($err)"
7040 foreach v
{arcnos arcout arcids arcstart arcend growing \
7041 arctags archeads allparents allchildren
} {
7052 proc writecache
{f
} {
7053 global cachearc cachedarcs allccache
7054 global arcstart arcend arcnos arcids arcout
7058 if {$lim - $a > 1000} {
7059 set lim
[expr {$a + 1000}]
7062 while {[incr a
] <= $lim} {
7063 if {[info exists arcend
($a)]} {
7064 puts
$f [list
$arcstart($a) $arcend($a) $arcids($a)]
7066 puts
$f [list
$arcstart($a) {} $arcids($a)]
7071 catch
{file delete
$allccache}
7072 #puts "writing cache failed ($err)"
7075 set cachearc
[expr {$a - 1}]
7076 if {$a > $cachedarcs} {
7085 global nextarc cachedarcs cachearc allccache
7087 if {$nextarc == $cachedarcs} return
7089 set cachedarcs
$nextarc
7091 set f
[open
$allccache w
]
7092 puts
$f [list
1 $cachedarcs]
7097 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7098 # or 0 if neither is true.
7099 proc anc_or_desc
{a b
} {
7100 global arcout arcstart arcend arcnos cached_isanc
7102 if {$arcnos($a) eq
$arcnos($b)} {
7103 # Both are on the same arc(s); either both are the same BMP,
7104 # or if one is not a BMP, the other is also not a BMP or is
7105 # the BMP at end of the arc (and it only has 1 incoming arc).
7106 # Or both can be BMPs with no incoming arcs.
7107 if {$a eq
$b ||
$arcnos($a) eq
{}} {
7110 # assert {[llength $arcnos($a)] == 1}
7111 set arc
[lindex
$arcnos($a) 0]
7112 set i
[lsearch
-exact $arcids($arc) $a]
7113 set j
[lsearch
-exact $arcids($arc) $b]
7114 if {$i < 0 ||
$i > $j} {
7121 if {![info exists arcout
($a)]} {
7122 set arc
[lindex
$arcnos($a) 0]
7123 if {[info exists arcend
($arc)]} {
7124 set aend
$arcend($arc)
7128 set a
$arcstart($arc)
7132 if {![info exists arcout
($b)]} {
7133 set arc
[lindex
$arcnos($b) 0]
7134 if {[info exists arcend
($arc)]} {
7135 set bend
$arcend($arc)
7139 set b
$arcstart($arc)
7149 if {[info exists cached_isanc
($a,$bend)]} {
7150 if {$cached_isanc($a,$bend)} {
7154 if {[info exists cached_isanc
($b,$aend)]} {
7155 if {$cached_isanc($b,$aend)} {
7158 if {[info exists cached_isanc
($a,$bend)]} {
7163 set todo
[list
$a $b]
7166 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7167 set x
[lindex
$todo $i]
7168 if {$anc($x) eq
{}} {
7171 foreach arc
$arcnos($x) {
7172 set xd
$arcstart($arc)
7174 set cached_isanc
($a,$bend) 1
7175 set cached_isanc
($b,$aend) 0
7177 } elseif
{$xd eq
$aend} {
7178 set cached_isanc
($b,$aend) 1
7179 set cached_isanc
($a,$bend) 0
7182 if {![info exists anc
($xd)]} {
7183 set anc
($xd) $anc($x)
7185 } elseif
{$anc($xd) ne
$anc($x)} {
7190 set cached_isanc
($a,$bend) 0
7191 set cached_isanc
($b,$aend) 0
7195 # This identifies whether $desc has an ancestor that is
7196 # a growing tip of the graph and which is not an ancestor of $anc
7197 # and returns 0 if so and 1 if not.
7198 # If we subsequently discover a tag on such a growing tip, and that
7199 # turns out to be a descendent of $anc (which it could, since we
7200 # don't necessarily see children before parents), then $desc
7201 # isn't a good choice to display as a descendent tag of
7202 # $anc (since it is the descendent of another tag which is
7203 # a descendent of $anc). Similarly, $anc isn't a good choice to
7204 # display as a ancestor tag of $desc.
7206 proc is_certain
{desc anc
} {
7207 global arcnos arcout arcstart arcend growing problems
7210 if {[llength
$arcnos($anc)] == 1} {
7211 # tags on the same arc are certain
7212 if {$arcnos($desc) eq
$arcnos($anc)} {
7215 if {![info exists arcout
($anc)]} {
7216 # if $anc is partway along an arc, use the start of the arc instead
7217 set a
[lindex
$arcnos($anc) 0]
7218 set anc
$arcstart($a)
7221 if {[llength
$arcnos($desc)] > 1 ||
[info exists arcout
($desc)]} {
7224 set a
[lindex
$arcnos($desc) 0]
7230 set anclist
[list
$x]
7234 for {set i
0} {$i < [llength
$anclist] && ($nnh > 0 ||
$ngrowanc > 0)} {incr i
} {
7235 set x
[lindex
$anclist $i]
7240 foreach a
$arcout($x) {
7241 if {[info exists growing
($a)]} {
7242 if {![info exists growanc
($x)] && $dl($x)} {
7248 if {[info exists dl
($y)]} {
7252 if {![info exists
done($y)]} {
7255 if {[info exists growanc
($x)]} {
7259 for {set k
0} {$k < [llength
$xl]} {incr k
} {
7260 set z
[lindex
$xl $k]
7261 foreach c
$arcout($z) {
7262 if {[info exists arcend
($c)]} {
7264 if {[info exists dl
($v)] && $dl($v)} {
7266 if {![info exists
done($v)]} {
7269 if {[info exists growanc
($v)]} {
7279 } elseif
{$y eq
$anc ||
!$dl($x)} {
7290 foreach x
[array names growanc
] {
7299 proc validate_arctags
{a
} {
7300 global arctags idtags
7304 foreach id
$arctags($a) {
7306 if {![info exists idtags
($id)]} {
7307 set na
[lreplace
$na $i $i]
7314 proc validate_archeads
{a
} {
7315 global archeads idheads
7318 set na
$archeads($a)
7319 foreach id
$archeads($a) {
7321 if {![info exists idheads
($id)]} {
7322 set na
[lreplace
$na $i $i]
7326 set archeads
($a) $na
7329 # Return the list of IDs that have tags that are descendents of id,
7330 # ignoring IDs that are descendents of IDs already reported.
7331 proc desctags
{id
} {
7332 global arcnos arcstart arcids arctags idtags allparents
7333 global growing cached_dtags
7335 if {![info exists allparents
($id)]} {
7338 set t1
[clock clicks
-milliseconds]
7340 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7341 # part-way along an arc; check that arc first
7342 set a
[lindex
$arcnos($id) 0]
7343 if {$arctags($a) ne
{}} {
7345 set i
[lsearch
-exact $arcids($a) $id]
7347 foreach t
$arctags($a) {
7348 set j
[lsearch
-exact $arcids($a) $t]
7356 set id
$arcstart($a)
7357 if {[info exists idtags
($id)]} {
7361 if {[info exists cached_dtags
($id)]} {
7362 return $cached_dtags($id)
7369 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7370 set id
[lindex
$todo $i]
7372 set ta
[info exists hastaggedancestor
($id)]
7376 # ignore tags on starting node
7377 if {!$ta && $i > 0} {
7378 if {[info exists idtags
($id)]} {
7381 } elseif
{[info exists cached_dtags
($id)]} {
7382 set tagloc
($id) $cached_dtags($id)
7386 foreach a
$arcnos($id) {
7388 if {!$ta && $arctags($a) ne
{}} {
7390 if {$arctags($a) ne
{}} {
7391 lappend tagloc
($id) [lindex
$arctags($a) end
]
7394 if {$ta ||
$arctags($a) ne
{}} {
7395 set tomark
[list
$d]
7396 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7397 set dd [lindex
$tomark $j]
7398 if {![info exists hastaggedancestor
($dd)]} {
7399 if {[info exists
done($dd)]} {
7400 foreach b
$arcnos($dd) {
7401 lappend tomark
$arcstart($b)
7403 if {[info exists tagloc
($dd)]} {
7406 } elseif
{[info exists queued
($dd)]} {
7409 set hastaggedancestor
($dd) 1
7413 if {![info exists queued
($d)]} {
7416 if {![info exists hastaggedancestor
($d)]} {
7423 foreach id
[array names tagloc
] {
7424 if {![info exists hastaggedancestor
($id)]} {
7425 foreach t
$tagloc($id) {
7426 if {[lsearch
-exact $tags $t] < 0} {
7432 set t2
[clock clicks
-milliseconds]
7435 # remove tags that are descendents of other tags
7436 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7437 set a
[lindex
$tags $i]
7438 for {set j
0} {$j < $i} {incr j
} {
7439 set b
[lindex
$tags $j]
7440 set r
[anc_or_desc
$a $b]
7442 set tags
[lreplace
$tags $j $j]
7445 } elseif
{$r == -1} {
7446 set tags
[lreplace
$tags $i $i]
7453 if {[array names growing
] ne
{}} {
7454 # graph isn't finished, need to check if any tag could get
7455 # eclipsed by another tag coming later. Simply ignore any
7456 # tags that could later get eclipsed.
7459 if {[is_certain
$t $origid]} {
7463 if {$tags eq
$ctags} {
7464 set cached_dtags
($origid) $tags
7469 set cached_dtags
($origid) $tags
7471 set t3
[clock clicks
-milliseconds]
7472 if {0 && $t3 - $t1 >= 100} {
7473 puts
"iterating descendents ($loopix/[llength $todo] nodes) took\
7474 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7480 global arcnos arcids arcout arcend arctags idtags allparents
7481 global growing cached_atags
7483 if {![info exists allparents
($id)]} {
7486 set t1
[clock clicks
-milliseconds]
7488 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7489 # part-way along an arc; check that arc first
7490 set a
[lindex
$arcnos($id) 0]
7491 if {$arctags($a) ne
{}} {
7493 set i
[lsearch
-exact $arcids($a) $id]
7494 foreach t
$arctags($a) {
7495 set j
[lsearch
-exact $arcids($a) $t]
7501 if {![info exists arcend
($a)]} {
7505 if {[info exists idtags
($id)]} {
7509 if {[info exists cached_atags
($id)]} {
7510 return $cached_atags($id)
7518 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7519 set id
[lindex
$todo $i]
7521 set td
[info exists hastaggeddescendent
($id)]
7525 # ignore tags on starting node
7526 if {!$td && $i > 0} {
7527 if {[info exists idtags
($id)]} {
7530 } elseif
{[info exists cached_atags
($id)]} {
7531 set tagloc
($id) $cached_atags($id)
7535 foreach a
$arcout($id) {
7536 if {!$td && $arctags($a) ne
{}} {
7538 if {$arctags($a) ne
{}} {
7539 lappend tagloc
($id) [lindex
$arctags($a) 0]
7542 if {![info exists arcend
($a)]} continue
7544 if {$td ||
$arctags($a) ne
{}} {
7545 set tomark
[list
$d]
7546 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7547 set dd [lindex
$tomark $j]
7548 if {![info exists hastaggeddescendent
($dd)]} {
7549 if {[info exists
done($dd)]} {
7550 foreach b
$arcout($dd) {
7551 if {[info exists arcend
($b)]} {
7552 lappend tomark
$arcend($b)
7555 if {[info exists tagloc
($dd)]} {
7558 } elseif
{[info exists queued
($dd)]} {
7561 set hastaggeddescendent
($dd) 1
7565 if {![info exists queued
($d)]} {
7568 if {![info exists hastaggeddescendent
($d)]} {
7574 set t2
[clock clicks
-milliseconds]
7577 foreach id
[array names tagloc
] {
7578 if {![info exists hastaggeddescendent
($id)]} {
7579 foreach t
$tagloc($id) {
7580 if {[lsearch
-exact $tags $t] < 0} {
7587 # remove tags that are ancestors of other tags
7588 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7589 set a
[lindex
$tags $i]
7590 for {set j
0} {$j < $i} {incr j
} {
7591 set b
[lindex
$tags $j]
7592 set r
[anc_or_desc
$a $b]
7594 set tags
[lreplace
$tags $j $j]
7597 } elseif
{$r == 1} {
7598 set tags
[lreplace
$tags $i $i]
7605 if {[array names growing
] ne
{}} {
7606 # graph isn't finished, need to check if any tag could get
7607 # eclipsed by another tag coming later. Simply ignore any
7608 # tags that could later get eclipsed.
7611 if {[is_certain
$origid $t]} {
7615 if {$tags eq
$ctags} {
7616 set cached_atags
($origid) $tags
7621 set cached_atags
($origid) $tags
7623 set t3
[clock clicks
-milliseconds]
7624 if {0 && $t3 - $t1 >= 100} {
7625 puts
"iterating ancestors ($loopix/[llength $todo] nodes) took\
7626 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7631 # Return the list of IDs that have heads that are descendents of id,
7632 # including id itself if it has a head.
7633 proc descheads
{id
} {
7634 global arcnos arcstart arcids archeads idheads cached_dheads
7637 if {![info exists allparents
($id)]} {
7641 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7642 # part-way along an arc; check it first
7643 set a
[lindex
$arcnos($id) 0]
7644 if {$archeads($a) ne
{}} {
7645 validate_archeads
$a
7646 set i
[lsearch
-exact $arcids($a) $id]
7647 foreach t
$archeads($a) {
7648 set j
[lsearch
-exact $arcids($a) $t]
7653 set id
$arcstart($a)
7659 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7660 set id
[lindex
$todo $i]
7661 if {[info exists cached_dheads
($id)]} {
7662 set ret
[concat
$ret $cached_dheads($id)]
7664 if {[info exists idheads
($id)]} {
7667 foreach a
$arcnos($id) {
7668 if {$archeads($a) ne
{}} {
7669 validate_archeads
$a
7670 if {$archeads($a) ne
{}} {
7671 set ret
[concat
$ret $archeads($a)]
7675 if {![info exists seen
($d)]} {
7682 set ret
[lsort
-unique $ret]
7683 set cached_dheads
($origid) $ret
7684 return [concat
$ret $aret]
7687 proc addedtag
{id
} {
7688 global arcnos arcout cached_dtags cached_atags
7690 if {![info exists arcnos
($id)]} return
7691 if {![info exists arcout
($id)]} {
7692 recalcarc
[lindex
$arcnos($id) 0]
7694 catch
{unset cached_dtags
}
7695 catch
{unset cached_atags
}
7698 proc addedhead
{hid
head} {
7699 global arcnos arcout cached_dheads
7701 if {![info exists arcnos
($hid)]} return
7702 if {![info exists arcout
($hid)]} {
7703 recalcarc
[lindex
$arcnos($hid) 0]
7705 catch
{unset cached_dheads
}
7708 proc removedhead
{hid
head} {
7709 global cached_dheads
7711 catch
{unset cached_dheads
}
7714 proc movedhead
{hid
head} {
7715 global arcnos arcout cached_dheads
7717 if {![info exists arcnos
($hid)]} return
7718 if {![info exists arcout
($hid)]} {
7719 recalcarc
[lindex
$arcnos($hid) 0]
7721 catch
{unset cached_dheads
}
7724 proc changedrefs
{} {
7725 global cached_dheads cached_dtags cached_atags
7726 global arctags archeads arcnos arcout idheads idtags
7728 foreach id
[concat
[array names idheads
] [array names idtags
]] {
7729 if {[info exists arcnos
($id)] && ![info exists arcout
($id)]} {
7730 set a
[lindex
$arcnos($id) 0]
7731 if {![info exists donearc
($a)]} {
7737 catch
{unset cached_dtags
}
7738 catch
{unset cached_atags
}
7739 catch
{unset cached_dheads
}
7742 proc rereadrefs
{} {
7743 global idtags idheads idotherrefs mainhead
7745 set refids
[concat
[array names idtags
] \
7746 [array names idheads
] [array names idotherrefs
]]
7747 foreach id
$refids {
7748 if {![info exists ref
($id)]} {
7749 set ref
($id) [listrefs
$id]
7752 set oldmainhead
$mainhead
7755 set refids
[lsort
-unique [concat
$refids [array names idtags
] \
7756 [array names idheads
] [array names idotherrefs
]]]
7757 foreach id
$refids {
7758 set v
[listrefs
$id]
7759 if {![info exists ref
($id)] ||
$ref($id) != $v ||
7760 ($id eq
$oldmainhead && $id ne
$mainhead) ||
7761 ($id eq
$mainhead && $id ne
$oldmainhead)} {
7768 proc listrefs
{id
} {
7769 global idtags idheads idotherrefs
7772 if {[info exists idtags
($id)]} {
7776 if {[info exists idheads
($id)]} {
7780 if {[info exists idotherrefs
($id)]} {
7781 set z
$idotherrefs($id)
7783 return [list
$x $y $z]
7786 proc showtag
{tag isnew
} {
7787 global ctext tagcontents tagids linknum tagobjid
7790 addtohistory
[list showtag
$tag 0]
7792 $ctext conf
-state normal
7796 if {![info exists tagcontents
($tag)]} {
7798 set tagcontents
($tag) [exec git cat-file tag
$tagobjid($tag)]
7801 if {[info exists tagcontents
($tag)]} {
7802 set text
$tagcontents($tag)
7804 set text
"[mc "Tag
"]: $tag\n[mc "Id
"]: $tagids($tag)"
7806 appendwithlinks
$text {}
7807 $ctext conf
-state disabled
7818 proc mkfontdisp
{font top
which} {
7819 global fontattr fontpref
$font
7821 set fontpref
($font) [set $font]
7822 button
$top.
${font}but
-text $which -font optionfont \
7823 -command [list choosefont
$font $which]
7824 label
$top.
$font -relief flat
-font $font \
7825 -text $fontattr($font,family
) -justify left
7826 grid x
$top.
${font}but
$top.
$font -sticky w
7829 proc choosefont
{font
which} {
7830 global fontparam fontlist fonttop fontattr
7832 set fontparam
(which) $which
7833 set fontparam
(font
) $font
7834 set fontparam
(family
) [font actual
$font -family]
7835 set fontparam
(size
) $fontattr($font,size
)
7836 set fontparam
(weight
) $fontattr($font,weight
)
7837 set fontparam
(slant
) $fontattr($font,slant
)
7840 if {![winfo exists
$top]} {
7842 eval font config sample
[font actual
$font]
7844 wm title
$top [mc
"Gitk font chooser"]
7845 label
$top.l
-textvariable fontparam
(which)
7846 pack
$top.l
-side top
7847 set fontlist
[lsort
[font families
]]
7849 listbox
$top.f.fam
-listvariable fontlist \
7850 -yscrollcommand [list
$top.f.sb
set]
7851 bind $top.f.fam
<<ListboxSelect>> selfontfam
7852 scrollbar $top.f.sb -command [list $top.f.fam yview]
7853 pack $top.f.sb -side right -fill y
7854 pack $top.f.fam -side left -fill both -expand 1
7855 pack $top.f -side top -fill both -expand 1
7857 spinbox $top.g.size -from 4 -to 40 -width 4 \
7858 -textvariable fontparam(size) \
7859 -validatecommand {string is integer -strict %s}
7860 checkbutton $top.g.bold -padx 5 \
7861 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7862 -variable fontparam(weight) -onvalue bold -offvalue normal
7863 checkbutton $top.g.ital -padx 5 \
7864 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7865 -variable fontparam(slant) -onvalue italic -offvalue roman
7866 pack $top.g.size $top.g.bold $top.g.ital -side left
7867 pack $top.g -side top
7868 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7870 $top.c create text 100 25 -anchor center -text $which -font sample \
7871 -fill black -tags text
7872 bind $top.c <Configure> [list centertext $top.c]
7873 pack $top.c -side top -fill x
7875 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7876 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7877 grid $top.buts.ok $top.buts.can
7878 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7879 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7880 pack $top.buts -side bottom -fill x
7881 trace add variable fontparam write chg_fontparam
7884 $top.c itemconf text -text $which
7886 set i [lsearch -exact $fontlist $fontparam(family)]
7888 $top.f.fam selection set $i
7893 proc centertext {w} {
7894 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7898 global fontparam fontpref prefstop
7900 set f $fontparam(font)
7901 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7902 if {$fontparam(weight) eq "bold"} {
7903 lappend fontpref($f) "bold"
7905 if {$fontparam(slant) eq "italic"} {
7906 lappend fontpref($f) "italic"
7909 $w conf -text $fontparam(family) -font $fontpref($f)
7915 global fonttop fontparam
7917 if {[info exists fonttop]} {
7918 catch {destroy $fonttop}
7919 catch {font delete sample}
7925 proc selfontfam {} {
7926 global fonttop fontparam
7928 set i [$fonttop.f.fam curselection]
7930 set fontparam(family) [$fonttop.f.fam get $i]
7934 proc chg_fontparam {v sub op} {
7937 font config sample -$sub $fontparam($sub)
7941 global maxwidth maxgraphpct
7942 global oldprefs prefstop showneartags showlocalchanges
7943 global bgcolor fgcolor ctext diffcolors selectbgcolor
7944 global tabstop limitdiffs
7948 if {[winfo exists $top]} {
7952 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7953 limitdiffs tabstop} {
7954 set oldprefs($v) [set $v]
7957 wm title $top [mc "Gitk preferences"]
7958 label $top.ldisp -text [mc "Commit list display options"]
7959 grid $top.ldisp - -sticky w -pady 10
7960 label $top.spacer -text " "
7961 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7963 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7964 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7965 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7967 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7968 grid x $top.maxpctl $top.maxpct -sticky w
7969 frame $top.showlocal
7970 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7971 checkbutton $top.showlocal.b -variable showlocalchanges
7972 pack $top.showlocal.b $top.showlocal.l -side left
7973 grid x $top.showlocal -sticky w
7975 label $top.ddisp -text [mc "Diff display options"]
7976 grid $top.ddisp - -sticky w -pady 10
7977 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7978 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7979 grid x $top.tabstopl $top.tabstop -sticky w
7981 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7982 checkbutton $top.ntag.b -variable showneartags
7983 pack $top.ntag.b $top.ntag.l -side left
7984 grid x $top.ntag -sticky w
7986 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7987 checkbutton $top.ldiff.b -variable limitdiffs
7988 pack $top.ldiff.b $top.ldiff.l -side left
7989 grid x $top.ldiff -sticky w
7991 label $top.cdisp -text [mc "Colors: press to choose"]
7992 grid $top.cdisp - -sticky w -pady 10
7993 label $top.bg -padx 40 -relief sunk -background $bgcolor
7994 button $top.bgbut -text [mc "Background"] -font optionfont \
7995 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7996 grid x $top.bgbut $top.bg -sticky w
7997 label $top.fg -padx 40 -relief sunk -background $fgcolor
7998 button $top.fgbut -text [mc "Foreground"] -font optionfont \
7999 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8000 grid x $top.fgbut $top.fg -sticky w
8001 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8002 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8003 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8004 [list $ctext tag conf d0 -foreground]]
8005 grid x $top.diffoldbut $top.diffold -sticky w
8006 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8007 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8008 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8009 [list $ctext tag conf d1 -foreground]]
8010 grid x $top.diffnewbut $top.diffnew -sticky w
8011 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8012 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8013 -command [list choosecolor diffcolors 2 $top.hunksep \
8014 "diff hunk header" \
8015 [list $ctext tag conf hunksep -foreground]]
8016 grid x $top.hunksepbut $top.hunksep -sticky w
8017 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8018 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8019 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8020 grid x $top.selbgbut $top.selbgsep -sticky w
8022 label $top.cfont -text [mc "Fonts: press to choose"]
8023 grid $top.cfont - -sticky w -pady 10
8024 mkfontdisp mainfont $top [mc "Main font"]
8025 mkfontdisp textfont $top [mc "Diff display font"]
8026 mkfontdisp uifont $top [mc "User interface font"]
8029 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8030 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8031 grid $top.buts.ok $top.buts.can
8032 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8033 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8034 grid $top.buts - - -pady 10 -sticky ew
8035 bind $top <Visibility> "focus $top.buts.ok"
8038 proc choosecolor {v vi w x cmd} {
8041 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8042 -title [mc "Gitk: choose color for %s" $x]]
8043 if {$c eq {}} return
8044 $w conf -background $c
8050 global bglist cflist
8052 $w configure -selectbackground $c
8054 $cflist tag configure highlight \
8055 -background [$cflist cget -selectbackground]
8056 allcanvs itemconf secsel -fill $c
8063 $w conf -background $c
8071 $w conf -foreground $c
8073 allcanvs itemconf text -fill $c
8074 $canv itemconf circle -outline $c
8078 global oldprefs prefstop
8080 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8081 limitdiffs tabstop} {
8083 set $v $oldprefs($v)
8085 catch {destroy $prefstop}
8091 global maxwidth maxgraphpct
8092 global oldprefs prefstop showneartags showlocalchanges
8093 global fontpref mainfont textfont uifont
8094 global limitdiffs treediffs
8096 catch {destroy $prefstop}
8100 if {$mainfont ne $fontpref(mainfont)} {
8101 set mainfont $fontpref(mainfont)
8102 parsefont mainfont $mainfont
8103 eval font configure mainfont [fontflags mainfont]
8104 eval font configure mainfontbold [fontflags mainfont 1]
8108 if {$textfont ne $fontpref(textfont)} {
8109 set textfont $fontpref(textfont)
8110 parsefont textfont $textfont
8111 eval font configure textfont [fontflags textfont]
8112 eval font configure textfontbold [fontflags textfont 1]
8114 if {$uifont ne $fontpref(uifont)} {
8115 set uifont $fontpref(uifont)
8116 parsefont uifont $uifont
8117 eval font configure uifont [fontflags uifont]
8120 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8121 if {$showlocalchanges} {
8127 if {$limitdiffs != $oldprefs(limitdiffs)} {
8128 # treediffs elements are limited by path
8129 catch {unset treediffs}
8131 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8132 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8134 } elseif {$showneartags != $oldprefs(showneartags) ||
8135 $limitdiffs != $oldprefs(limitdiffs)} {
8140 proc formatdate {d} {
8141 global datetimeformat
8143 set d [clock format $d -format $datetimeformat]
8148 # This list of encoding names and aliases is distilled from
8149 # http://www.iana.org/assignments/character-sets.
8150 # Not all of them are supported by Tcl.
8151 set encoding_aliases {
8152 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8153 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8154 { ISO-10646-UTF-1 csISO10646UTF1 }
8155 { ISO_646.basic:1983 ref csISO646basic1983 }
8156 { INVARIANT csINVARIANT }
8157 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8158 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8159 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8160 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8161 { NATS-DANO iso-ir-9-1 csNATSDANO }
8162 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8163 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8164 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8165 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8166 { ISO-2022-KR csISO2022KR }
8168 { ISO-2022-JP csISO2022JP }
8169 { ISO-2022-JP-2 csISO2022JP2 }
8170 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8172 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8173 { IT iso-ir-15 ISO646-IT csISO15Italian }
8174 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8175 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8176 { greek7-old iso-ir-18 csISO18Greek7Old }
8177 { latin-greek iso-ir-19 csISO19LatinGreek }
8178 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8179 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8180 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8181 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8182 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8183 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8184 { INIS iso-ir-49 csISO49INIS }
8185 { INIS-8 iso-ir-50 csISO50INIS8 }
8186 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8187 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8188 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8189 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8190 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8191 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8193 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8194 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8195 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8196 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8197 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8198 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8199 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8200 { greek7 iso-ir-88 csISO88Greek7 }
8201 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8202 { iso-ir-90 csISO90 }
8203 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8204 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8205 csISO92JISC62991984b }
8206 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8207 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8208 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8209 csISO95JIS62291984handadd }
8210 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8211 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8212 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8213 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8215 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8216 { T.61-7bit iso-ir-102 csISO102T617bit }
8217 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8218 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8219 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8220 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8221 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8222 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8223 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8224 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8225 arabic csISOLatinArabic }
8226 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8227 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8228 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8229 greek greek8 csISOLatinGreek }
8230 { T.101-G2 iso-ir-128 csISO128T101G2 }
8231 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8233 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8234 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8235 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8236 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8237 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8238 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8239 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8240 csISOLatinCyrillic }
8241 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8242 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8243 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8244 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8245 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8246 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8247 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8248 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8249 { ISO_10367-box iso-ir-155 csISO10367Box }
8250 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8251 { latin-lap lap iso-ir-158 csISO158Lap }
8252 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8253 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8256 { JIS_X0201 X0201 csHalfWidthKatakana }
8257 { KSC5636 ISO646-KR csKSC5636 }
8258 { ISO-10646-UCS-2 csUnicode }
8259 { ISO-10646-UCS-4 csUCS4 }
8260 { DEC-MCS dec csDECMCS }
8261 { hp-roman8 roman8 r8 csHPRoman8 }
8262 { macintosh mac csMacintosh }
8263 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8265 { IBM038 EBCDIC-INT cp038 csIBM038 }
8266 { IBM273 CP273 csIBM273 }
8267 { IBM274 EBCDIC-BE CP274 csIBM274 }
8268 { IBM275 EBCDIC-BR cp275 csIBM275 }
8269 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8270 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8271 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8272 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8273 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8274 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8275 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8276 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8277 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8278 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8279 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8280 { IBM437 cp437 437 csPC8CodePage437 }
8281 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8282 { IBM775 cp775 csPC775Baltic }
8283 { IBM850 cp850 850 csPC850Multilingual }
8284 { IBM851 cp851 851 csIBM851 }
8285 { IBM852 cp852 852 csPCp852 }
8286 { IBM855 cp855 855 csIBM855 }
8287 { IBM857 cp857 857 csIBM857 }
8288 { IBM860 cp860 860 csIBM860 }
8289 { IBM861 cp861 861 cp-is csIBM861 }
8290 { IBM862 cp862 862 csPC862LatinHebrew }
8291 { IBM863 cp863 863 csIBM863 }
8292 { IBM864 cp864 csIBM864 }
8293 { IBM865 cp865 865 csIBM865 }
8294 { IBM866 cp866 866 csIBM866 }
8295 { IBM868 CP868 cp-ar csIBM868 }
8296 { IBM869 cp869 869 cp-gr csIBM869 }
8297 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8298 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8299 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8300 { IBM891 cp891 csIBM891 }
8301 { IBM903 cp903 csIBM903 }
8302 { IBM904 cp904 904 csIBBM904 }
8303 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8304 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8305 { IBM1026 CP1026 csIBM1026 }
8306 { EBCDIC-AT-DE csIBMEBCDICATDE }
8307 { EBCDIC-AT-DE-A csEBCDICATDEA }
8308 { EBCDIC-CA-FR csEBCDICCAFR }
8309 { EBCDIC-DK-NO csEBCDICDKNO }
8310 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8311 { EBCDIC-FI-SE csEBCDICFISE }
8312 { EBCDIC-FI-SE-A csEBCDICFISEA }
8313 { EBCDIC-FR csEBCDICFR }
8314 { EBCDIC-IT csEBCDICIT }
8315 { EBCDIC-PT csEBCDICPT }
8316 { EBCDIC-ES csEBCDICES }
8317 { EBCDIC-ES-A csEBCDICESA }
8318 { EBCDIC-ES-S csEBCDICESS }
8319 { EBCDIC-UK csEBCDICUK }
8320 { EBCDIC-US csEBCDICUS }
8321 { UNKNOWN-8BIT csUnknown8BiT }
8322 { MNEMONIC csMnemonic }
8327 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8328 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8329 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8330 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8331 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8332 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8333 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8334 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8335 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8336 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8337 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8338 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8339 { IBM1047 IBM-1047 }
8340 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8341 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8342 { UNICODE-1-1 csUnicode11 }
8345 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8346 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8348 { ISO-8859-15 ISO_8859-15 Latin-9 }
8349 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8350 { GBK CP936 MS936 windows-936 }
8351 { JIS_Encoding csJISEncoding }
8352 { Shift_JIS MS_Kanji csShiftJIS }
8353 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8355 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8356 { ISO-10646-UCS-Basic csUnicodeASCII }
8357 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8358 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8359 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8360 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8361 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8362 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8363 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8364 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8365 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8366 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8367 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8368 { Ventura-US csVenturaUS }
8369 { Ventura-International csVenturaInternational }
8370 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8371 { PC8-Turkish csPC8Turkish }
8372 { IBM-Symbols csIBMSymbols }
8373 { IBM-Thai csIBMThai }
8374 { HP-Legal csHPLegal }
8375 { HP-Pi-font csHPPiFont }
8376 { HP-Math8 csHPMath8 }
8377 { Adobe-Symbol-Encoding csHPPSMath }
8378 { HP-DeskTop csHPDesktop }
8379 { Ventura-Math csVenturaMath }
8380 { Microsoft-Publishing csMicrosoftPublishing }
8381 { Windows-31J csWindows31J }
8386 proc tcl_encoding {enc} {
8387 global encoding_aliases
8388 set names [encoding names]
8389 set lcnames [string tolower $names]
8390 set enc [string tolower $enc]
8391 set i [lsearch -exact $lcnames $enc]
8393 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8394 if {[regsub {^iso[-_]} $enc iso encx]} {
8395 set i [lsearch -exact $lcnames $encx]
8399 foreach l $encoding_aliases {
8400 set ll [string tolower $l]
8401 if {[lsearch -exact $ll $enc] < 0} continue
8402 # look through the aliases for one that tcl knows about
8404 set i [lsearch -exact $lcnames $e]
8406 if {[regsub {^iso[-_]} $e iso ex]} {
8407 set i [lsearch -exact $lcnames $ex]
8416 return [lindex $names $i]
8421 # First check that Tcl/Tk is recent enough
8422 if {[catch {package require Tk 8.4} err]} {
8423 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8424 Gitk requires at least Tcl/Tk 8.4."]
8430 set wrcomcmd "git diff-tree --stdin -p --pretty"
8434 set gitencoding [exec git config --get i18n.commitencoding]
8436 if {$gitencoding == ""} {
8437 set gitencoding "utf-8"
8439 set tclencoding [tcl_encoding $gitencoding]
8440 if {$tclencoding == {}} {
8441 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8444 set mainfont {Helvetica 9}
8445 set textfont {Courier 9}
8446 set uifont {Helvetica 9 bold}
8448 set findmergefiles 0
8456 set cmitmode "patch"
8457 set wrapcomment "none"
8461 set showlocalchanges 1
8463 set datetimeformat "%Y-%m-%d %H:%M:%S"
8465 set colors {green red blue magenta darkgrey brown orange}
8468 set diffcolors {red "#00a000" blue}
8471 set selectbgcolor gray85
8473 ## For msgcat loading, first locate the installation location.
8474 if { [info exists ::env(GITK_MSGSDIR)] } {
8475 ## Msgsdir was manually set in the environment.
8476 set gitk_msgsdir $::env(GITK_MSGSDIR)
8478 ## Let's guess the prefix from argv0.
8479 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8480 set gitk_libdir [file join $gitk_prefix share gitk lib]
8481 set gitk_msgsdir [file join $gitk_libdir msgs]
8485 ## Internationalization (i18n) through msgcat and gettext. See
8486 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8487 package require msgcat
8488 namespace import ::msgcat::mc
8489 ## And eventually load the actual message catalog
8490 ::msgcat::mcload $gitk_msgsdir
8492 catch {source ~/.gitk}
8494 font create optionfont -family sans-serif -size -12
8496 parsefont mainfont $mainfont
8497 eval font create mainfont [fontflags mainfont]
8498 eval font create mainfontbold [fontflags mainfont 1]
8500 parsefont textfont $textfont
8501 eval font create textfont [fontflags textfont]
8502 eval font create textfontbold [fontflags textfont 1]
8504 parsefont uifont $uifont
8505 eval font create uifont [fontflags uifont]
8509 # check that we can find a .git directory somewhere...
8510 if {[catch {set gitdir [gitdir]}]} {
8511 show_error {} . [mc "Cannot find a git repository here."]
8514 if {![file isdirectory $gitdir]} {
8515 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8521 set cmdline_files {}
8526 "-d" { set datemode 1 }
8529 lappend revtreeargs $arg
8532 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8536 lappend revtreeargs $arg
8542 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8543 # no -- on command line, but some arguments (other than -d)
8545 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8546 set cmdline_files [split $f "\n"]
8547 set n [llength $cmdline_files]
8548 set revtreeargs [lrange $revtreeargs 0 end-$n]
8549 # Unfortunately git rev-parse doesn't produce an error when
8550 # something is both a revision and a filename. To be consistent
8551 # with git log and git rev-list, check revtreeargs for filenames.
8552 foreach arg $revtreeargs {
8553 if {[file exists $arg]} {
8554 show_error {} . [mc "Ambiguous argument '%s': both revision\
8560 # unfortunately we get both stdout and stderr in $err,
8561 # so look for "fatal:".
8562 set i [string first "fatal:" $err]
8564 set err [string range $err [expr {$i + 6}] end]
8566 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8572 # find the list of unmerged files
8576 set fd [open "| git ls-files -u" r]
8578 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8581 while {[gets $fd line] >= 0} {
8582 set i [string first "\t" $line]
8583 if {$i < 0} continue
8584 set fname [string range $line [expr {$i+1}] end]
8585 if {[lsearch -exact $mlist $fname] >= 0} continue
8587 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8588 lappend mlist $fname
8593 if {$nr_unmerged == 0} {
8594 show_error {} . [mc "No files selected: --merge specified but\
8595 no files are unmerged."]
8597 show_error {} . [mc "No files selected: --merge specified but\
8598 no unmerged files are within file limit."]
8602 set cmdline_files $mlist
8605 set nullid "0000000000000000000000000000000000000000"
8606 set nullid2 "0000000000000000000000000000000000000001"
8608 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8615 set highlight_paths {}
8617 set searchdirn -forwards
8621 set markingmatches 0
8622 set linkentercount 0
8623 set need_redisplay 0
8630 set selectedhlview [mc "None"]
8631 set highlight_related [mc "None"]
8632 set highlight_files {}
8646 # wait for the window to become visible
8648 wm title . "[file tail $argv0]: [file tail [pwd]]"
8651 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8652 # create a view for the files/dirs specified on the command line
8656 set viewname(1) [mc "Command line"]
8657 set viewfiles(1) $cmdline_files
8658 set viewargs(1) $revtreeargs
8661 .bar.view entryconf [mc "Edit view..."] -state normal
8662 .bar.view entryconf [mc "Delete view"] -state normal
8665 if {[info exists permviews]} {
8666 foreach v $permviews {
8669 set viewname($n) [lindex $v 0]
8670 set viewfiles($n) [lindex $v 1]
8671 set viewargs($n) [lindex $v 2]