2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
28 if {[info exists isonrunq
($script)]} return
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 set tstart
[clock clicks
-milliseconds]
56 set fd
[lindex
$runq 0 0]
57 set script [lindex
$runq 0 1]
58 set repeat
[eval $script]
59 set t1
[clock clicks
-milliseconds]
60 set t
[expr {$t1 - $t0}]
61 set runq
[lrange
$runq 1 end
]
62 if {$repeat ne
{} && $repeat} {
63 if {$fd eq
{} ||
$repeat == 2} {
64 # script returns 1 if it wants to be readded
65 # file readers return 2 if they could do more straight away
66 lappend runq
[list
$fd $script]
68 fileevent
$fd readable
[list filereadable
$fd $script]
70 } elseif
{$fd eq
{}} {
71 unset isonrunq
($script)
74 if {$t1 - $tstart >= 80} break
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list
{view
} {
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx viewcomplete vnextroot
86 global showlocalchanges commitinterest mainheadid
87 global progressdirn progresscoords proglastnc curview
89 set startmsecs
[clock clicks
-milliseconds]
90 set commitidx
($view) 0
91 set viewcomplete
($view) 0
92 set vnextroot
($view) 0
93 set order
"--topo-order"
95 set order
"--date-order"
98 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$order --parents \
99 --boundary $viewargs($view) "--" $viewfiles($view)] r
]
101 error_popup
"[mc "Error executing git rev-list
:"] $err"
104 set commfd
($view) $fd
105 set leftover
($view) {}
106 if {$showlocalchanges} {
107 lappend commitinterest
($mainheadid) {dodiffindex
}
109 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
110 if {$tclencoding != {}} {
111 fconfigure
$fd -encoding $tclencoding
113 filerun
$fd [list getcommitlines
$fd $view]
114 nowbusy
$view [mc
"Reading"]
115 if {$view == $curview} {
117 set progresscoords
{0 0}
122 proc stop_rev_list
{} {
123 global commfd curview
125 if {![info exists commfd
($curview)]} return
126 set fd
$commfd($curview)
132 unset commfd
($curview)
136 global phase canv curview
140 start_rev_list
$curview
141 show_status
[mc
"Reading commits..."]
144 # This makes a string representation of a positive integer which
145 # sorts as a string in numerical order
148 return [format
"%x" $n]
149 } elseif
{$n < 256} {
150 return [format
"x%.2x" $n]
151 } elseif
{$n < 65536} {
152 return [format
"y%.4x" $n]
154 return [format
"z%.8x" $n]
157 proc getcommitlines
{fd view
} {
158 global commitlisted commitinterest
159 global leftover commfd
160 global displayorder commitidx viewcomplete commitrow commitdata
161 global parentlist children curview hlview
162 global vparentlist vdisporder vcmitlisted
163 global ordertok vnextroot idpending
165 set stuff
[read $fd 500000]
166 # git log doesn't terminate the last commit with a null...
167 if {$stuff == {} && $leftover($view) ne
{} && [eof
$fd]} {
174 # Check if we have seen any ids listed as parents that haven't
175 # appeared in the list
176 foreach vid
[array names idpending
"$view,*"] {
177 # should only get here if git log is buggy
178 set id
[lindex
[split $vid ","] 1]
179 set commitrow
($vid) $commitidx($view)
180 incr commitidx
($view)
181 if {$view == $curview} {
182 lappend parentlist
{}
183 lappend displayorder
$id
184 lappend commitlisted
0
186 lappend vparentlist
($view) {}
187 lappend vdisporder
($view) $id
188 lappend vcmitlisted
($view) 0
191 set viewcomplete
($view) 1
192 global viewname progresscoords
195 set progresscoords
{0 0}
197 # set it blocking so we wait for the process to terminate
198 fconfigure
$fd -blocking 1
199 if {[catch
{close
$fd} err
]} {
201 if {$view != $curview} {
202 set fv
" for the \"$viewname($view)\" view"
204 if {[string range
$err 0 4] == "usage"} {
205 set err
"Gitk: error reading commits$fv:\
206 bad arguments to git rev-list."
207 if {$viewname($view) eq
"Command line"} {
209 " (Note: arguments to gitk are passed to git rev-list\
210 to allow selection of commits to be displayed.)"
213 set err
"Error reading commits$fv: $err"
217 if {$view == $curview} {
218 run chewcommits
$view
225 set i
[string first
"\0" $stuff $start]
227 append leftover
($view) [string range
$stuff $start end
]
231 set cmit
$leftover($view)
232 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
233 set leftover
($view) {}
235 set cmit
[string range
$stuff $start [expr {$i - 1}]]
237 set start
[expr {$i + 1}]
238 set j
[string first
"\n" $cmit]
241 if {$j >= 0 && [string match
"commit *" $cmit]} {
242 set ids
[string range
$cmit 7 [expr {$j - 1}]]
243 if {[string match
{[-^
<>]*} $ids]} {
244 switch
-- [string index
$ids 0] {
250 set ids
[string range
$ids 1 end
]
254 if {[string length
$id] != 40} {
262 if {[string length
$shortcmit] > 80} {
263 set shortcmit
"[string range $shortcmit 0 80]..."
265 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
268 set id [lindex $ids 0]
269 if {![info exists ordertok($view,$id)]} {
270 set otok "o[strrep $vnextroot($view)]"
271 incr vnextroot($view)
272 set ordertok($view,$id) $otok
274 set otok $ordertok($view,$id)
275 unset idpending($view,$id)
278 set olds [lrange $ids 1 end]
279 if {[llength $olds] == 1} {
280 set p [lindex $olds 0]
281 lappend children($view,$p) $id
282 if {![info exists ordertok($view,$p)]} {
283 set ordertok($view,$p) $ordertok($view,$id)
284 set idpending($view,$p) 1
289 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
290 lappend children($view,$p) $id
292 if {![info exists ordertok($view,$p)]} {
293 set ordertok($view,$p) "$otok[strrep $i]]"
294 set idpending($view,$p) 1
302 if {![info exists children($view,$id)]} {
303 set children($view,$id) {}
305 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
306 set commitrow($view,$id) $commitidx($view)
307 incr commitidx($view)
308 if {$view == $curview} {
309 lappend parentlist $olds
310 lappend displayorder $id
311 lappend commitlisted $listed
313 lappend vparentlist($view) $olds
314 lappend vdisporder($view) $id
315 lappend vcmitlisted($view) $listed
317 if {[info exists commitinterest($id)]} {
318 foreach script $commitinterest($id) {
319 eval [string map [list "%I" $id] $script]
321 unset commitinterest($id)
326 run chewcommits $view
327 if {$view == $curview} {
328 # update progress bar
329 global progressdirn progresscoords proglastnc
330 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
331 set proglastnc $commitidx($view)
332 set l [lindex $progresscoords 0]
333 set r [lindex $progresscoords 1]
335 set r [expr {$r + $inc}]
341 set l [expr {$r - 0.2}]
344 set l [expr {$l - $inc}]
349 set r [expr {$l + 0.2}]
351 set progresscoords [list $l $r]
358 proc chewcommits {view} {
359 global curview hlview viewcomplete
360 global selectedline pending_select
362 if {$view == $curview} {
364 if {$viewcomplete($view)} {
365 global displayorder commitidx phase
366 global numcommits startmsecs
368 if {[info exists pending_select]} {
369 set row [first_real_row]
372 if {$commitidx($curview) > 0} {
373 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
374 #puts "overall $ms ms for $numcommits commits"
376 show_status [mc "No commits selected"]
382 if {[info exists hlview] && $view == $hlview} {
388 proc readcommit {id} {
389 if {[catch {set contents [exec git cat-file commit $id]}]} return
390 parsecommit $id $contents 0
393 proc updatecommits {} {
394 global viewdata curview phase displayorder ordertok idpending
395 global children commitrow selectedline thickerline showneartags
402 foreach id $displayorder {
403 catch {unset children($n,$id)}
404 catch {unset commitrow($n,$id)}
405 catch {unset ordertok($n,$id)}
407 foreach vid [array names idpending "$n,*"] {
408 unset idpending($vid)
411 catch {unset selectedline}
412 catch {unset thickerline}
413 catch {unset viewdata($n)}
422 proc parsecommit {id contents listed} {
423 global commitinfo cdate
432 set hdrend [string first "\n\n" $contents]
434 # should never happen...
435 set hdrend [string length $contents]
437 set header [string range $contents 0 [expr {$hdrend - 1}]]
438 set comment [string range $contents [expr {$hdrend + 2}] end]
439 foreach line [split $header "\n"] {
440 set tag [lindex $line 0]
441 if {$tag == "author"} {
442 set audate [lindex $line end-1]
443 set auname [lrange $line 1 end-2]
444 } elseif {$tag == "committer"} {
445 set comdate [lindex $line end-1]
446 set comname [lrange $line 1 end-2]
450 # take the first non-blank line of the comment as the headline
451 set headline [string trimleft $comment]
452 set i [string first "\n" $headline]
454 set headline [string range $headline 0 $i]
456 set headline [string trimright $headline]
457 set i [string first "\r" $headline]
459 set headline [string trimright [string range $headline 0 $i]]
462 # git rev-list indents the comment by 4 spaces;
463 # if we got this via git cat-file, add the indentation
465 foreach line [split $comment "\n"] {
466 append newcomment " "
467 append newcomment $line
468 append newcomment "\n"
470 set comment $newcomment
472 if {$comdate != {}} {
473 set cdate($id) $comdate
475 set commitinfo($id) [list $headline $auname $audate \
476 $comname $comdate $comment]
479 proc getcommit {id} {
480 global commitdata commitinfo
482 if {[info exists commitdata($id)]} {
483 parsecommit $id $commitdata($id) 1
486 if {![info exists commitinfo($id)]} {
487 set commitinfo($id) [list [mc "No commit information available"]]
494 global tagids idtags headids idheads tagobjid
495 global otherrefids idotherrefs mainhead mainheadid
497 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
500 set refd [open [list | git show-ref -d] r]
501 while {[gets $refd line] >= 0} {
502 if {[string index $line 40] ne " "} continue
503 set id [string range $line 0 39]
504 set ref [string range $line 41 end]
505 if {![string match "refs/*" $ref]} continue
506 set name [string range $ref 5 end]
507 if {[string match "remotes/*" $name]} {
508 if {![string match "*/HEAD" $name]} {
509 set headids($name) $id
510 lappend idheads($id) $name
512 } elseif {[string match "heads/*" $name]} {
513 set name [string range $name 6 end]
514 set headids($name) $id
515 lappend idheads($id) $name
516 } elseif {[string match "tags/*" $name]} {
517 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
518 # which is what we want since the former is the commit ID
519 set name [string range $name 5 end]
520 if {[string match "*^{}" $name]} {
521 set name [string range $name 0 end-3]
523 set tagobjid($name) $id
525 set tagids($name) $id
526 lappend idtags($id) $name
528 set otherrefids($name) $id
529 lappend idotherrefs($id) $name
536 set thehead [exec git symbolic-ref HEAD]
537 if {[string match "refs/heads/*" $thehead]} {
538 set mainhead [string range $thehead 11 end]
539 if {[info exists headids($mainhead)]} {
540 set mainheadid $headids($mainhead)
546 # skip over fake commits
547 proc first_real_row {} {
548 global nullid nullid2 displayorder numcommits
550 for {set row 0} {$row < $numcommits} {incr row} {
551 set id [lindex $displayorder $row]
552 if {$id ne $nullid && $id ne $nullid2} {
559 # update things for a head moved to a child of its previous location
560 proc movehead {id name} {
561 global headids idheads
563 removehead $headids($name) $name
564 set headids($name) $id
565 lappend idheads($id) $name
568 # update things when a head has been removed
569 proc removehead {id name} {
570 global headids idheads
572 if {$idheads($id) eq $name} {
575 set i [lsearch -exact $idheads($id) $name]
577 set idheads($id) [lreplace $idheads($id) $i $i]
583 proc show_error {w top msg} {
584 message $w.m -text $msg -justify center -aspect 400
585 pack $w.m -side top -fill x -padx 20 -pady 20
586 button $w.ok -text [mc OK] -command "destroy $top"
587 pack $w.ok -side bottom -fill x
588 bind $top <Visibility> "grab $top; focus $top"
589 bind $top <Key-Return> "destroy $top"
593 proc error_popup msg {
597 show_error $w $w $msg
600 proc confirm_popup msg {
606 message $w.m -text $msg -justify center -aspect 400
607 pack $w.m -side top -fill x -padx 20 -pady 20
608 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
609 pack $w.ok -side left -fill x
610 button $w.cancel -text [mc Cancel] -command "destroy $w"
611 pack $w.cancel -side right -fill x
612 bind $w <Visibility> "grab $w; focus $w"
618 option add *Panedwindow.showHandle 1 startupFile
619 option add *Panedwindow.sashRelief raised startupFile
620 option add *Button.font uifont startupFile
621 option add *Checkbutton.font uifont startupFile
622 option add *Radiobutton.font uifont startupFile
623 option add *Menu.font uifont startupFile
624 option add *Menubutton.font uifont startupFile
625 option add *Label.font uifont startupFile
626 option add *Message.font uifont startupFile
627 option add *Entry.font uifont startupFile
631 global canv canv2 canv3 linespc charspc ctext cflist
633 global findtype findtypemenu findloc findstring fstring geometry
634 global entries sha1entry sha1string sha1but
635 global diffcontextstring diffcontext
637 global maincursor textcursor curtextcursor
638 global rowctxmenu fakerowmenu mergemax wrapcomment
639 global highlight_files gdttype
640 global searchstring sstring
641 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
642 global headctxmenu progresscanv progressitem progresscoords statusw
643 global fprogitem fprogcoord lastprogupdate progupdatepending
644 global rprogitem rprogcoord
648 .bar add cascade -label [mc "File"] -menu .bar.file
650 .bar.file add command -label [mc "Update"] -command updatecommits
651 .bar.file add command -label [mc "Reread references"] -command rereadrefs
652 .bar.file add command -label [mc "List references"] -command showrefs
653 .bar.file add command -label [mc "Quit"] -command doquit
655 .bar add cascade -label [mc "Edit"] -menu .bar.edit
656 .bar.edit add command -label [mc "Preferences"] -command doprefs
659 .bar add cascade -label [mc "View"] -menu .bar.view
660 .bar.view add command -label [mc "New view..."] -command {newview 0}
661 .bar.view add command -label [mc "Edit view..."] -command editview \
663 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
664 .bar.view add separator
665 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
666 -variable selectedview -value 0
669 .bar add cascade -label [mc "Help"] -menu .bar.help
670 .bar.help add command -label [mc "About gitk"] -command about
671 .bar.help add command -label [mc "Key bindings"] -command keys
673 . configure -menu .bar
675 # the gui has upper and lower half, parts of a paned window.
676 panedwindow .ctop -orient vertical
678 # possibly use assumed geometry
679 if {![info exists geometry(pwsash0)]} {
680 set geometry(topheight) [expr {15 * $linespc}]
681 set geometry(topwidth) [expr {80 * $charspc}]
682 set geometry(botheight) [expr {15 * $linespc}]
683 set geometry(botwidth) [expr {50 * $charspc}]
684 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
685 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
688 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
689 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
691 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
693 # create three canvases
694 set cscroll .tf.histframe.csb
695 set canv .tf.histframe.pwclist.canv
697 -selectbackground $selectbgcolor \
698 -background $bgcolor -bd 0 \
699 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
700 .tf.histframe.pwclist add $canv
701 set canv2 .tf.histframe.pwclist.canv2
703 -selectbackground $selectbgcolor \
704 -background $bgcolor -bd 0 -yscrollincr $linespc
705 .tf.histframe.pwclist add $canv2
706 set canv3 .tf.histframe.pwclist.canv3
708 -selectbackground $selectbgcolor \
709 -background $bgcolor -bd 0 -yscrollincr $linespc
710 .tf.histframe.pwclist add $canv3
711 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
712 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
714 # a scroll bar to rule them
715 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
716 pack $cscroll -side right -fill y
717 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
718 lappend bglist $canv $canv2 $canv3
719 pack .tf.histframe.pwclist -fill both -expand 1 -side left
721 # we have two button bars at bottom of top frame. Bar 1
723 frame .tf.lbar -height 15
725 set sha1entry .tf.bar.sha1
726 set entries $sha1entry
727 set sha1but .tf.bar.sha1label
728 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
729 -command gotocommit -width 8
730 $sha1but conf -disabledforeground [$sha1but cget -foreground]
731 pack .tf.bar.sha1label -side left
732 entry $sha1entry -width 40 -font textfont -textvariable sha1string
733 trace add variable sha1string write sha1change
734 pack $sha1entry -side left -pady 2
736 image create bitmap bm-left -data {
737 #define left_width 16
738 #define left_height 16
739 static unsigned char left_bits[] = {
740 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
741 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
742 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
744 image create bitmap bm-right -data {
745 #define right_width 16
746 #define right_height 16
747 static unsigned char right_bits[] = {
748 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
749 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
750 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
752 button .tf.bar.leftbut -image bm-left -command goback \
753 -state disabled -width 26
754 pack .tf.bar.leftbut -side left -fill y
755 button .tf.bar.rightbut -image bm-right -command goforw \
756 -state disabled -width 26
757 pack .tf.bar.rightbut -side left -fill y
759 # Status label and progress bar
760 set statusw .tf.bar.status
761 label $statusw -width 15 -relief sunken
762 pack $statusw -side left -padx 5
763 set h [expr {[font metrics uifont -linespace] + 2}]
764 set progresscanv .tf.bar.progress
765 canvas $progresscanv -relief sunken -height $h -borderwidth 2
766 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
767 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
768 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
769 pack $progresscanv -side right -expand 1 -fill x
770 set progresscoords {0 0}
773 bind $progresscanv <Configure> adjustprogress
774 set lastprogupdate [clock clicks -milliseconds]
775 set progupdatepending 0
777 # build up the bottom bar of upper window
778 label .tf.lbar.flabel -text "[mc "Find"] "
779 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
780 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
781 label .tf.lbar.flab2 -text " [mc "commit"] "
782 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
784 set gdttype [mc "containing:"]
785 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
787 [mc "touching paths:"] \
788 [mc "adding/removing string:"]]
789 trace add variable gdttype write gdttype_change
790 pack .tf.lbar.gdttype -side left -fill y
793 set fstring .tf.lbar.findstring
794 lappend entries $fstring
795 entry $fstring -width 30 -font textfont -textvariable findstring
796 trace add variable findstring write find_change
797 set findtype [mc "Exact"]
798 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
799 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
800 trace add variable findtype write findcom_change
801 set findloc [mc "All fields"]
802 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
803 [mc "Comments"] [mc "Author"] [mc "Committer"]
804 trace add variable findloc write find_change
805 pack .tf.lbar.findloc -side right
806 pack .tf.lbar.findtype -side right
807 pack $fstring -side left -expand 1 -fill x
809 # Finish putting the upper half of the viewer together
810 pack .tf.lbar -in .tf -side bottom -fill x
811 pack .tf.bar -in .tf -side bottom -fill x
812 pack .tf.histframe -fill both -side top -expand 1
814 .ctop paneconfigure .tf -height $geometry(topheight)
815 .ctop paneconfigure .tf -width $geometry(topwidth)
817 # now build up the bottom
818 panedwindow .pwbottom -orient horizontal
820 # lower left, a text box over search bar, scroll bar to the right
821 # if we know window height, then that will set the lower text height, otherwise
822 # we set lower text height which will drive window height
823 if {[info exists geometry(main)]} {
824 frame .bleft -width $geometry(botwidth)
826 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
831 button .bleft.top.search -text [mc "Search"] -command dosearch
832 pack .bleft.top.search -side left -padx 5
833 set sstring .bleft.top.sstring
834 entry $sstring -width 20 -font textfont -textvariable searchstring
835 lappend entries $sstring
836 trace add variable searchstring write incrsearch
837 pack $sstring -side left -expand 1 -fill x
838 radiobutton .bleft.mid.diff -text [mc "Diff"] \
839 -command changediffdisp -variable diffelide -value {0 0}
840 radiobutton .bleft.mid.old -text [mc "Old version"] \
841 -command changediffdisp -variable diffelide -value {0 1}
842 radiobutton .bleft.mid.new -text [mc "New version"] \
843 -command changediffdisp -variable diffelide -value {1 0}
844 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
845 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
846 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
847 -from 1 -increment 1 -to 10000000 \
848 -validate all -validatecommand "diffcontextvalidate %P" \
849 -textvariable diffcontextstring
850 .bleft.mid.diffcontext set $diffcontext
851 trace add variable diffcontextstring write diffcontextchange
852 lappend entries .bleft.mid.diffcontext
853 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
854 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
855 -command changeignorespace -variable ignorespace
856 pack .bleft.mid.ignspace -side left -padx 5
857 set ctext .bleft.ctext
858 text $ctext -background $bgcolor -foreground $fgcolor \
859 -state disabled -font textfont \
860 -yscrollcommand scrolltext -wrap none
862 $ctext conf -tabstyle wordprocessor
864 scrollbar .bleft.sb -command "$ctext yview"
865 pack .bleft.top -side top -fill x
866 pack .bleft.mid -side top -fill x
867 pack .bleft.sb -side right -fill y
868 pack $ctext -side left -fill both -expand 1
869 lappend bglist $ctext
870 lappend fglist $ctext
872 $ctext tag conf comment -wrap $wrapcomment
873 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
874 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
875 $ctext tag conf d0 -fore [lindex $diffcolors 0]
876 $ctext tag conf d1 -fore [lindex $diffcolors 1]
877 $ctext tag conf m0 -fore red
878 $ctext tag conf m1 -fore blue
879 $ctext tag conf m2 -fore green
880 $ctext tag conf m3 -fore purple
881 $ctext tag conf m4 -fore brown
882 $ctext tag conf m5 -fore "#009090"
883 $ctext tag conf m6 -fore magenta
884 $ctext tag conf m7 -fore "#808000"
885 $ctext tag conf m8 -fore "#009000"
886 $ctext tag conf m9 -fore "#ff0080"
887 $ctext tag conf m10 -fore cyan
888 $ctext tag conf m11 -fore "#b07070"
889 $ctext tag conf m12 -fore "#70b0f0"
890 $ctext tag conf m13 -fore "#70f0b0"
891 $ctext tag conf m14 -fore "#f0b070"
892 $ctext tag conf m15 -fore "#ff70b0"
893 $ctext tag conf mmax -fore darkgrey
895 $ctext tag conf mresult -font textfontbold
896 $ctext tag conf msep -font textfontbold
897 $ctext tag conf found -back yellow
900 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
905 radiobutton .bright.mode.patch -text [mc "Patch"] \
906 -command reselectline -variable cmitmode -value "patch"
907 radiobutton .bright.mode.tree -text [mc "Tree"] \
908 -command reselectline -variable cmitmode -value "tree"
909 grid .bright.mode.patch .bright.mode.tree -sticky ew
910 pack .bright.mode -side top -fill x
911 set cflist .bright.cfiles
912 set indent [font measure mainfont "nn"]
914 -selectbackground $selectbgcolor \
915 -background $bgcolor -foreground $fgcolor \
917 -tabs [list $indent [expr {2 * $indent}]] \
918 -yscrollcommand ".bright.sb set" \
919 -cursor [. cget -cursor] \
920 -spacing1 1 -spacing3 1
921 lappend bglist $cflist
922 lappend fglist $cflist
923 scrollbar .bright.sb -command "$cflist yview"
924 pack .bright.sb -side right -fill y
925 pack $cflist -side left -fill both -expand 1
926 $cflist tag configure highlight \
927 -background [$cflist cget -selectbackground]
928 $cflist tag configure bold -font mainfontbold
930 .pwbottom add .bright
933 # restore window position if known
934 if {[info exists geometry(main)]} {
935 wm geometry . "$geometry(main)"
938 if {[tk windowingsystem] eq {aqua}} {
944 bind .pwbottom <Configure> {resizecdetpanes %W %w}
945 pack .ctop -fill both -expand 1
946 bindall <1> {selcanvline %W %x %y}
947 #bindall <B1-Motion> {selcanvline %W %x %y}
948 if {[tk windowingsystem] == "win32"} {
949 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
950 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
952 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
953 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
954 if {[tk windowingsystem] eq "aqua"} {
955 bindall <MouseWheel> {
956 set delta [expr {- (%D)}]
957 allcanvs yview scroll $delta units
961 bindall <2> "canvscan mark %W %x %y"
962 bindall <B2-Motion> "canvscan dragto %W %x %y"
963 bindkey <Home> selfirstline
964 bindkey <End> sellastline
965 bind . <Key-Up> "selnextline -1"
966 bind . <Key-Down> "selnextline 1"
967 bind . <Shift-Key-Up> "dofind -1 0"
968 bind . <Shift-Key-Down> "dofind 1 0"
969 bindkey <Key-Right> "goforw"
970 bindkey <Key-Left> "goback"
971 bind . <Key-Prior> "selnextpage -1"
972 bind . <Key-Next> "selnextpage 1"
973 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
974 bind . <$M1B-End> "allcanvs yview moveto 1.0"
975 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
976 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
977 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
978 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
979 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
980 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
981 bindkey <Key-space> "$ctext yview scroll 1 pages"
982 bindkey p "selnextline -1"
983 bindkey n "selnextline 1"
986 bindkey i "selnextline -1"
987 bindkey k "selnextline 1"
990 bindkey b "$ctext yview scroll -1 pages"
991 bindkey d "$ctext yview scroll 18 units"
992 bindkey u "$ctext yview scroll -18 units"
993 bindkey / {dofind 1 1}
994 bindkey <Key-Return> {dofind 1 1}
995 bindkey ? {dofind -1 1}
997 bindkey <F5> updatecommits
998 bind . <$M1B-q> doquit
999 bind . <$M1B-f> {dofind 1 1}
1000 bind . <$M1B-g> {dofind 1 0}
1001 bind . <$M1B-r> dosearchback
1002 bind . <$M1B-s> dosearch
1003 bind . <$M1B-equal> {incrfont 1}
1004 bind . <$M1B-plus> {incrfont 1}
1005 bind . <$M1B-KP_Add> {incrfont 1}
1006 bind . <$M1B-minus> {incrfont -1}
1007 bind . <$M1B-KP_Subtract> {incrfont -1}
1008 wm protocol . WM_DELETE_WINDOW doquit
1009 bind . <Button-1> "click %W"
1010 bind $fstring <Key-Return> {dofind 1 1}
1011 bind $sha1entry <Key-Return> gotocommit
1012 bind $sha1entry <<PasteSelection>> clearsha1
1013 bind $cflist <1> {sel_flist %W %x %y; break}
1014 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1015 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1016 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1018 set maincursor [. cget -cursor]
1019 set textcursor [$ctext cget -cursor]
1020 set curtextcursor $textcursor
1022 set rowctxmenu .rowctxmenu
1023 menu $rowctxmenu -tearoff 0
1024 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1025 -command {diffvssel 0}
1026 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1027 -command {diffvssel 1}
1028 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1029 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1030 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1031 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1032 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1034 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1037 set fakerowmenu .fakerowmenu
1038 menu $fakerowmenu -tearoff 0
1039 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1040 -command {diffvssel 0}
1041 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1042 -command {diffvssel 1}
1043 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1044 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1045 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1046 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1048 set headctxmenu .headctxmenu
1049 menu $headctxmenu -tearoff 0
1050 $headctxmenu add command -label [mc "Check out this branch"] \
1052 $headctxmenu add command -label [mc "Remove this branch"] \
1056 set flist_menu .flistctxmenu
1057 menu $flist_menu -tearoff 0
1058 $flist_menu add command -label [mc "Highlight this too"] \
1059 -command {flist_hl 0}
1060 $flist_menu add command -label [mc "Highlight this only"] \
1061 -command {flist_hl 1}
1064 # Windows sends all mouse wheel events to the current focused window, not
1065 # the one where the mouse hovers, so bind those events here and redirect
1066 # to the correct window
1067 proc windows_mousewheel_redirector {W X Y D} {
1068 global canv canv2 canv3
1069 set w [winfo containing -displayof $W $X $Y]
1071 set u [expr {$D < 0 ? 5 : -5}]
1072 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1073 allcanvs yview scroll $u units
1076 $w yview scroll $u units
1082 # mouse-2 makes all windows scan vertically, but only the one
1083 # the cursor is in scans horizontally
1084 proc canvscan {op w x y} {
1085 global canv canv2 canv3
1086 foreach c [list $canv $canv2 $canv3] {
1095 proc scrollcanv {cscroll f0 f1} {
1096 $cscroll set $f0 $f1
1101 # when we make a key binding for the toplevel, make sure
1102 # it doesn't get triggered when that key is pressed
in the
1103 # find string entry widget.
1104 proc bindkey
{ev
script} {
1107 set escript
[bind Entry
$ev]
1108 if {$escript == {}} {
1109 set escript
[bind Entry
<Key
>]
1111 foreach e
$entries {
1112 bind $e $ev "$escript; break"
1116 # set the focus back to the toplevel for any click outside
1119 global ctext entries
1120 foreach e
[concat
$entries $ctext] {
1121 if {$w == $e} return
1126 # Adjust the progress bar for a change in requested extent or canvas size
1127 proc adjustprogress
{} {
1128 global progresscanv progressitem progresscoords
1129 global fprogitem fprogcoord lastprogupdate progupdatepending
1130 global rprogitem rprogcoord
1132 set w
[expr {[winfo width
$progresscanv] - 4}]
1133 set x0
[expr {$w * [lindex
$progresscoords 0]}]
1134 set x1
[expr {$w * [lindex
$progresscoords 1]}]
1135 set h
[winfo height
$progresscanv]
1136 $progresscanv coords
$progressitem $x0 0 $x1 $h
1137 $progresscanv coords
$fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1138 $progresscanv coords
$rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1139 set now
[clock clicks
-milliseconds]
1140 if {$now >= $lastprogupdate + 100} {
1141 set progupdatepending
0
1143 } elseif
{!$progupdatepending} {
1144 set progupdatepending
1
1145 after
[expr {$lastprogupdate + 100 - $now}] doprogupdate
1149 proc doprogupdate
{} {
1150 global lastprogupdate progupdatepending
1152 if {$progupdatepending} {
1153 set progupdatepending
0
1154 set lastprogupdate
[clock clicks
-milliseconds]
1159 proc savestuff
{w
} {
1160 global canv canv2 canv3 mainfont textfont uifont tabstop
1161 global stuffsaved findmergefiles maxgraphpct
1162 global maxwidth showneartags showlocalchanges
1163 global viewname viewfiles viewargs viewperm nextviewnum
1164 global cmitmode wrapcomment datetimeformat limitdiffs
1165 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1167 if {$stuffsaved} return
1168 if {![winfo viewable .
]} return
1170 set f
[open
"~/.gitk-new" w
]
1171 puts
$f [list
set mainfont
$mainfont]
1172 puts
$f [list
set textfont
$textfont]
1173 puts
$f [list
set uifont
$uifont]
1174 puts
$f [list
set tabstop
$tabstop]
1175 puts
$f [list
set findmergefiles
$findmergefiles]
1176 puts
$f [list
set maxgraphpct
$maxgraphpct]
1177 puts
$f [list
set maxwidth
$maxwidth]
1178 puts
$f [list
set cmitmode
$cmitmode]
1179 puts
$f [list
set wrapcomment
$wrapcomment]
1180 puts
$f [list
set showneartags
$showneartags]
1181 puts
$f [list
set showlocalchanges
$showlocalchanges]
1182 puts
$f [list
set datetimeformat
$datetimeformat]
1183 puts
$f [list
set limitdiffs
$limitdiffs]
1184 puts
$f [list
set bgcolor
$bgcolor]
1185 puts
$f [list
set fgcolor
$fgcolor]
1186 puts
$f [list
set colors
$colors]
1187 puts
$f [list
set diffcolors
$diffcolors]
1188 puts
$f [list
set diffcontext
$diffcontext]
1189 puts
$f [list
set selectbgcolor
$selectbgcolor]
1191 puts
$f "set geometry(main) [wm geometry .]"
1192 puts
$f "set geometry(topwidth) [winfo width .tf]"
1193 puts
$f "set geometry(topheight) [winfo height .tf]"
1194 puts
$f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1195 puts
$f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1196 puts
$f "set geometry(botwidth) [winfo width .bleft]"
1197 puts
$f "set geometry(botheight) [winfo height .bleft]"
1199 puts
-nonewline $f "set permviews {"
1200 for {set v
0} {$v < $nextviewnum} {incr v
} {
1201 if {$viewperm($v)} {
1202 puts
$f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1207 catch
{file delete
"~/.gitk"}
1208 file rename
-force "~/.gitk-new" "~/.gitk"
1213 proc resizeclistpanes
{win w
} {
1215 if {[info exists oldwidth
($win)]} {
1216 set s0
[$win sash coord
0]
1217 set s1
[$win sash coord
1]
1219 set sash0
[expr {int
($w/2 - 2)}]
1220 set sash1
[expr {int
($w*5/6 - 2)}]
1222 set factor [expr {1.0 * $w / $oldwidth($win)}]
1223 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1224 set sash1
[expr {int
($factor * [lindex
$s1 0])}]
1228 if {$sash1 < $sash0 + 20} {
1229 set sash1
[expr {$sash0 + 20}]
1231 if {$sash1 > $w - 10} {
1232 set sash1
[expr {$w - 10}]
1233 if {$sash0 > $sash1 - 20} {
1234 set sash0
[expr {$sash1 - 20}]
1238 $win sash place
0 $sash0 [lindex
$s0 1]
1239 $win sash place
1 $sash1 [lindex
$s1 1]
1241 set oldwidth
($win) $w
1244 proc resizecdetpanes
{win w
} {
1246 if {[info exists oldwidth
($win)]} {
1247 set s0
[$win sash coord
0]
1249 set sash0
[expr {int
($w*3/4 - 2)}]
1251 set factor [expr {1.0 * $w / $oldwidth($win)}]
1252 set sash0
[expr {int
($factor * [lindex
$s0 0])}]
1256 if {$sash0 > $w - 15} {
1257 set sash0
[expr {$w - 15}]
1260 $win sash place
0 $sash0 [lindex
$s0 1]
1262 set oldwidth
($win) $w
1265 proc allcanvs args
{
1266 global canv canv2 canv3
1272 proc bindall
{event action
} {
1273 global canv canv2 canv3
1274 bind $canv $event $action
1275 bind $canv2 $event $action
1276 bind $canv3 $event $action
1282 if {[winfo exists
$w]} {
1287 wm title
$w [mc
"About gitk"]
1288 message
$w.m
-text [mc
"
1289 Gitk - a commit viewer for git
1291 Copyright © 2005-2006 Paul Mackerras
1293 Use and redistribute under the terms of the GNU General Public License"] \
1294 -justify center
-aspect 400 -border 2 -bg white
-relief groove
1295 pack
$w.m
-side top
-fill x
-padx 2 -pady 2
1296 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1297 pack
$w.ok
-side bottom
1298 bind $w <Visibility
> "focus $w.ok"
1299 bind $w <Key-Escape
> "destroy $w"
1300 bind $w <Key-Return
> "destroy $w"
1305 if {[winfo exists
$w]} {
1309 if {[tk windowingsystem
] eq
{aqua
}} {
1315 wm title
$w [mc
"Gitk key bindings"]
1316 message
$w.m
-text "
1317 [mc "Gitk key bindings
:"]
1319 [mc "<%s-Q
> Quit
" $M1T]
1320 [mc "<Home
> Move to first commit
"]
1321 [mc "<End
> Move to last commit
"]
1322 [mc "<Up
>, p
, i Move up one commit
"]
1323 [mc "<Down
>, n
, k Move down one commit
"]
1324 [mc "<Left
>, z
, j Go back
in history list
"]
1325 [mc "<Right
>, x
, l Go forward
in history list
"]
1326 [mc "<PageUp
> Move up one page
in commit list
"]
1327 [mc "<PageDown
> Move down one page
in commit list
"]
1328 [mc "<%s-Home
> Scroll to top of commit list
" $M1T]
1329 [mc "<%s-End
> Scroll to bottom of commit list
" $M1T]
1330 [mc "<%s-Up
> Scroll commit list up one line
" $M1T]
1331 [mc "<%s-Down
> Scroll commit list down one line
" $M1T]
1332 [mc "<%s-PageUp
> Scroll commit list up one page
" $M1T]
1333 [mc "<%s-PageDown
> Scroll commit list down one page
" $M1T]
1334 [mc "<Shift-Up
> Find backwards
(upwards
, later commits
)"]
1335 [mc "<Shift-Down
> Find forwards
(downwards
, earlier commits
)"]
1336 [mc "<Delete
>, b Scroll
diff view up one page
"]
1337 [mc "<Backspace
> Scroll
diff view up one page
"]
1338 [mc "<Space
> Scroll
diff view down one page
"]
1339 [mc "u Scroll
diff view up
18 lines
"]
1340 [mc "d Scroll
diff view down
18 lines
"]
1341 [mc "<%s-F
> Find
" $M1T]
1342 [mc "<%s-G
> Move to next
find hit
" $M1T]
1343 [mc "<Return
> Move to next
find hit
"]
1344 [mc "/ Move to next
find hit
, or redo
find"]
1345 [mc "? Move to previous
find hit
"]
1346 [mc "f Scroll
diff view to next
file"]
1347 [mc "<%s-S
> Search
for next hit
in diff view
" $M1T]
1348 [mc "<%s-R
> Search
for previous hit
in diff view
" $M1T]
1349 [mc "<%s-KP
+> Increase font size
" $M1T]
1350 [mc "<%s-plus
> Increase font size
" $M1T]
1351 [mc "<%s-KP-
> Decrease font size
" $M1T]
1352 [mc "<%s-minus
> Decrease font size
" $M1T]
1355 -justify left
-bg white
-border 2 -relief groove
1356 pack
$w.m
-side top
-fill both
-padx 2 -pady 2
1357 button
$w.ok
-text [mc
"Close"] -command "destroy $w" -default active
1358 pack
$w.ok
-side bottom
1359 bind $w <Visibility
> "focus $w.ok"
1360 bind $w <Key-Escape
> "destroy $w"
1361 bind $w <Key-Return
> "destroy $w"
1364 # Procedures for manipulating the file list window at the
1365 # bottom right of the overall window.
1367 proc treeview
{w l openlevs
} {
1368 global treecontents treediropen treeheight treeparent treeindex
1378 set treecontents
() {}
1379 $w conf
-state normal
1381 while {[string range
$f 0 $prefixend] ne
$prefix} {
1382 if {$lev <= $openlevs} {
1383 $w mark
set e
:$treeindex($prefix) "end -1c"
1384 $w mark gravity e
:$treeindex($prefix) left
1386 set treeheight
($prefix) $ht
1387 incr ht
[lindex
$htstack end
]
1388 set htstack
[lreplace
$htstack end end
]
1389 set prefixend
[lindex
$prefendstack end
]
1390 set prefendstack
[lreplace
$prefendstack end end
]
1391 set prefix
[string range
$prefix 0 $prefixend]
1394 set tail [string range
$f [expr {$prefixend+1}] end
]
1395 while {[set slash
[string first
"/" $tail]] >= 0} {
1398 lappend prefendstack
$prefixend
1399 incr prefixend
[expr {$slash + 1}]
1400 set d
[string range
$tail 0 $slash]
1401 lappend treecontents
($prefix) $d
1402 set oldprefix
$prefix
1404 set treecontents
($prefix) {}
1405 set treeindex
($prefix) [incr ix
]
1406 set treeparent
($prefix) $oldprefix
1407 set tail [string range
$tail [expr {$slash+1}] end
]
1408 if {$lev <= $openlevs} {
1410 set treediropen
($prefix) [expr {$lev < $openlevs}]
1411 set bm
[expr {$lev == $openlevs?
"tri-rt": "tri-dn"}]
1412 $w mark
set d
:$ix "end -1c"
1413 $w mark gravity d
:$ix left
1415 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1417 $w image create end
-align center
-image $bm -padx 1 \
1419 $w insert end
$d [highlight_tag
$prefix]
1420 $w mark
set s
:$ix "end -1c"
1421 $w mark gravity s
:$ix left
1426 if {$lev <= $openlevs} {
1429 for {set i
0} {$i < $lev} {incr i
} {append str
"\t"}
1431 $w insert end
$tail [highlight_tag
$f]
1433 lappend treecontents
($prefix) $tail
1436 while {$htstack ne
{}} {
1437 set treeheight
($prefix) $ht
1438 incr ht
[lindex
$htstack end
]
1439 set htstack
[lreplace
$htstack end end
]
1440 set prefixend
[lindex
$prefendstack end
]
1441 set prefendstack
[lreplace
$prefendstack end end
]
1442 set prefix
[string range
$prefix 0 $prefixend]
1444 $w conf
-state disabled
1447 proc linetoelt
{l
} {
1448 global treeheight treecontents
1453 foreach e
$treecontents($prefix) {
1458 if {[string index
$e end
] eq
"/"} {
1459 set n
$treeheight($prefix$e)
1471 proc highlight_tree
{y prefix
} {
1472 global treeheight treecontents cflist
1474 foreach e
$treecontents($prefix) {
1476 if {[highlight_tag
$path] ne
{}} {
1477 $cflist tag add bold
$y.0 "$y.0 lineend"
1480 if {[string index
$e end
] eq
"/" && $treeheight($path) > 1} {
1481 set y
[highlight_tree
$y $path]
1487 proc treeclosedir
{w dir
} {
1488 global treediropen treeheight treeparent treeindex
1490 set ix
$treeindex($dir)
1491 $w conf
-state normal
1492 $w delete s
:$ix e
:$ix
1493 set treediropen
($dir) 0
1494 $w image configure a
:$ix -image tri-rt
1495 $w conf
-state disabled
1496 set n
[expr {1 - $treeheight($dir)}]
1497 while {$dir ne
{}} {
1498 incr treeheight
($dir) $n
1499 set dir
$treeparent($dir)
1503 proc treeopendir
{w dir
} {
1504 global treediropen treeheight treeparent treecontents treeindex
1506 set ix
$treeindex($dir)
1507 $w conf
-state normal
1508 $w image configure a
:$ix -image tri-dn
1509 $w mark
set e
:$ix s
:$ix
1510 $w mark gravity e
:$ix right
1513 set n
[llength
$treecontents($dir)]
1514 for {set x
$dir} {$x ne
{}} {set x
$treeparent($x)} {
1517 incr treeheight
($x) $n
1519 foreach e
$treecontents($dir) {
1521 if {[string index
$e end
] eq
"/"} {
1522 set iy
$treeindex($de)
1523 $w mark
set d
:$iy e
:$ix
1524 $w mark gravity d
:$iy left
1525 $w insert e
:$ix $str
1526 set treediropen
($de) 0
1527 $w image create e
:$ix -align center
-image tri-rt
-padx 1 \
1529 $w insert e
:$ix $e [highlight_tag
$de]
1530 $w mark
set s
:$iy e
:$ix
1531 $w mark gravity s
:$iy left
1532 set treeheight
($de) 1
1534 $w insert e
:$ix $str
1535 $w insert e
:$ix $e [highlight_tag
$de]
1538 $w mark gravity e
:$ix left
1539 $w conf
-state disabled
1540 set treediropen
($dir) 1
1541 set top
[lindex
[split [$w index @
0,0] .
] 0]
1542 set ht
[$w cget
-height]
1543 set l
[lindex
[split [$w index s
:$ix] .
] 0]
1546 } elseif
{$l + $n + 1 > $top + $ht} {
1547 set top
[expr {$l + $n + 2 - $ht}]
1555 proc treeclick
{w x y
} {
1556 global treediropen cmitmode ctext cflist cflist_top
1558 if {$cmitmode ne
"tree"} return
1559 if {![info exists cflist_top
]} return
1560 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1561 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1562 $cflist tag add highlight
$l.0 "$l.0 lineend"
1568 set e
[linetoelt
$l]
1569 if {[string index
$e end
] ne
"/"} {
1571 } elseif
{$treediropen($e)} {
1578 proc setfilelist
{id
} {
1579 global treefilelist cflist
1581 treeview
$cflist $treefilelist($id) 0
1584 image create bitmap tri-rt
-background black
-foreground blue
-data {
1585 #define tri-rt_width 13
1586 #define tri-rt_height 13
1587 static unsigned char tri-rt_bits
[] = {
1588 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1589 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1592 #define tri-rt-mask_width 13
1593 #define tri-rt-mask_height 13
1594 static unsigned char tri-rt-mask_bits
[] = {
1595 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1596 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1599 image create bitmap tri-dn
-background black
-foreground blue
-data {
1600 #define tri-dn_width 13
1601 #define tri-dn_height 13
1602 static unsigned char tri-dn_bits
[] = {
1603 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1604 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1607 #define tri-dn-mask_width 13
1608 #define tri-dn-mask_height 13
1609 static unsigned char tri-dn-mask_bits
[] = {
1610 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1611 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1615 image create bitmap reficon-T
-background black
-foreground yellow
-data {
1616 #define tagicon_width 13
1617 #define tagicon_height 9
1618 static unsigned char tagicon_bits
[] = {
1619 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1620 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1622 #define tagicon-mask_width 13
1623 #define tagicon-mask_height 9
1624 static unsigned char tagicon-mask_bits
[] = {
1625 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1626 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1629 #define headicon_width 13
1630 #define headicon_height 9
1631 static unsigned char headicon_bits
[] = {
1632 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1633 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1636 #define headicon-mask_width 13
1637 #define headicon-mask_height 9
1638 static unsigned char headicon-mask_bits
[] = {
1639 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1640 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1642 image create bitmap reficon-H
-background black
-foreground green \
1643 -data $rectdata -maskdata $rectmask
1644 image create bitmap reficon-o
-background black
-foreground "#ddddff" \
1645 -data $rectdata -maskdata $rectmask
1647 proc init_flist
{first
} {
1648 global cflist cflist_top selectedline difffilestart
1650 $cflist conf
-state normal
1651 $cflist delete
0.0 end
1653 $cflist insert end
$first
1655 $cflist tag add highlight
1.0 "1.0 lineend"
1657 catch
{unset cflist_top
}
1659 $cflist conf
-state disabled
1660 set difffilestart
{}
1663 proc highlight_tag
{f
} {
1664 global highlight_paths
1666 foreach p
$highlight_paths {
1667 if {[string match
$p $f]} {
1674 proc highlight_filelist
{} {
1675 global cmitmode cflist
1677 $cflist conf
-state normal
1678 if {$cmitmode ne
"tree"} {
1679 set end
[lindex
[split [$cflist index end
] .
] 0]
1680 for {set l
2} {$l < $end} {incr l
} {
1681 set line
[$cflist get
$l.0 "$l.0 lineend"]
1682 if {[highlight_tag
$line] ne
{}} {
1683 $cflist tag add bold
$l.0 "$l.0 lineend"
1689 $cflist conf
-state disabled
1692 proc unhighlight_filelist
{} {
1695 $cflist conf
-state normal
1696 $cflist tag remove bold
1.0 end
1697 $cflist conf
-state disabled
1700 proc add_flist
{fl
} {
1703 $cflist conf
-state normal
1705 $cflist insert end
"\n"
1706 $cflist insert end
$f [highlight_tag
$f]
1708 $cflist conf
-state disabled
1711 proc sel_flist
{w x y
} {
1712 global ctext difffilestart cflist cflist_top cmitmode
1714 if {$cmitmode eq
"tree"} return
1715 if {![info exists cflist_top
]} return
1716 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1717 $cflist tag remove highlight
$cflist_top.0 "$cflist_top.0 lineend"
1718 $cflist tag add highlight
$l.0 "$l.0 lineend"
1723 catch
{$ctext yview
[lindex
$difffilestart [expr {$l - 2}]]}
1727 proc pop_flist_menu
{w X Y x y
} {
1728 global ctext cflist cmitmode flist_menu flist_menu_file
1729 global treediffs diffids
1732 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
1734 if {$cmitmode eq
"tree"} {
1735 set e
[linetoelt
$l]
1736 if {[string index
$e end
] eq
"/"} return
1738 set e
[lindex
$treediffs($diffids) [expr {$l-2}]]
1740 set flist_menu_file
$e
1741 tk_popup
$flist_menu $X $Y
1744 proc flist_hl
{only
} {
1745 global flist_menu_file findstring gdttype
1747 set x
[shellquote
$flist_menu_file]
1748 if {$only ||
$findstring eq
{} ||
$gdttype ne
[mc
"touching paths:"]} {
1751 append findstring
" " $x
1753 set gdttype
[mc
"touching paths:"]
1756 # Functions for adding and removing shell-type quoting
1758 proc shellquote
{str
} {
1759 if {![string match
"*\['\"\\ \t]*" $str]} {
1762 if {![string match
"*\['\"\\]*" $str]} {
1765 if {![string match
"*'*" $str]} {
1768 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1771 proc shellarglist
{l
} {
1777 append str
[shellquote
$a]
1782 proc shelldequote
{str
} {
1787 if {![regexp
-start $used -indices "\['\"\\\\ \t]" $str first
]} {
1788 append ret
[string range
$str $used end
]
1789 set used
[string length
$str]
1792 set first
[lindex
$first 0]
1793 set ch
[string index
$str $first]
1794 if {$first > $used} {
1795 append ret
[string range
$str $used [expr {$first - 1}]]
1798 if {$ch eq
" " ||
$ch eq
"\t"} break
1801 set first
[string first
"'" $str $used]
1803 error
"unmatched single-quote"
1805 append ret
[string range
$str $used [expr {$first - 1}]]
1810 if {$used >= [string length
$str]} {
1811 error
"trailing backslash"
1813 append ret
[string index
$str $used]
1818 if {![regexp
-start $used -indices "\[\"\\\\]" $str first
]} {
1819 error
"unmatched double-quote"
1821 set first
[lindex
$first 0]
1822 set ch
[string index
$str $first]
1823 if {$first > $used} {
1824 append ret
[string range
$str $used [expr {$first - 1}]]
1827 if {$ch eq
"\""} break
1829 append ret
[string index
$str $used]
1833 return [list
$used $ret]
1836 proc shellsplit
{str
} {
1839 set str
[string trimleft
$str]
1840 if {$str eq
{}} break
1841 set dq
[shelldequote
$str]
1842 set n
[lindex
$dq 0]
1843 set word
[lindex
$dq 1]
1844 set str
[string range
$str $n end
]
1850 # Code to implement multiple views
1852 proc newview
{ishighlight
} {
1853 global nextviewnum newviewname newviewperm newishighlight
1854 global newviewargs revtreeargs
1856 set newishighlight
$ishighlight
1858 if {[winfo exists
$top]} {
1862 set newviewname
($nextviewnum) "View $nextviewnum"
1863 set newviewperm
($nextviewnum) 0
1864 set newviewargs
($nextviewnum) [shellarglist
$revtreeargs]
1865 vieweditor
$top $nextviewnum [mc
"Gitk view definition"]
1870 global viewname viewperm newviewname newviewperm
1871 global viewargs newviewargs
1873 set top .gitkvedit-
$curview
1874 if {[winfo exists
$top]} {
1878 set newviewname
($curview) $viewname($curview)
1879 set newviewperm
($curview) $viewperm($curview)
1880 set newviewargs
($curview) [shellarglist
$viewargs($curview)]
1881 vieweditor
$top $curview "Gitk: edit view $viewname($curview)"
1884 proc vieweditor
{top n title
} {
1885 global newviewname newviewperm viewfiles bgcolor
1888 wm title
$top $title
1889 label
$top.
nl -text [mc
"Name"]
1890 entry
$top.name
-width 20 -textvariable newviewname
($n)
1891 grid
$top.
nl $top.name
-sticky w
-pady 5
1892 checkbutton
$top.perm
-text [mc
"Remember this view"] \
1893 -variable newviewperm
($n)
1894 grid
$top.perm
- -pady 5 -sticky w
1895 message
$top.al
-aspect 1000 \
1896 -text [mc
"Commits to include (arguments to git rev-list):"]
1897 grid
$top.al
- -sticky w
-pady 5
1898 entry
$top.args
-width 50 -textvariable newviewargs
($n) \
1899 -background $bgcolor
1900 grid
$top.args
- -sticky ew
-padx 5
1901 message
$top.l
-aspect 1000 \
1902 -text [mc
"Enter files and directories to include, one per line:"]
1903 grid
$top.l
- -sticky w
1904 text
$top.t
-width 40 -height 10 -background $bgcolor -font uifont
1905 if {[info exists viewfiles
($n)]} {
1906 foreach f
$viewfiles($n) {
1907 $top.t insert end
$f
1908 $top.t insert end
"\n"
1910 $top.t delete
{end
- 1c
} end
1911 $top.t mark
set insert
0.0
1913 grid
$top.t
- -sticky ew
-padx 5
1915 button
$top.buts.ok
-text [mc
"OK"] -command [list newviewok
$top $n]
1916 button
$top.buts.can
-text [mc
"Cancel"] -command [list destroy
$top]
1917 grid
$top.buts.ok
$top.buts.can
1918 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
1919 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
1920 grid
$top.buts
- -pady 10 -sticky ew
1924 proc doviewmenu
{m first cmd op argv
} {
1925 set nmenu
[$m index end
]
1926 for {set i
$first} {$i <= $nmenu} {incr i
} {
1927 if {[$m entrycget
$i -command] eq
$cmd} {
1928 eval $m $op $i $argv
1934 proc allviewmenus
{n op args
} {
1937 doviewmenu .bar.view
5 [list showview
$n] $op $args
1938 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1941 proc newviewok
{top n
} {
1942 global nextviewnum newviewperm newviewname newishighlight
1943 global viewname viewfiles viewperm selectedview curview
1944 global viewargs newviewargs viewhlmenu
1947 set newargs
[shellsplit
$newviewargs($n)]
1949 error_popup
"[mc "Error
in commit selection arguments
:"] $err"
1955 foreach f
[split [$top.t get
0.0 end
] "\n"] {
1956 set ft
[string trim
$f]
1961 if {![info exists viewfiles
($n)]} {
1962 # creating a new view
1964 set viewname
($n) $newviewname($n)
1965 set viewperm
($n) $newviewperm($n)
1966 set viewfiles
($n) $files
1967 set viewargs
($n) $newargs
1969 if {!$newishighlight} {
1972 run addvhighlight
$n
1975 # editing an existing view
1976 set viewperm
($n) $newviewperm($n)
1977 if {$newviewname($n) ne
$viewname($n)} {
1978 set viewname
($n) $newviewname($n)
1979 doviewmenu .bar.view
5 [list showview
$n] \
1980 entryconf
[list
-label $viewname($n)]
1981 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1982 # entryconf [list -label $viewname($n) -value $viewname($n)]
1984 if {$files ne
$viewfiles($n) ||
$newargs ne
$viewargs($n)} {
1985 set viewfiles
($n) $files
1986 set viewargs
($n) $newargs
1987 if {$curview == $n} {
1992 catch
{destroy
$top}
1996 global curview viewdata viewperm hlview selectedhlview
1998 if {$curview == 0} return
1999 if {[info exists hlview
] && $hlview == $curview} {
2000 set selectedhlview
[mc
"None"]
2003 allviewmenus
$curview delete
2004 set viewdata
($curview) {}
2005 set viewperm
($curview) 0
2009 proc addviewmenu
{n
} {
2010 global viewname viewhlmenu
2012 .bar.view add radiobutton
-label $viewname($n) \
2013 -command [list showview
$n] -variable selectedview
-value $n
2014 #$viewhlmenu add radiobutton -label $viewname($n) \
2015 # -command [list addvhighlight $n] -variable selectedhlview
2018 proc flatten
{var
} {
2022 foreach i
[array names
$var] {
2023 lappend ret
$i [set $var\
($i\
)]
2028 proc unflatten
{var l
} {
2038 global curview viewdata viewfiles
2039 global displayorder parentlist rowidlist rowisopt rowfinal
2040 global colormap rowtextx commitrow nextcolor canvxmax
2041 global numcommits commitlisted
2042 global selectedline currentid canv canvy0
2044 global pending_select phase
2047 global selectedview selectfirst
2048 global vparentlist vdisporder vcmitlisted
2049 global hlview selectedhlview commitinterest
2051 if {$n == $curview} return
2053 if {[info exists selectedline
]} {
2054 set selid
$currentid
2055 set y
[yc
$selectedline]
2056 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2057 set span
[$canv yview
]
2058 set ytop
[expr {[lindex
$span 0] * $ymax}]
2059 set ybot
[expr {[lindex
$span 1] * $ymax}]
2060 if {$ytop < $y && $y < $ybot} {
2061 set yscreen
[expr {$y - $ytop}]
2063 set yscreen
[expr {($ybot - $ytop) / 2}]
2065 } elseif
{[info exists pending_select
]} {
2066 set selid
$pending_select
2067 unset pending_select
2071 if {$curview >= 0} {
2072 set vparentlist
($curview) $parentlist
2073 set vdisporder
($curview) $displayorder
2074 set vcmitlisted
($curview) $commitlisted
2076 ![info exists viewdata
($curview)] ||
2077 [lindex
$viewdata($curview) 0] ne
{}} {
2078 set viewdata
($curview) \
2079 [list
$phase $rowidlist $rowisopt $rowfinal]
2082 catch
{unset treediffs
}
2084 if {[info exists hlview
] && $hlview == $n} {
2086 set selectedhlview
[mc
"None"]
2088 catch
{unset commitinterest
}
2092 .bar.view entryconf
[mc
"Edit view..."] -state [expr {$n == 0?
"disabled": "normal"}]
2093 .bar.view entryconf
[mc
"Delete view"] -state [expr {$n == 0?
"disabled": "normal"}]
2096 if {![info exists viewdata
($n)]} {
2098 set pending_select
$selid
2105 set phase
[lindex
$v 0]
2106 set displayorder
$vdisporder($n)
2107 set parentlist
$vparentlist($n)
2108 set commitlisted
$vcmitlisted($n)
2109 set rowidlist
[lindex
$v 1]
2110 set rowisopt
[lindex
$v 2]
2111 set rowfinal
[lindex
$v 3]
2112 set numcommits
$commitidx($n)
2114 catch
{unset colormap
}
2115 catch
{unset rowtextx
}
2117 set canvxmax
[$canv cget
-width]
2124 if {$selid ne
{} && [info exists commitrow
($n,$selid)]} {
2125 set row
$commitrow($n,$selid)
2126 # try to get the selected row in the same position on the screen
2127 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2128 set ytop
[expr {[yc
$row] - $yscreen}]
2132 set yf
[expr {$ytop * 1.0 / $ymax}]
2134 allcanvs yview moveto
$yf
2138 } elseif
{$selid ne
{}} {
2139 set pending_select
$selid
2141 set row
[first_real_row
]
2142 if {$row < $numcommits} {
2149 if {$phase eq
"getcommits"} {
2150 show_status
[mc
"Reading commits..."]
2153 } elseif
{$numcommits == 0} {
2154 show_status
[mc
"No commits selected"]
2158 # Stuff relating to the highlighting facility
2160 proc ishighlighted
{row
} {
2161 global vhighlights fhighlights nhighlights rhighlights
2163 if {[info exists nhighlights
($row)] && $nhighlights($row) > 0} {
2164 return $nhighlights($row)
2166 if {[info exists vhighlights
($row)] && $vhighlights($row) > 0} {
2167 return $vhighlights($row)
2169 if {[info exists fhighlights
($row)] && $fhighlights($row) > 0} {
2170 return $fhighlights($row)
2172 if {[info exists rhighlights
($row)] && $rhighlights($row) > 0} {
2173 return $rhighlights($row)
2178 proc bolden
{row font
} {
2179 global canv linehtag selectedline boldrows
2181 lappend boldrows
$row
2182 $canv itemconf
$linehtag($row) -font $font
2183 if {[info exists selectedline
] && $row == $selectedline} {
2185 set t
[eval $canv create rect
[$canv bbox
$linehtag($row)] \
2186 -outline {{}} -tags secsel \
2187 -fill [$canv cget
-selectbackground]]
2192 proc bolden_name
{row font
} {
2193 global canv2 linentag selectedline boldnamerows
2195 lappend boldnamerows
$row
2196 $canv2 itemconf
$linentag($row) -font $font
2197 if {[info exists selectedline
] && $row == $selectedline} {
2198 $canv2 delete secsel
2199 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($row)] \
2200 -outline {{}} -tags secsel \
2201 -fill [$canv2 cget
-selectbackground]]
2210 foreach row
$boldrows {
2211 if {![ishighlighted
$row]} {
2212 bolden
$row mainfont
2214 lappend stillbold
$row
2217 set boldrows
$stillbold
2220 proc addvhighlight
{n
} {
2221 global hlview curview viewdata vhl_done vhighlights commitidx
2223 if {[info exists hlview
]} {
2227 if {$n != $curview && ![info exists viewdata
($n)]} {
2228 set viewdata
($n) [list getcommits
{{}} 0 0 0]
2229 set vparentlist
($n) {}
2230 set vdisporder
($n) {}
2231 set vcmitlisted
($n) {}
2234 set vhl_done
$commitidx($hlview)
2235 if {$vhl_done > 0} {
2240 proc delvhighlight
{} {
2241 global hlview vhighlights
2243 if {![info exists hlview
]} return
2245 catch
{unset vhighlights
}
2249 proc vhighlightmore
{} {
2250 global hlview vhl_done commitidx vhighlights
2251 global displayorder vdisporder curview
2253 set max
$commitidx($hlview)
2254 if {$hlview == $curview} {
2255 set disp
$displayorder
2257 set disp
$vdisporder($hlview)
2259 set vr
[visiblerows
]
2260 set r0
[lindex
$vr 0]
2261 set r1
[lindex
$vr 1]
2262 for {set i
$vhl_done} {$i < $max} {incr i
} {
2263 set id
[lindex
$disp $i]
2264 if {[info exists commitrow
($curview,$id)]} {
2265 set row
$commitrow($curview,$id)
2266 if {$r0 <= $row && $row <= $r1} {
2267 if {![highlighted
$row]} {
2268 bolden
$row mainfontbold
2270 set vhighlights
($row) 1
2277 proc askvhighlight
{row id
} {
2278 global hlview vhighlights commitrow iddrawn
2280 if {[info exists commitrow
($hlview,$id)]} {
2281 if {[info exists iddrawn
($id)] && ![ishighlighted
$row]} {
2282 bolden
$row mainfontbold
2284 set vhighlights
($row) 1
2286 set vhighlights
($row) 0
2290 proc hfiles_change
{} {
2291 global highlight_files filehighlight fhighlights fh_serial
2292 global highlight_paths gdttype
2294 if {[info exists filehighlight
]} {
2295 # delete previous highlights
2296 catch
{close
$filehighlight}
2298 catch
{unset fhighlights
}
2300 unhighlight_filelist
2302 set highlight_paths
{}
2303 after cancel do_file_hl
$fh_serial
2305 if {$highlight_files ne
{}} {
2306 after
300 do_file_hl
$fh_serial
2310 proc gdttype_change
{name ix op
} {
2311 global gdttype highlight_files findstring findpattern
2314 if {$findstring ne
{}} {
2315 if {$gdttype eq
[mc
"containing:"]} {
2316 if {$highlight_files ne
{}} {
2317 set highlight_files
{}
2322 if {$findpattern ne
{}} {
2326 set highlight_files
$findstring
2331 # enable/disable findtype/findloc menus too
2334 proc find_change
{name ix op
} {
2335 global gdttype findstring highlight_files
2338 if {$gdttype eq
[mc
"containing:"]} {
2341 if {$highlight_files ne
$findstring} {
2342 set highlight_files
$findstring
2349 proc findcom_change args
{
2350 global nhighlights boldnamerows
2351 global findpattern findtype findstring gdttype
2354 # delete previous highlights, if any
2355 foreach row
$boldnamerows {
2356 bolden_name
$row mainfont
2359 catch
{unset nhighlights
}
2362 if {$gdttype ne
[mc
"containing:"] ||
$findstring eq
{}} {
2364 } elseif
{$findtype eq
[mc
"Regexp"]} {
2365 set findpattern
$findstring
2367 set e
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2369 set findpattern
"*$e*"
2373 proc makepatterns
{l
} {
2376 set ee
[string map
{"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2377 if {[string index
$ee end
] eq
"/"} {
2387 proc do_file_hl
{serial
} {
2388 global highlight_files filehighlight highlight_paths gdttype fhl_list
2390 if {$gdttype eq
[mc
"touching paths:"]} {
2391 if {[catch
{set paths
[shellsplit
$highlight_files]}]} return
2392 set highlight_paths
[makepatterns
$paths]
2394 set gdtargs
[concat
-- $paths]
2395 } elseif
{$gdttype eq
[mc
"adding/removing string:"]} {
2396 set gdtargs
[list
"-S$highlight_files"]
2398 # must be "containing:", i.e. we're searching commit info
2401 set cmd
[concat | git diff-tree
-r -s --stdin $gdtargs]
2402 set filehighlight
[open
$cmd r
+]
2403 fconfigure
$filehighlight -blocking 0
2404 filerun
$filehighlight readfhighlight
2410 proc flushhighlights
{} {
2411 global filehighlight fhl_list
2413 if {[info exists filehighlight
]} {
2415 puts
$filehighlight ""
2416 flush
$filehighlight
2420 proc askfilehighlight
{row id
} {
2421 global filehighlight fhighlights fhl_list
2423 lappend fhl_list
$id
2424 set fhighlights
($row) -1
2425 puts
$filehighlight $id
2428 proc readfhighlight
{} {
2429 global filehighlight fhighlights commitrow curview iddrawn
2430 global fhl_list find_dirn
2432 if {![info exists filehighlight
]} {
2436 while {[incr nr
] <= 100 && [gets
$filehighlight line
] >= 0} {
2437 set line
[string trim
$line]
2438 set i
[lsearch
-exact $fhl_list $line]
2439 if {$i < 0} continue
2440 for {set j
0} {$j < $i} {incr j
} {
2441 set id
[lindex
$fhl_list $j]
2442 if {[info exists commitrow
($curview,$id)]} {
2443 set fhighlights
($commitrow($curview,$id)) 0
2446 set fhl_list
[lrange
$fhl_list [expr {$i+1}] end
]
2447 if {$line eq
{}} continue
2448 if {![info exists commitrow
($curview,$line)]} continue
2449 set row
$commitrow($curview,$line)
2450 if {[info exists iddrawn
($line)] && ![ishighlighted
$row]} {
2451 bolden
$row mainfontbold
2453 set fhighlights
($row) 1
2455 if {[eof
$filehighlight]} {
2457 puts
"oops, git diff-tree died"
2458 catch
{close
$filehighlight}
2462 if {[info exists find_dirn
]} {
2468 proc doesmatch
{f
} {
2469 global findtype findpattern
2471 if {$findtype eq
[mc
"Regexp"]} {
2472 return [regexp
$findpattern $f]
2473 } elseif
{$findtype eq
[mc
"IgnCase"]} {
2474 return [string match
-nocase $findpattern $f]
2476 return [string match
$findpattern $f]
2480 proc askfindhighlight
{row id
} {
2481 global nhighlights commitinfo iddrawn
2483 global markingmatches
2485 if {![info exists commitinfo
($id)]} {
2488 set info
$commitinfo($id)
2490 set fldtypes
[list
[mc Headline
] [mc Author
] [mc Date
] [mc Committer
] [mc CDate
] [mc Comments
]]
2491 foreach f
$info ty
$fldtypes {
2492 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
2494 if {$ty eq
[mc
"Author"]} {
2501 if {$isbold && [info exists iddrawn
($id)]} {
2502 if {![ishighlighted
$row]} {
2503 bolden
$row mainfontbold
2505 bolden_name
$row mainfontbold
2508 if {$markingmatches} {
2509 markrowmatches
$row $id
2512 set nhighlights
($row) $isbold
2515 proc markrowmatches
{row id
} {
2516 global canv canv2 linehtag linentag commitinfo findloc
2518 set headline
[lindex
$commitinfo($id) 0]
2519 set author
[lindex
$commitinfo($id) 1]
2520 $canv delete match
$row
2521 $canv2 delete match
$row
2522 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Headline"]} {
2523 set m
[findmatches
$headline]
2525 markmatches
$canv $row $headline $linehtag($row) $m \
2526 [$canv itemcget
$linehtag($row) -font] $row
2529 if {$findloc eq
[mc
"All fields"] ||
$findloc eq
[mc
"Author"]} {
2530 set m
[findmatches
$author]
2532 markmatches
$canv2 $row $author $linentag($row) $m \
2533 [$canv2 itemcget
$linentag($row) -font] $row
2538 proc vrel_change
{name ix op
} {
2539 global highlight_related
2542 if {$highlight_related ne
[mc
"None"]} {
2547 # prepare for testing whether commits are descendents or ancestors of a
2548 proc rhighlight_sel
{a
} {
2549 global descendent desc_todo ancestor anc_todo
2550 global highlight_related rhighlights
2552 catch
{unset descendent
}
2553 set desc_todo
[list
$a]
2554 catch
{unset ancestor
}
2555 set anc_todo
[list
$a]
2556 if {$highlight_related ne
[mc
"None"]} {
2562 proc rhighlight_none
{} {
2565 catch
{unset rhighlights
}
2569 proc is_descendent
{a
} {
2570 global curview children commitrow descendent desc_todo
2573 set la
$commitrow($v,$a)
2577 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2578 set do [lindex
$todo $i]
2579 if {$commitrow($v,$do) < $la} {
2580 lappend leftover
$do
2583 foreach nk
$children($v,$do) {
2584 if {![info exists descendent
($nk)]} {
2585 set descendent
($nk) 1
2593 set desc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2597 set descendent
($a) 0
2598 set desc_todo
$leftover
2601 proc is_ancestor
{a
} {
2602 global curview parentlist commitrow ancestor anc_todo
2605 set la
$commitrow($v,$a)
2609 for {set i
0} {$i < [llength
$todo]} {incr i
} {
2610 set do [lindex
$todo $i]
2611 if {![info exists commitrow
($v,$do)] ||
$commitrow($v,$do) > $la} {
2612 lappend leftover
$do
2615 foreach np
[lindex
$parentlist $commitrow($v,$do)] {
2616 if {![info exists ancestor
($np)]} {
2625 set anc_todo
[concat
$leftover [lrange
$todo [expr {$i+1}] end
]]
2630 set anc_todo
$leftover
2633 proc askrelhighlight
{row id
} {
2634 global descendent highlight_related iddrawn rhighlights
2635 global selectedline ancestor
2637 if {![info exists selectedline
]} return
2639 if {$highlight_related eq
[mc
"Descendant"] ||
2640 $highlight_related eq
[mc
"Not descendant"]} {
2641 if {![info exists descendent
($id)]} {
2644 if {$descendent($id) == ($highlight_related eq
[mc
"Descendant"])} {
2647 } elseif
{$highlight_related eq
[mc
"Ancestor"] ||
2648 $highlight_related eq
[mc
"Not ancestor"]} {
2649 if {![info exists ancestor
($id)]} {
2652 if {$ancestor($id) == ($highlight_related eq
[mc
"Ancestor"])} {
2656 if {[info exists iddrawn
($id)]} {
2657 if {$isbold && ![ishighlighted
$row]} {
2658 bolden
$row mainfontbold
2661 set rhighlights
($row) $isbold
2664 # Graph layout functions
2666 proc shortids
{ids
} {
2669 if {[llength
$id] > 1} {
2670 lappend res
[shortids
$id]
2671 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $id]} {
2672 lappend res
[string range
$id 0 7]
2683 for {set mask
1} {$mask <= $n} {incr mask
$mask} {
2684 if {($n & $mask) != 0} {
2685 set ret
[concat
$ret $o]
2687 set o
[concat
$o $o]
2692 # Work out where id should go in idlist so that order-token
2693 # values increase from left to right
2694 proc idcol
{idlist id
{i
0}} {
2695 global ordertok curview
2697 set t
$ordertok($curview,$id)
2698 if {$i >= [llength
$idlist] ||
2699 $t < $ordertok($curview,[lindex
$idlist $i])} {
2700 if {$i > [llength
$idlist]} {
2701 set i
[llength
$idlist]
2703 while {[incr i
-1] >= 0 &&
2704 $t < $ordertok($curview,[lindex
$idlist $i])} {}
2707 if {$t > $ordertok($curview,[lindex
$idlist $i])} {
2708 while {[incr i
] < [llength
$idlist] &&
2709 $t >= $ordertok($curview,[lindex
$idlist $i])} {}
2715 proc initlayout
{} {
2716 global rowidlist rowisopt rowfinal displayorder commitlisted
2717 global numcommits canvxmax canv
2720 global colormap rowtextx
2731 set canvxmax
[$canv cget
-width]
2732 catch
{unset colormap
}
2733 catch
{unset rowtextx
}
2737 proc setcanvscroll
{} {
2738 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2740 set ymax
[expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2741 $canv conf
-scrollregion [list
0 0 $canvxmax $ymax]
2742 $canv2 conf
-scrollregion [list
0 0 0 $ymax]
2743 $canv3 conf
-scrollregion [list
0 0 0 $ymax]
2746 proc visiblerows
{} {
2747 global canv numcommits linespc
2749 set ymax
[lindex
[$canv cget
-scrollregion] 3]
2750 if {$ymax eq
{} ||
$ymax == 0} return
2752 set y0
[expr {int
([lindex
$f 0] * $ymax)}]
2753 set r0
[expr {int
(($y0 - 3) / $linespc) - 1}]
2757 set y1
[expr {int
([lindex
$f 1] * $ymax)}]
2758 set r1
[expr {int
(($y1 - 3) / $linespc) + 1}]
2759 if {$r1 >= $numcommits} {
2760 set r1
[expr {$numcommits - 1}]
2762 return [list
$r0 $r1]
2765 proc layoutmore
{} {
2766 global commitidx viewcomplete numcommits
2767 global uparrowlen downarrowlen mingaplen curview
2769 set show
$commitidx($curview)
2770 if {$show > $numcommits ||
$viewcomplete($curview)} {
2771 showstuff
$show $viewcomplete($curview)
2775 proc showstuff
{canshow last
} {
2776 global numcommits commitrow pending_select selectedline curview
2777 global mainheadid displayorder selectfirst
2778 global lastscrollset commitinterest
2780 if {$numcommits == 0} {
2782 set phase
"incrdraw"
2786 set prev
$numcommits
2787 set numcommits
$canshow
2788 set t
[clock clicks
-milliseconds]
2789 if {$prev < 100 ||
$last ||
$t - $lastscrollset > 500} {
2790 set lastscrollset
$t
2793 set rows
[visiblerows
]
2794 set r1
[lindex
$rows 1]
2795 if {$r1 >= $canshow} {
2796 set r1
[expr {$canshow - 1}]
2801 if {[info exists pending_select
] &&
2802 [info exists commitrow
($curview,$pending_select)] &&
2803 $commitrow($curview,$pending_select) < $numcommits} {
2804 selectline
$commitrow($curview,$pending_select) 1
2807 if {[info exists selectedline
] ||
[info exists pending_select
]} {
2810 set l
[first_real_row
]
2817 proc doshowlocalchanges
{} {
2818 global curview mainheadid phase commitrow
2820 if {[info exists commitrow
($curview,$mainheadid)] &&
2821 ($phase eq
{} ||
$commitrow($curview,$mainheadid) < $numcommits - 1)} {
2823 } elseif
{$phase ne
{}} {
2824 lappend commitinterest
($mainheadid) {}
2828 proc dohidelocalchanges
{} {
2829 global localfrow localirow lserial
2831 if {$localfrow >= 0} {
2832 removerow
$localfrow
2834 if {$localirow > 0} {
2838 if {$localirow >= 0} {
2839 removerow
$localirow
2845 # spawn off a process to do git diff-index --cached HEAD
2846 proc dodiffindex
{} {
2847 global localirow localfrow lserial showlocalchanges
2849 if {!$showlocalchanges} return
2853 set fd
[open
"|git diff-index --cached HEAD" r
]
2854 fconfigure
$fd -blocking 0
2855 filerun
$fd [list readdiffindex
$fd $lserial]
2858 proc readdiffindex
{fd serial
} {
2859 global localirow commitrow mainheadid nullid2 curview
2860 global commitinfo commitdata lserial
2863 if {[gets
$fd line
] < 0} {
2869 # we only need to see one line and we don't really care what it says...
2872 # now see if there are any local changes not checked in to the index
2873 if {$serial == $lserial} {
2874 set fd
[open
"|git diff-files" r
]
2875 fconfigure
$fd -blocking 0
2876 filerun
$fd [list readdifffiles
$fd $serial]
2879 if {$isdiff && $serial == $lserial && $localirow == -1} {
2880 # add the line for the changes in the index to the graph
2881 set localirow
$commitrow($curview,$mainheadid)
2882 set hl
[mc
"Local changes checked in to index but not committed"]
2883 set commitinfo
($nullid2) [list
$hl {} {} {} {} " $hl\n"]
2884 set commitdata
($nullid2) "\n $hl\n"
2885 insertrow
$localirow $nullid2
2890 proc readdifffiles
{fd serial
} {
2891 global localirow localfrow commitrow mainheadid nullid curview
2892 global commitinfo commitdata lserial
2895 if {[gets
$fd line
] < 0} {
2901 # we only need to see one line and we don't really care what it says...
2904 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2905 # add the line for the local diff to the graph
2906 if {$localirow >= 0} {
2907 set localfrow
$localirow
2910 set localfrow
$commitrow($curview,$mainheadid)
2912 set hl
[mc
"Local uncommitted changes, not checked in to index"]
2913 set commitinfo
($nullid) [list
$hl {} {} {} {} " $hl\n"]
2914 set commitdata
($nullid) "\n $hl\n"
2915 insertrow
$localfrow $nullid
2920 proc nextuse
{id row
} {
2921 global commitrow curview children
2923 if {[info exists children
($curview,$id)]} {
2924 foreach kid
$children($curview,$id) {
2925 if {![info exists commitrow
($curview,$kid)]} {
2928 if {$commitrow($curview,$kid) > $row} {
2929 return $commitrow($curview,$kid)
2933 if {[info exists commitrow
($curview,$id)]} {
2934 return $commitrow($curview,$id)
2939 proc prevuse
{id row
} {
2940 global commitrow curview children
2943 if {[info exists children
($curview,$id)]} {
2944 foreach kid
$children($curview,$id) {
2945 if {![info exists commitrow
($curview,$kid)]} break
2946 if {$commitrow($curview,$kid) < $row} {
2947 set ret
$commitrow($curview,$kid)
2954 proc make_idlist
{row
} {
2955 global displayorder parentlist uparrowlen downarrowlen mingaplen
2956 global commitidx curview ordertok children commitrow
2958 set r
[expr {$row - $mingaplen - $downarrowlen - 1}]
2962 set ra
[expr {$row - $downarrowlen}]
2966 set rb
[expr {$row + $uparrowlen}]
2967 if {$rb > $commitidx($curview)} {
2968 set rb
$commitidx($curview)
2971 for {} {$r < $ra} {incr r
} {
2972 set nextid
[lindex
$displayorder [expr {$r + 1}]]
2973 foreach p
[lindex
$parentlist $r] {
2974 if {$p eq
$nextid} continue
2975 set rn
[nextuse
$p $r]
2977 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2978 lappend ids
[list
$ordertok($curview,$p) $p]
2982 for {} {$r < $row} {incr r
} {
2983 set nextid
[lindex
$displayorder [expr {$r + 1}]]
2984 foreach p
[lindex
$parentlist $r] {
2985 if {$p eq
$nextid} continue
2986 set rn
[nextuse
$p $r]
2987 if {$rn < 0 ||
$rn >= $row} {
2988 lappend ids
[list
$ordertok($curview,$p) $p]
2992 set id
[lindex
$displayorder $row]
2993 lappend ids
[list
$ordertok($curview,$id) $id]
2995 foreach p
[lindex
$parentlist $r] {
2996 set firstkid
[lindex
$children($curview,$p) 0]
2997 if {$commitrow($curview,$firstkid) < $row} {
2998 lappend ids
[list
$ordertok($curview,$p) $p]
3002 set id
[lindex
$displayorder $r]
3004 set firstkid
[lindex
$children($curview,$id) 0]
3005 if {$firstkid ne
{} && $commitrow($curview,$firstkid) < $row} {
3006 lappend ids
[list
$ordertok($curview,$id) $id]
3011 foreach idx
[lsort
-unique $ids] {
3012 lappend idlist
[lindex
$idx 1]
3017 proc rowsequal
{a b
} {
3018 while {[set i
[lsearch
-exact $a {}]] >= 0} {
3019 set a
[lreplace
$a $i $i]
3021 while {[set i
[lsearch
-exact $b {}]] >= 0} {
3022 set b
[lreplace
$b $i $i]
3024 return [expr {$a eq
$b}]
3027 proc makeupline
{id row rend
col} {
3028 global rowidlist uparrowlen downarrowlen mingaplen
3030 for {set r
$rend} {1} {set r
$rstart} {
3031 set rstart
[prevuse
$id $r]
3032 if {$rstart < 0} return
3033 if {$rstart < $row} break
3035 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3036 set rstart
[expr {$rend - $uparrowlen - 1}]
3038 for {set r
$rstart} {[incr r
] <= $row} {} {
3039 set idlist
[lindex
$rowidlist $r]
3040 if {$idlist ne
{} && [lsearch
-exact $idlist $id] < 0} {
3041 set col [idcol
$idlist $id $col]
3042 lset rowidlist
$r [linsert
$idlist $col $id]
3048 proc layoutrows
{row endrow
} {
3049 global rowidlist rowisopt rowfinal displayorder
3050 global uparrowlen downarrowlen maxwidth mingaplen
3051 global children parentlist
3052 global commitidx viewcomplete curview commitrow
3056 set rm1
[expr {$row - 1}]
3057 foreach id
[lindex
$rowidlist $rm1] {
3062 set final
[lindex
$rowfinal $rm1]
3064 for {} {$row < $endrow} {incr row
} {
3065 set rm1
[expr {$row - 1}]
3066 if {$rm1 < 0 ||
$idlist eq
{}} {
3067 set idlist
[make_idlist
$row]
3070 set id
[lindex
$displayorder $rm1]
3071 set col [lsearch
-exact $idlist $id]
3072 set idlist
[lreplace
$idlist $col $col]
3073 foreach p
[lindex
$parentlist $rm1] {
3074 if {[lsearch
-exact $idlist $p] < 0} {
3075 set col [idcol
$idlist $p $col]
3076 set idlist
[linsert
$idlist $col $p]
3077 # if not the first child, we have to insert a line going up
3078 if {$id ne
[lindex
$children($curview,$p) 0]} {
3079 makeupline
$p $rm1 $row $col
3083 set id
[lindex
$displayorder $row]
3084 if {$row > $downarrowlen} {
3085 set termrow
[expr {$row - $downarrowlen - 1}]
3086 foreach p
[lindex
$parentlist $termrow] {
3087 set i
[lsearch
-exact $idlist $p]
3088 if {$i < 0} continue
3089 set nr
[nextuse
$p $termrow]
3090 if {$nr < 0 ||
$nr >= $row + $mingaplen + $uparrowlen} {
3091 set idlist
[lreplace
$idlist $i $i]
3095 set col [lsearch
-exact $idlist $id]
3097 set col [idcol
$idlist $id]
3098 set idlist
[linsert
$idlist $col $id]
3099 if {$children($curview,$id) ne
{}} {
3100 makeupline
$id $rm1 $row $col
3103 set r
[expr {$row + $uparrowlen - 1}]
3104 if {$r < $commitidx($curview)} {
3106 foreach p
[lindex
$parentlist $r] {
3107 if {[lsearch
-exact $idlist $p] >= 0} continue
3108 set fk
[lindex
$children($curview,$p) 0]
3109 if {$commitrow($curview,$fk) < $row} {
3110 set x
[idcol
$idlist $p $x]
3111 set idlist
[linsert
$idlist $x $p]
3114 if {[incr r
] < $commitidx($curview)} {
3115 set p
[lindex
$displayorder $r]
3116 if {[lsearch
-exact $idlist $p] < 0} {
3117 set fk
[lindex
$children($curview,$p) 0]
3118 if {$fk ne
{} && $commitrow($curview,$fk) < $row} {
3119 set x
[idcol
$idlist $p $x]
3120 set idlist
[linsert
$idlist $x $p]
3126 if {$final && !$viewcomplete($curview) &&
3127 $row + $uparrowlen + $mingaplen + $downarrowlen
3128 >= $commitidx($curview)} {
3131 set l
[llength
$rowidlist]
3133 lappend rowidlist
$idlist
3135 lappend rowfinal
$final
3136 } elseif
{$row < $l} {
3137 if {![rowsequal
$idlist [lindex
$rowidlist $row]]} {
3138 lset rowidlist
$row $idlist
3141 lset rowfinal
$row $final
3143 set pad
[ntimes
[expr {$row - $l}] {}]
3144 set rowidlist
[concat
$rowidlist $pad]
3145 lappend rowidlist
$idlist
3146 set rowfinal
[concat
$rowfinal $pad]
3147 lappend rowfinal
$final
3148 set rowisopt
[concat
$rowisopt [ntimes
[expr {$row - $l + 1}] 0]]
3154 proc changedrow
{row
} {
3155 global displayorder iddrawn rowisopt need_redisplay
3157 set l
[llength
$rowisopt]
3159 lset rowisopt
$row 0
3160 if {$row + 1 < $l} {
3161 lset rowisopt
[expr {$row + 1}] 0
3162 if {$row + 2 < $l} {
3163 lset rowisopt
[expr {$row + 2}] 0
3167 set id
[lindex
$displayorder $row]
3168 if {[info exists iddrawn
($id)]} {
3169 set need_redisplay
1
3173 proc insert_pad
{row
col npad
} {
3176 set pad
[ntimes
$npad {}]
3177 set idlist
[lindex
$rowidlist $row]
3178 set bef
[lrange
$idlist 0 [expr {$col - 1}]]
3179 set aft
[lrange
$idlist $col end
]
3180 set i
[lsearch
-exact $aft {}]
3182 set aft
[lreplace
$aft $i $i]
3184 lset rowidlist
$row [concat
$bef $pad $aft]
3188 proc optimize_rows
{row
col endrow
} {
3189 global rowidlist rowisopt displayorder curview children
3194 for {} {$row < $endrow} {incr row
; set col 0} {
3195 if {[lindex
$rowisopt $row]} continue
3197 set y0
[expr {$row - 1}]
3198 set ym
[expr {$row - 2}]
3199 set idlist
[lindex
$rowidlist $row]
3200 set previdlist
[lindex
$rowidlist $y0]
3201 if {$idlist eq
{} ||
$previdlist eq
{}} continue
3203 set pprevidlist
[lindex
$rowidlist $ym]
3204 if {$pprevidlist eq
{}} continue
3210 for {} {$col < [llength
$idlist]} {incr
col} {
3211 set id
[lindex
$idlist $col]
3212 if {[lindex
$previdlist $col] eq
$id} continue
3217 set x0
[lsearch
-exact $previdlist $id]
3218 if {$x0 < 0} continue
3219 set z
[expr {$x0 - $col}]
3223 set xm
[lsearch
-exact $pprevidlist $id]
3225 set z0
[expr {$xm - $x0}]
3229 # if row y0 is the first child of $id then it's not an arrow
3230 if {[lindex
$children($curview,$id) 0] ne
3231 [lindex
$displayorder $y0]} {
3235 if {!$isarrow && $id ne
[lindex
$displayorder $row] &&
3236 [lsearch
-exact [lindex
$rowidlist [expr {$row+1}]] $id] < 0} {
3239 # Looking at lines from this row to the previous row,
3240 # make them go straight up if they end in an arrow on
3241 # the previous row; otherwise make them go straight up
3243 if {$z < -1 ||
($z < 0 && $isarrow)} {
3244 # Line currently goes left too much;
3245 # insert pads in the previous row, then optimize it
3246 set npad
[expr {-1 - $z + $isarrow}]
3247 insert_pad
$y0 $x0 $npad
3249 optimize_rows
$y0 $x0 $row
3251 set previdlist
[lindex
$rowidlist $y0]
3252 set x0
[lsearch
-exact $previdlist $id]
3253 set z
[expr {$x0 - $col}]
3255 set pprevidlist
[lindex
$rowidlist $ym]
3256 set xm
[lsearch
-exact $pprevidlist $id]
3257 set z0
[expr {$xm - $x0}]
3259 } elseif
{$z > 1 ||
($z > 0 && $isarrow)} {
3260 # Line currently goes right too much;
3261 # insert pads in this line
3262 set npad
[expr {$z - 1 + $isarrow}]
3263 insert_pad
$row $col $npad
3264 set idlist
[lindex
$rowidlist $row]
3266 set z
[expr {$x0 - $col}]
3269 if {$z0 eq
{} && !$isarrow && $ym >= 0} {
3270 # this line links to its first child on row $row-2
3271 set id
[lindex
$displayorder $ym]
3272 set xc
[lsearch
-exact $pprevidlist $id]
3274 set z0
[expr {$xc - $x0}]
3277 # avoid lines jigging left then immediately right
3278 if {$z0 ne
{} && $z < 0 && $z0 > 0} {
3279 insert_pad
$y0 $x0 1
3281 optimize_rows
$y0 $x0 $row
3282 set previdlist
[lindex
$rowidlist $y0]
3286 # Find the first column that doesn't have a line going right
3287 for {set col [llength
$idlist]} {[incr
col -1] >= 0} {} {
3288 set id
[lindex
$idlist $col]
3289 if {$id eq
{}} break
3290 set x0
[lsearch
-exact $previdlist $id]
3292 # check if this is the link to the first child
3293 set kid
[lindex
$displayorder $y0]
3294 if {[lindex
$children($curview,$id) 0] eq
$kid} {
3295 # it is, work out offset to child
3296 set x0
[lsearch
-exact $previdlist $kid]
3299 if {$x0 <= $col} break
3301 # Insert a pad at that column as long as it has a line and
3302 # isn't the last column
3303 if {$x0 >= 0 && [incr
col] < [llength
$idlist]} {
3304 set idlist
[linsert
$idlist $col {}]
3305 lset rowidlist
$row $idlist
3313 global canvx0 linespc
3314 return [expr {$canvx0 + $col * $linespc}]
3318 global canvy0 linespc
3319 return [expr {$canvy0 + $row * $linespc}]
3322 proc linewidth
{id
} {
3323 global thickerline lthickness
3326 if {[info exists thickerline
] && $id eq
$thickerline} {
3327 set wid
[expr {2 * $lthickness}]
3332 proc rowranges
{id
} {
3333 global commitrow curview children uparrowlen downarrowlen
3336 set kids
$children($curview,$id)
3342 foreach child
$kids {
3343 if {![info exists commitrow
($curview,$child)]} break
3344 set row
$commitrow($curview,$child)
3345 if {![info exists prev
]} {
3346 lappend ret
[expr {$row + 1}]
3348 if {$row <= $prevrow} {
3349 puts
"oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3351 # see if the line extends the whole way from prevrow to row
3352 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3353 [lsearch
-exact [lindex
$rowidlist \
3354 [expr {int
(($row + $prevrow) / 2)}]] $id] < 0} {
3355 # it doesn't, see where it ends
3356 set r
[expr {$prevrow + $downarrowlen}]
3357 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3358 while {[incr r
-1] > $prevrow &&
3359 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3361 while {[incr r
] <= $row &&
3362 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3366 # see where it starts up again
3367 set r
[expr {$row - $uparrowlen}]
3368 if {[lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {
3369 while {[incr r
] < $row &&
3370 [lsearch
-exact [lindex
$rowidlist $r] $id] < 0} {}
3372 while {[incr r
-1] >= $prevrow &&
3373 [lsearch
-exact [lindex
$rowidlist $r] $id] >= 0} {}
3379 if {$child eq
$id} {
3388 proc drawlineseg
{id row endrow arrowlow
} {
3389 global rowidlist displayorder iddrawn linesegs
3390 global canv colormap linespc curview maxlinelen parentlist
3392 set cols
[list
[lsearch
-exact [lindex
$rowidlist $row] $id]]
3393 set le
[expr {$row + 1}]
3396 set c
[lsearch
-exact [lindex
$rowidlist $le] $id]
3402 set x
[lindex
$displayorder $le]
3407 if {[info exists iddrawn
($x)] ||
$le == $endrow} {
3408 set c
[lsearch
-exact [lindex
$rowidlist [expr {$le+1}]] $id]
3424 if {[info exists linesegs
($id)]} {
3425 set lines
$linesegs($id)
3427 set r0
[lindex
$li 0]
3429 if {$r0 == $le && [lindex
$li 1] - $row <= $maxlinelen} {
3439 set li
[lindex
$lines [expr {$i-1}]]
3440 set r1
[lindex
$li 1]
3441 if {$r1 == $row && $le - [lindex
$li 0] <= $maxlinelen} {
3446 set x
[lindex
$cols [expr {$le - $row}]]
3447 set xp
[lindex
$cols [expr {$le - 1 - $row}]]
3448 set dir
[expr {$xp - $x}]
3450 set ith
[lindex
$lines $i 2]
3451 set coords
[$canv coords
$ith]
3452 set ah
[$canv itemcget
$ith -arrow]
3453 set arrowhigh
[expr {$ah eq
"first" ||
$ah eq
"both"}]
3454 set x2
[lindex
$cols [expr {$le + 1 - $row}]]
3455 if {$x2 ne
{} && $x - $x2 == $dir} {
3456 set coords
[lrange
$coords 0 end-2
]
3459 set coords
[list
[xc
$le $x] [yc
$le]]
3462 set itl
[lindex
$lines [expr {$i-1}] 2]
3463 set al
[$canv itemcget
$itl -arrow]
3464 set arrowlow
[expr {$al eq
"last" ||
$al eq
"both"}]
3465 } elseif
{$arrowlow} {
3466 if {[lsearch
-exact [lindex
$rowidlist [expr {$row-1}]] $id] >= 0 ||
3467 [lsearch
-exact [lindex
$parentlist [expr {$row-1}]] $id] >= 0} {
3471 set arrow
[lindex
{none first last both
} [expr {$arrowhigh + 2*$arrowlow}]]
3472 for {set y
$le} {[incr y
-1] > $row} {} {
3474 set xp
[lindex
$cols [expr {$y - 1 - $row}]]
3475 set ndir
[expr {$xp - $x}]
3476 if {$dir != $ndir ||
$xp < 0} {
3477 lappend coords
[xc
$y $x] [yc
$y]
3483 # join parent line to first child
3484 set ch
[lindex
$displayorder $row]
3485 set xc
[lsearch
-exact [lindex
$rowidlist $row] $ch]
3487 puts
"oops: drawlineseg: child $ch not on row $row"
3488 } elseif
{$xc != $x} {
3489 if {($arrowhigh && $le == $row + 1) ||
$dir == 0} {
3490 set d
[expr {int
(0.5 * $linespc)}]
3493 set x2
[expr {$x1 - $d}]
3495 set x2
[expr {$x1 + $d}]
3498 set y1
[expr {$y2 + $d}]
3499 lappend coords
$x1 $y1 $x2 $y2
3500 } elseif
{$xc < $x - 1} {
3501 lappend coords
[xc
$row [expr {$x-1}]] [yc
$row]
3502 } elseif
{$xc > $x + 1} {
3503 lappend coords
[xc
$row [expr {$x+1}]] [yc
$row]
3507 lappend coords
[xc
$row $x] [yc
$row]
3509 set xn
[xc
$row $xp]
3511 lappend coords
$xn $yn
3515 set t
[$canv create line
$coords -width [linewidth
$id] \
3516 -fill $colormap($id) -tags lines.
$id -arrow $arrow]
3519 set lines
[linsert
$lines $i [list
$row $le $t]]
3521 $canv coords
$ith $coords
3522 if {$arrow ne
$ah} {
3523 $canv itemconf
$ith -arrow $arrow
3525 lset lines
$i 0 $row
3528 set xo
[lsearch
-exact [lindex
$rowidlist [expr {$row - 1}]] $id]
3529 set ndir
[expr {$xo - $xp}]
3530 set clow
[$canv coords
$itl]
3531 if {$dir == $ndir} {
3532 set clow
[lrange
$clow 2 end
]
3534 set coords
[concat
$coords $clow]
3536 lset lines
[expr {$i-1}] 1 $le
3538 # coalesce two pieces
3540 set b
[lindex
$lines [expr {$i-1}] 0]
3541 set e
[lindex
$lines $i 1]
3542 set lines
[lreplace
$lines [expr {$i-1}] $i [list
$b $e $itl]]
3544 $canv coords
$itl $coords
3545 if {$arrow ne
$al} {
3546 $canv itemconf
$itl -arrow $arrow
3550 set linesegs
($id) $lines
3554 proc drawparentlinks
{id row
} {
3555 global rowidlist canv colormap curview parentlist
3556 global idpos linespc
3558 set rowids
[lindex
$rowidlist $row]
3559 set col [lsearch
-exact $rowids $id]
3560 if {$col < 0} return
3561 set olds
[lindex
$parentlist $row]
3562 set row2
[expr {$row + 1}]
3563 set x
[xc
$row $col]
3566 set d
[expr {int
(0.5 * $linespc)}]
3567 set ymid
[expr {$y + $d}]
3568 set ids
[lindex
$rowidlist $row2]
3569 # rmx = right-most X coord used
3572 set i
[lsearch
-exact $ids $p]
3574 puts
"oops, parent $p of $id not in list"
3577 set x2
[xc
$row2 $i]
3581 set j
[lsearch
-exact $rowids $p]
3583 # drawlineseg will do this one for us
3587 # should handle duplicated parents here...
3588 set coords
[list
$x $y]
3590 # if attaching to a vertical segment, draw a smaller
3591 # slant for visual distinctness
3594 lappend coords
[expr {$x2 + $d}] $y $x2 $ymid
3596 lappend coords
[expr {$x2 - $d}] $y $x2 $ymid
3598 } elseif
{$i < $col && $i < $j} {
3599 # segment slants towards us already
3600 lappend coords
[xc
$row $j] $y
3602 if {$i < $col - 1} {
3603 lappend coords
[expr {$x2 + $linespc}] $y
3604 } elseif
{$i > $col + 1} {
3605 lappend coords
[expr {$x2 - $linespc}] $y
3607 lappend coords
$x2 $y2
3610 lappend coords
$x2 $y2
3612 set t
[$canv create line
$coords -width [linewidth
$p] \
3613 -fill $colormap($p) -tags lines.
$p]
3617 if {$rmx > [lindex
$idpos($id) 1]} {
3618 lset idpos
($id) 1 $rmx
3623 proc drawlines
{id
} {
3626 $canv itemconf lines.
$id -width [linewidth
$id]
3629 proc drawcmittext
{id row
col} {
3630 global linespc canv canv2 canv3 canvy0 fgcolor curview
3631 global commitlisted commitinfo rowidlist parentlist
3632 global rowtextx idpos idtags idheads idotherrefs
3633 global linehtag linentag linedtag selectedline
3634 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3636 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3637 set listed
[lindex
$commitlisted $row]
3638 if {$id eq
$nullid} {
3640 } elseif
{$id eq
$nullid2} {
3643 set ofill
[expr {$listed != 0 ?
$listed == 2 ?
"gray" : "blue" : "white"}]
3645 set x
[xc
$row $col]
3647 set orad
[expr {$linespc / 3}]
3649 set t
[$canv create oval
[expr {$x - $orad}] [expr {$y - $orad}] \
3650 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3651 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3652 } elseif
{$listed == 3} {
3653 # triangle pointing left for left-side commits
3654 set t
[$canv create polygon \
3655 [expr {$x - $orad}] $y \
3656 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3657 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3658 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3660 # triangle pointing right for right-side commits
3661 set t
[$canv create polygon \
3662 [expr {$x + $orad - 1}] $y \
3663 [expr {$x - $orad}] [expr {$y - $orad}] \
3664 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3665 -fill $ofill -outline $fgcolor -width 1 -tags circle
]
3668 $canv bind $t <1> {selcanvline
{} %x
%y
}
3669 set rmx
[llength
[lindex
$rowidlist $row]]
3670 set olds
[lindex
$parentlist $row]
3672 set nextids
[lindex
$rowidlist [expr {$row + 1}]]
3674 set i
[lsearch
-exact $nextids $p]
3680 set xt
[xc
$row $rmx]
3681 set rowtextx
($row) $xt
3682 set idpos
($id) [list
$x $xt $y]
3683 if {[info exists idtags
($id)] ||
[info exists idheads
($id)]
3684 ||
[info exists idotherrefs
($id)]} {
3685 set xt
[drawtags
$id $x $xt $y]
3687 set headline
[lindex
$commitinfo($id) 0]
3688 set name
[lindex
$commitinfo($id) 1]
3689 set date [lindex
$commitinfo($id) 2]
3690 set date [formatdate
$date]
3693 set isbold
[ishighlighted
$row]
3695 lappend boldrows
$row
3696 set font mainfontbold
3698 lappend boldnamerows
$row
3699 set nfont mainfontbold
3702 set linehtag
($row) [$canv create text
$xt $y -anchor w
-fill $fgcolor \
3703 -text $headline -font $font -tags text
]
3704 $canv bind $linehtag($row) <Button-3
> "rowmenu %X %Y $id"
3705 set linentag
($row) [$canv2 create text
3 $y -anchor w
-fill $fgcolor \
3706 -text $name -font $nfont -tags text
]
3707 set linedtag
($row) [$canv3 create text
3 $y -anchor w
-fill $fgcolor \
3708 -text $date -font mainfont
-tags text
]
3709 if {[info exists selectedline
] && $selectedline == $row} {
3712 set xr
[expr {$xt + [font measure
$font $headline]}]
3713 if {$xr > $canvxmax} {
3719 proc drawcmitrow
{row
} {
3720 global displayorder rowidlist nrows_drawn
3721 global iddrawn markingmatches
3722 global commitinfo parentlist numcommits
3723 global filehighlight fhighlights findpattern nhighlights
3724 global hlview vhighlights
3725 global highlight_related rhighlights
3727 if {$row >= $numcommits} return
3729 set id
[lindex
$displayorder $row]
3730 if {[info exists hlview
] && ![info exists vhighlights
($row)]} {
3731 askvhighlight
$row $id
3733 if {[info exists filehighlight
] && ![info exists fhighlights
($row)]} {
3734 askfilehighlight
$row $id
3736 if {$findpattern ne
{} && ![info exists nhighlights
($row)]} {
3737 askfindhighlight
$row $id
3739 if {$highlight_related ne
[mc
"None"] && ![info exists rhighlights
($row)]} {
3740 askrelhighlight
$row $id
3742 if {![info exists iddrawn
($id)]} {
3743 set col [lsearch
-exact [lindex
$rowidlist $row] $id]
3745 puts
"oops, row $row id $id not in list"
3748 if {![info exists commitinfo
($id)]} {
3752 drawcmittext
$id $row $col
3756 if {$markingmatches} {
3757 markrowmatches
$row $id
3761 proc drawcommits
{row
{endrow
{}}} {
3762 global numcommits iddrawn displayorder curview need_redisplay
3763 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3768 if {$endrow eq
{}} {
3771 if {$endrow >= $numcommits} {
3772 set endrow
[expr {$numcommits - 1}]
3775 set rl1
[expr {$row - $downarrowlen - 3}]
3779 set ro1
[expr {$row - 3}]
3783 set r2
[expr {$endrow + $uparrowlen + 3}]
3784 if {$r2 > $numcommits} {
3787 for {set r
$rl1} {$r < $r2} {incr r
} {
3788 if {[lindex
$rowidlist $r] ne
{} && [lindex
$rowfinal $r]} {
3792 set rl1
[expr {$r + 1}]
3798 optimize_rows
$ro1 0 $r2
3799 if {$need_redisplay ||
$nrows_drawn > 2000} {
3804 # make the lines join to already-drawn rows either side
3805 set r
[expr {$row - 1}]
3806 if {$r < 0 ||
![info exists iddrawn
([lindex
$displayorder $r])]} {
3809 set er
[expr {$endrow + 1}]
3810 if {$er >= $numcommits ||
3811 ![info exists iddrawn
([lindex
$displayorder $er])]} {
3814 for {} {$r <= $er} {incr r
} {
3815 set id
[lindex
$displayorder $r]
3816 set wasdrawn
[info exists iddrawn
($id)]
3818 if {$r == $er} break
3819 set nextid
[lindex
$displayorder [expr {$r + 1}]]
3820 if {$wasdrawn && [info exists iddrawn
($nextid)]} continue
3821 drawparentlinks
$id $r
3823 set rowids
[lindex
$rowidlist $r]
3824 foreach lid
$rowids {
3825 if {$lid eq
{}} continue
3826 if {[info exists lineend
($lid)] && $lineend($lid) > $r} continue
3828 # see if this is the first child of any of its parents
3829 foreach p
[lindex
$parentlist $r] {
3830 if {[lsearch
-exact $rowids $p] < 0} {
3831 # make this line extend up to the child
3832 set lineend
($p) [drawlineseg
$p $r $er 0]
3836 set lineend
($lid) [drawlineseg
$lid $r $er 1]
3842 proc drawfrac
{f0 f1
} {
3845 set ymax
[lindex
[$canv cget
-scrollregion] 3]
3846 if {$ymax eq
{} ||
$ymax == 0} return
3847 set y0
[expr {int
($f0 * $ymax)}]
3848 set row
[expr {int
(($y0 - 3) / $linespc) - 1}]
3849 set y1
[expr {int
($f1 * $ymax)}]
3850 set endrow
[expr {int
(($y1 - 3) / $linespc) + 1}]
3851 drawcommits
$row $endrow
3854 proc drawvisible
{} {
3856 eval drawfrac
[$canv yview
]
3859 proc clear_display
{} {
3860 global iddrawn linesegs need_redisplay nrows_drawn
3861 global vhighlights fhighlights nhighlights rhighlights
3864 catch
{unset iddrawn
}
3865 catch
{unset linesegs
}
3866 catch
{unset vhighlights
}
3867 catch
{unset fhighlights
}
3868 catch
{unset nhighlights
}
3869 catch
{unset rhighlights
}
3870 set need_redisplay
0
3874 proc findcrossings
{id
} {
3875 global rowidlist parentlist numcommits displayorder
3879 foreach
{s e
} [rowranges
$id] {
3880 if {$e >= $numcommits} {
3881 set e
[expr {$numcommits - 1}]
3883 if {$e <= $s} continue
3884 for {set row
$e} {[incr row
-1] >= $s} {} {
3885 set x
[lsearch
-exact [lindex
$rowidlist $row] $id]
3887 set olds
[lindex
$parentlist $row]
3888 set kid
[lindex
$displayorder $row]
3889 set kidx
[lsearch
-exact [lindex
$rowidlist $row] $kid]
3890 if {$kidx < 0} continue
3891 set nextrow
[lindex
$rowidlist [expr {$row + 1}]]
3893 set px
[lsearch
-exact $nextrow $p]
3894 if {$px < 0} continue
3895 if {($kidx < $x && $x < $px) ||
($px < $x && $x < $kidx)} {
3896 if {[lsearch
-exact $ccross $p] >= 0} continue
3897 if {$x == $px + ($kidx < $px?
-1: 1)} {
3899 } elseif
{[lsearch
-exact $cross $p] < 0} {
3906 return [concat
$ccross {{}} $cross]
3909 proc assigncolor
{id
} {
3910 global colormap colors nextcolor
3911 global commitrow parentlist children children curview
3913 if {[info exists colormap
($id)]} return
3914 set ncolors
[llength
$colors]
3915 if {[info exists children
($curview,$id)]} {
3916 set kids
$children($curview,$id)
3920 if {[llength
$kids] == 1} {
3921 set child
[lindex
$kids 0]
3922 if {[info exists colormap
($child)]
3923 && [llength
[lindex
$parentlist $commitrow($curview,$child)]] == 1} {
3924 set colormap
($id) $colormap($child)
3930 foreach x
[findcrossings
$id] {
3932 # delimiter between corner crossings and other crossings
3933 if {[llength
$badcolors] >= $ncolors - 1} break
3934 set origbad
$badcolors
3936 if {[info exists colormap
($x)]
3937 && [lsearch
-exact $badcolors $colormap($x)] < 0} {
3938 lappend badcolors
$colormap($x)
3941 if {[llength
$badcolors] >= $ncolors} {
3942 set badcolors
$origbad
3944 set origbad
$badcolors
3945 if {[llength
$badcolors] < $ncolors - 1} {
3946 foreach child
$kids {
3947 if {[info exists colormap
($child)]
3948 && [lsearch
-exact $badcolors $colormap($child)] < 0} {
3949 lappend badcolors
$colormap($child)
3951 foreach p
[lindex
$parentlist $commitrow($curview,$child)] {
3952 if {[info exists colormap
($p)]
3953 && [lsearch
-exact $badcolors $colormap($p)] < 0} {
3954 lappend badcolors
$colormap($p)
3958 if {[llength
$badcolors] >= $ncolors} {
3959 set badcolors
$origbad
3962 for {set i
0} {$i <= $ncolors} {incr i
} {
3963 set c
[lindex
$colors $nextcolor]
3964 if {[incr nextcolor
] >= $ncolors} {
3967 if {[lsearch
-exact $badcolors $c]} break
3969 set colormap
($id) $c
3972 proc bindline
{t id
} {
3975 $canv bind $t <Enter
> "lineenter %x %y $id"
3976 $canv bind $t <Motion
> "linemotion %x %y $id"
3977 $canv bind $t <Leave
> "lineleave $id"
3978 $canv bind $t <Button-1
> "lineclick %x %y $id 1"
3981 proc drawtags
{id x xt y1
} {
3982 global idtags idheads idotherrefs mainhead
3983 global linespc lthickness
3984 global canv commitrow rowtextx curview fgcolor bgcolor
3989 if {[info exists idtags
($id)]} {
3990 set marks
$idtags($id)
3991 set ntags
[llength
$marks]
3993 if {[info exists idheads
($id)]} {
3994 set marks
[concat
$marks $idheads($id)]
3995 set nheads
[llength
$idheads($id)]
3997 if {[info exists idotherrefs
($id)]} {
3998 set marks
[concat
$marks $idotherrefs($id)]
4004 set delta
[expr {int
(0.5 * ($linespc - $lthickness))}]
4005 set yt
[expr {$y1 - 0.5 * $linespc}]
4006 set yb
[expr {$yt + $linespc - 1}]
4010 foreach tag
$marks {
4012 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq
$mainhead} {
4013 set wid
[font measure mainfontbold
$tag]
4015 set wid
[font measure mainfont
$tag]
4019 set xt
[expr {$xt + $delta + $wid + $lthickness + $linespc}]
4021 set t
[$canv create line
$x $y1 [lindex
$xvals end
] $y1 \
4022 -width $lthickness -fill black
-tags tag.
$id]
4024 foreach tag
$marks x
$xvals wid
$wvals {
4025 set xl
[expr {$x + $delta}]
4026 set xr
[expr {$x + $delta + $wid + $lthickness}]
4028 if {[incr ntags
-1] >= 0} {
4030 set t
[$canv create polygon
$x [expr {$yt + $delta}] $xl $yt \
4031 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4032 -width 1 -outline black
-fill yellow
-tags tag.
$id]
4033 $canv bind $t <1> [list showtag
$tag 1]
4034 set rowtextx
($commitrow($curview,$id)) [expr {$xr + $linespc}]
4036 # draw a head or other ref
4037 if {[incr nheads
-1] >= 0} {
4039 if {$tag eq
$mainhead} {
4040 set font mainfontbold
4045 set xl
[expr {$xl - $delta/2}]
4046 $canv create polygon
$x $yt $xr $yt $xr $yb $x $yb \
4047 -width 1 -outline black
-fill $col -tags tag.
$id
4048 if {[regexp
{^
(remotes
/.
*/|remotes
/)} $tag match remoteprefix
]} {
4049 set rwid
[font measure mainfont
$remoteprefix]
4050 set xi
[expr {$x + 1}]
4051 set yti
[expr {$yt + 1}]
4052 set xri
[expr {$x + $rwid}]
4053 $canv create polygon
$xi $yti $xri $yti $xri $yb $xi $yb \
4054 -width 0 -fill "#ffddaa" -tags tag.
$id
4057 set t
[$canv create text
$xl $y1 -anchor w
-text $tag -fill $fgcolor \
4058 -font $font -tags [list tag.
$id text
]]
4060 $canv bind $t <1> [list showtag
$tag 1]
4061 } elseif
{$nheads >= 0} {
4062 $canv bind $t <Button-3
> [list headmenu
%X
%Y
$id $tag]
4068 proc xcoord
{i level
ln} {
4069 global canvx0 xspc1 xspc2
4071 set x
[expr {$canvx0 + $i * $xspc1($ln)}]
4072 if {$i > 0 && $i == $level} {
4073 set x
[expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4074 } elseif
{$i > $level} {
4075 set x
[expr {$x + $xspc2 - $xspc1($ln)}]
4080 proc show_status
{msg
} {
4084 $canv create text
3 3 -anchor nw
-text $msg -font mainfont \
4085 -tags text
-fill $fgcolor
4088 # Insert a new commit as the child of the commit on row $row.
4089 # The new commit will be displayed on row $row and the commits
4090 # on that row and below will move down one row.
4091 proc insertrow
{row newcmit
} {
4092 global displayorder parentlist commitlisted children
4093 global commitrow curview rowidlist rowisopt rowfinal numcommits
4095 global selectedline commitidx ordertok
4097 if {$row >= $numcommits} {
4098 puts
"oops, inserting new row $row but only have $numcommits rows"
4101 set p
[lindex
$displayorder $row]
4102 set displayorder
[linsert
$displayorder $row $newcmit]
4103 set parentlist
[linsert
$parentlist $row $p]
4104 set kids
$children($curview,$p)
4105 lappend kids
$newcmit
4106 set children
($curview,$p) $kids
4107 set children
($curview,$newcmit) {}
4108 set commitlisted
[linsert
$commitlisted $row 1]
4109 set l
[llength
$displayorder]
4110 for {set r
$row} {$r < $l} {incr r
} {
4111 set id
[lindex
$displayorder $r]
4112 set commitrow
($curview,$id) $r
4114 incr commitidx
($curview)
4115 set ordertok
($curview,$newcmit) $ordertok($curview,$p)
4117 if {$row < [llength
$rowidlist]} {
4118 set idlist
[lindex
$rowidlist $row]
4119 if {$idlist ne
{}} {
4120 if {[llength
$kids] == 1} {
4121 set col [lsearch
-exact $idlist $p]
4122 lset idlist
$col $newcmit
4124 set col [llength
$idlist]
4125 lappend idlist
$newcmit
4128 set rowidlist
[linsert
$rowidlist $row $idlist]
4129 set rowisopt
[linsert
$rowisopt $row 0]
4130 set rowfinal
[linsert
$rowfinal $row [lindex
$rowfinal $row]]
4135 if {[info exists selectedline
] && $selectedline >= $row} {
4141 # Remove a commit that was inserted with insertrow on row $row.
4142 proc removerow
{row
} {
4143 global displayorder parentlist commitlisted children
4144 global commitrow curview rowidlist rowisopt rowfinal numcommits
4146 global linesegends selectedline commitidx
4148 if {$row >= $numcommits} {
4149 puts
"oops, removing row $row but only have $numcommits rows"
4152 set rp1
[expr {$row + 1}]
4153 set id
[lindex
$displayorder $row]
4154 set p
[lindex
$parentlist $row]
4155 set displayorder
[lreplace
$displayorder $row $row]
4156 set parentlist
[lreplace
$parentlist $row $row]
4157 set commitlisted
[lreplace
$commitlisted $row $row]
4158 set kids
$children($curview,$p)
4159 set i
[lsearch
-exact $kids $id]
4161 set kids
[lreplace
$kids $i $i]
4162 set children
($curview,$p) $kids
4164 set l
[llength
$displayorder]
4165 for {set r
$row} {$r < $l} {incr r
} {
4166 set id
[lindex
$displayorder $r]
4167 set commitrow
($curview,$id) $r
4169 incr commitidx
($curview) -1
4171 if {$row < [llength
$rowidlist]} {
4172 set rowidlist
[lreplace
$rowidlist $row $row]
4173 set rowisopt
[lreplace
$rowisopt $row $row]
4174 set rowfinal
[lreplace
$rowfinal $row $row]
4179 if {[info exists selectedline
] && $selectedline > $row} {
4180 incr selectedline
-1
4185 # Don't change the text pane cursor if it is currently the hand cursor,
4186 # showing that we are over a sha1 ID link.
4187 proc settextcursor
{c
} {
4188 global ctext curtextcursor
4190 if {[$ctext cget
-cursor] == $curtextcursor} {
4191 $ctext config
-cursor $c
4193 set curtextcursor
$c
4196 proc nowbusy
{what
{name
{}}} {
4197 global isbusy busyname statusw
4199 if {[array names isbusy
] eq
{}} {
4200 . config
-cursor watch
4204 set busyname
($what) $name
4206 $statusw conf
-text $name
4210 proc notbusy
{what
} {
4211 global isbusy maincursor textcursor busyname statusw
4215 if {$busyname($what) ne
{} &&
4216 [$statusw cget
-text] eq
$busyname($what)} {
4217 $statusw conf
-text {}
4220 if {[array names isbusy
] eq
{}} {
4221 . config
-cursor $maincursor
4222 settextcursor
$textcursor
4226 proc findmatches
{f
} {
4227 global findtype findstring
4228 if {$findtype == [mc
"Regexp"]} {
4229 set matches
[regexp
-indices -all -inline $findstring $f]
4232 if {$findtype == [mc
"IgnCase"]} {
4233 set f
[string tolower
$f]
4234 set fs
[string tolower
$fs]
4238 set l
[string length
$fs]
4239 while {[set j
[string first
$fs $f $i]] >= 0} {
4240 lappend matches
[list
$j [expr {$j+$l-1}]]
4241 set i
[expr {$j + $l}]
4247 proc dofind
{{dirn
1} {wrap
1}} {
4248 global findstring findstartline findcurline selectedline numcommits
4249 global gdttype filehighlight fh_serial find_dirn findallowwrap
4251 if {[info exists find_dirn
]} {
4252 if {$find_dirn == $dirn} return
4256 if {$findstring eq
{} ||
$numcommits == 0} return
4257 if {![info exists selectedline
]} {
4258 set findstartline
[lindex
[visiblerows
] [expr {$dirn < 0}]]
4260 set findstartline
$selectedline
4262 set findcurline
$findstartline
4263 nowbusy finding
[mc
"Searching"]
4264 if {$gdttype ne
[mc
"containing:"] && ![info exists filehighlight
]} {
4265 after cancel do_file_hl
$fh_serial
4266 do_file_hl
$fh_serial
4269 set findallowwrap
$wrap
4273 proc stopfinding
{} {
4274 global find_dirn findcurline fprogcoord
4276 if {[info exists find_dirn
]} {
4286 global commitdata commitinfo numcommits findpattern findloc
4287 global findstartline findcurline displayorder
4288 global find_dirn gdttype fhighlights fprogcoord
4289 global findallowwrap
4291 if {![info exists find_dirn
]} {
4294 set fldtypes
[list
[mc
"Headline"] [mc
"Author"] [mc
"Date"] [mc
"Committer"] [mc
"CDate"] [mc
"Comments"]]
4297 if {$find_dirn > 0} {
4299 if {$l >= $numcommits} {
4302 if {$l <= $findstartline} {
4303 set lim
[expr {$findstartline + 1}]
4306 set moretodo
$findallowwrap
4313 if {$l >= $findstartline} {
4314 set lim
[expr {$findstartline - 1}]
4317 set moretodo
$findallowwrap
4320 set n
[expr {($lim - $l) * $find_dirn}]
4327 if {$gdttype eq
[mc
"containing:"]} {
4328 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4329 set id
[lindex
$displayorder $l]
4330 # shouldn't happen unless git log doesn't give all the commits...
4331 if {![info exists commitdata
($id)]} continue
4332 if {![doesmatch
$commitdata($id)]} continue
4333 if {![info exists commitinfo
($id)]} {
4336 set info
$commitinfo($id)
4337 foreach f
$info ty
$fldtypes {
4338 if {($findloc eq
[mc
"All fields"] ||
$findloc eq
$ty) &&
4347 for {} {$n > 0} {incr n
-1; incr l
$find_dirn} {
4348 set id
[lindex
$displayorder $l]
4349 if {![info exists fhighlights
($l)]} {
4350 askfilehighlight
$l $id
4353 set findcurline
[expr {$l - $find_dirn}]
4355 } elseif
{$fhighlights($l)} {
4361 if {$found ||
($domore && !$moretodo)} {
4377 set findcurline
[expr {$l - $find_dirn}]
4379 set n
[expr {($findcurline - $findstartline) * $find_dirn - 1}]
4383 set fprogcoord
[expr {$n * 1.0 / $numcommits}]
4388 proc findselectline
{l
} {
4389 global findloc commentend ctext findcurline markingmatches gdttype
4391 set markingmatches
1
4394 if {$findloc == [mc
"All fields"] ||
$findloc == [mc
"Comments"]} {
4395 # highlight the matches in the comments
4396 set f
[$ctext get
1.0 $commentend]
4397 set matches
[findmatches
$f]
4398 foreach match
$matches {
4399 set start
[lindex
$match 0]
4400 set end
[expr {[lindex
$match 1] + 1}]
4401 $ctext tag add found
"1.0 + $start c" "1.0 + $end c"
4407 # mark the bits of a headline or author that match a find string
4408 proc markmatches
{canv l str tag matches font row
} {
4411 set bbox
[$canv bbox
$tag]
4412 set x0
[lindex
$bbox 0]
4413 set y0
[lindex
$bbox 1]
4414 set y1
[lindex
$bbox 3]
4415 foreach match
$matches {
4416 set start
[lindex
$match 0]
4417 set end
[lindex
$match 1]
4418 if {$start > $end} continue
4419 set xoff
[font measure
$font [string range
$str 0 [expr {$start-1}]]]
4420 set xlen
[font measure
$font [string range
$str 0 [expr {$end}]]]
4421 set t
[$canv create rect
[expr {$x0+$xoff}] $y0 \
4422 [expr {$x0+$xlen+2}] $y1 \
4423 -outline {} -tags [list match
$l matches
] -fill yellow
]
4425 if {[info exists selectedline
] && $row == $selectedline} {
4426 $canv raise
$t secsel
4431 proc unmarkmatches
{} {
4432 global markingmatches
4434 allcanvs delete matches
4435 set markingmatches
0
4439 proc selcanvline
{w x y
} {
4440 global canv canvy0 ctext linespc
4442 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4443 if {$ymax == {}} return
4444 set yfrac
[lindex
[$canv yview
] 0]
4445 set y
[expr {$y + $yfrac * $ymax}]
4446 set l
[expr {int
(($y - $canvy0) / $linespc + 0.5)}]
4451 if {![info exists rowtextx
($l)] ||
$x < $rowtextx($l)} return
4457 proc commit_descriptor
{p
} {
4459 if {![info exists commitinfo
($p)]} {
4463 if {[llength
$commitinfo($p)] > 1} {
4464 set l
[lindex
$commitinfo($p) 0]
4469 # append some text to the ctext widget, and make any SHA1 ID
4470 # that we know about be a clickable link.
4471 proc appendwithlinks
{text tags
} {
4472 global ctext commitrow linknum curview pendinglinks
4474 set start
[$ctext index
"end - 1c"]
4475 $ctext insert end
$text $tags
4476 set links
[regexp
-indices -all -inline {[0-9a-f]{40}} $text]
4480 set linkid
[string range
$text $s $e]
4482 $ctext tag delete link
$linknum
4483 $ctext tag add link
$linknum "$start + $s c" "$start + $e c"
4484 setlink
$linkid link
$linknum
4489 proc setlink
{id lk
} {
4490 global curview commitrow ctext pendinglinks commitinterest
4492 if {[info exists commitrow
($curview,$id)]} {
4493 $ctext tag conf
$lk -foreground blue
-underline 1
4494 $ctext tag
bind $lk <1> [list selectline
$commitrow($curview,$id) 1]
4495 $ctext tag
bind $lk <Enter
> {linkcursor
%W
1}
4496 $ctext tag
bind $lk <Leave
> {linkcursor
%W
-1}
4498 lappend pendinglinks
($id) $lk
4499 lappend commitinterest
($id) {makelink
%I
}
4503 proc makelink
{id
} {
4506 if {![info exists pendinglinks
($id)]} return
4507 foreach lk
$pendinglinks($id) {
4510 unset pendinglinks
($id)
4513 proc linkcursor
{w inc
} {
4514 global linkentercount curtextcursor
4516 if {[incr linkentercount
$inc] > 0} {
4517 $w configure
-cursor hand2
4519 $w configure
-cursor $curtextcursor
4520 if {$linkentercount < 0} {
4521 set linkentercount
0
4526 proc viewnextline
{dir
} {
4530 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4531 set wnow
[$canv yview
]
4532 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4533 set newtop
[expr {$wtop + $dir * $linespc}]
4536 } elseif
{$newtop > $ymax} {
4539 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4542 # add a list of tag or branch names at position pos
4543 # returns the number of names inserted
4544 proc appendrefs
{pos ids var
} {
4545 global ctext commitrow linknum curview
$var maxrefs
4547 if {[catch
{$ctext index
$pos}]} {
4550 $ctext conf
-state normal
4551 $ctext delete
$pos "$pos lineend"
4554 foreach tag
[set $var\
($id\
)] {
4555 lappend tags
[list
$tag $id]
4558 if {[llength
$tags] > $maxrefs} {
4559 $ctext insert
$pos "many ([llength $tags])"
4561 set tags
[lsort
-index 0 -decreasing $tags]
4564 set id
[lindex
$ti 1]
4567 $ctext tag delete
$lk
4568 $ctext insert
$pos $sep
4569 $ctext insert
$pos [lindex
$ti 0] $lk
4574 $ctext conf
-state disabled
4575 return [llength
$tags]
4578 # called when we have finished computing the nearby tags
4579 proc dispneartags
{delay
} {
4580 global selectedline currentid showneartags tagphase
4582 if {![info exists selectedline
] ||
!$showneartags} return
4583 after cancel dispnexttag
4585 after
200 dispnexttag
4588 after idle dispnexttag
4593 proc dispnexttag
{} {
4594 global selectedline currentid showneartags tagphase ctext
4596 if {![info exists selectedline
] ||
!$showneartags} return
4597 switch
-- $tagphase {
4599 set dtags
[desctags
$currentid]
4601 appendrefs precedes
$dtags idtags
4605 set atags
[anctags
$currentid]
4607 appendrefs follows
$atags idtags
4611 set dheads
[descheads
$currentid]
4612 if {$dheads ne
{}} {
4613 if {[appendrefs branch
$dheads idheads
] > 1
4614 && [$ctext get
"branch -3c"] eq
"h"} {
4615 # turn "Branch" into "Branches"
4616 $ctext conf
-state normal
4617 $ctext insert
"branch -2c" "es"
4618 $ctext conf
-state disabled
4623 if {[incr tagphase
] <= 2} {
4624 after idle dispnexttag
4628 proc make_secsel
{l
} {
4629 global linehtag linentag linedtag canv canv2 canv3
4631 if {![info exists linehtag
($l)]} return
4633 set t
[eval $canv create rect
[$canv bbox
$linehtag($l)] -outline {{}} \
4634 -tags secsel
-fill [$canv cget
-selectbackground]]
4636 $canv2 delete secsel
4637 set t
[eval $canv2 create rect
[$canv2 bbox
$linentag($l)] -outline {{}} \
4638 -tags secsel
-fill [$canv2 cget
-selectbackground]]
4640 $canv3 delete secsel
4641 set t
[eval $canv3 create rect
[$canv3 bbox
$linedtag($l)] -outline {{}} \
4642 -tags secsel
-fill [$canv3 cget
-selectbackground]]
4646 proc selectline
{l isnew
} {
4647 global canv ctext commitinfo selectedline
4649 global canvy0 linespc parentlist children curview
4650 global currentid sha1entry
4651 global commentend idtags linknum
4652 global mergemax numcommits pending_select
4653 global cmitmode showneartags allcommits
4655 catch
{unset pending_select
}
4660 if {$l < 0 ||
$l >= $numcommits} return
4661 set y
[expr {$canvy0 + $l * $linespc}]
4662 set ymax
[lindex
[$canv cget
-scrollregion] 3]
4663 set ytop
[expr {$y - $linespc - 1}]
4664 set ybot
[expr {$y + $linespc + 1}]
4665 set wnow
[$canv yview
]
4666 set wtop
[expr {[lindex
$wnow 0] * $ymax}]
4667 set wbot
[expr {[lindex
$wnow 1] * $ymax}]
4668 set wh
[expr {$wbot - $wtop}]
4670 if {$ytop < $wtop} {
4671 if {$ybot < $wtop} {
4672 set newtop
[expr {$y - $wh / 2.0}]
4675 if {$newtop > $wtop - $linespc} {
4676 set newtop
[expr {$wtop - $linespc}]
4679 } elseif
{$ybot > $wbot} {
4680 if {$ytop > $wbot} {
4681 set newtop
[expr {$y - $wh / 2.0}]
4683 set newtop
[expr {$ybot - $wh}]
4684 if {$newtop < $wtop + $linespc} {
4685 set newtop
[expr {$wtop + $linespc}]
4689 if {$newtop != $wtop} {
4693 allcanvs yview moveto
[expr {$newtop * 1.0 / $ymax}]
4700 addtohistory
[list selectline
$l 0]
4705 set id
[lindex
$displayorder $l]
4707 $sha1entry delete
0 end
4708 $sha1entry insert
0 $id
4709 $sha1entry selection from
0
4710 $sha1entry selection to end
4713 $ctext conf
-state normal
4716 set info
$commitinfo($id)
4717 set date [formatdate
[lindex
$info 2]]
4718 $ctext insert end
"[mc "Author
"]: [lindex $info 1] $date\n"
4719 set date [formatdate
[lindex
$info 4]]
4720 $ctext insert end
"[mc "Committer
"]: [lindex $info 3] $date\n"
4721 if {[info exists idtags
($id)]} {
4722 $ctext insert end
[mc
"Tags:"]
4723 foreach tag
$idtags($id) {
4724 $ctext insert end
" $tag"
4726 $ctext insert end
"\n"
4730 set olds
[lindex
$parentlist $l]
4731 if {[llength
$olds] > 1} {
4734 if {$np >= $mergemax} {
4739 $ctext insert end
"[mc "Parent
"]: " $tag
4740 appendwithlinks
[commit_descriptor
$p] {}
4745 append headers
"[mc "Parent
"]: [commit_descriptor $p]"
4749 foreach c
$children($curview,$id) {
4750 append headers
"[mc "Child
"]: [commit_descriptor $c]"
4753 # make anything that looks like a SHA1 ID be a clickable link
4754 appendwithlinks
$headers {}
4755 if {$showneartags} {
4756 if {![info exists allcommits
]} {
4759 $ctext insert end
"[mc "Branch
"]: "
4760 $ctext mark
set branch
"end -1c"
4761 $ctext mark gravity branch left
4762 $ctext insert end
"\n[mc "Follows
"]: "
4763 $ctext mark
set follows
"end -1c"
4764 $ctext mark gravity follows left
4765 $ctext insert end
"\n[mc "Precedes
"]: "
4766 $ctext mark
set precedes
"end -1c"
4767 $ctext mark gravity precedes left
4768 $ctext insert end
"\n"
4771 $ctext insert end
"\n"
4772 set comment
[lindex
$info 5]
4773 if {[string first
"\r" $comment] >= 0} {
4774 set comment
[string map
{"\r" "\n "} $comment]
4776 appendwithlinks
$comment {comment
}
4778 $ctext tag remove found
1.0 end
4779 $ctext conf
-state disabled
4780 set commentend
[$ctext index
"end - 1c"]
4782 init_flist
[mc
"Comments"]
4783 if {$cmitmode eq
"tree"} {
4785 } elseif
{[llength
$olds] <= 1} {
4792 proc selfirstline
{} {
4797 proc sellastline
{} {
4800 set l
[expr {$numcommits - 1}]
4804 proc selnextline
{dir
} {
4807 if {![info exists selectedline
]} return
4808 set l
[expr {$selectedline + $dir}]
4813 proc selnextpage
{dir
} {
4814 global canv linespc selectedline numcommits
4816 set lpp
[expr {([winfo height
$canv] - 2) / $linespc}]
4820 allcanvs yview scroll
[expr {$dir * $lpp}] units
4822 if {![info exists selectedline
]} return
4823 set l
[expr {$selectedline + $dir * $lpp}]
4826 } elseif
{$l >= $numcommits} {
4827 set l
[expr $numcommits - 1]
4833 proc unselectline
{} {
4834 global selectedline currentid
4836 catch
{unset selectedline
}
4837 catch
{unset currentid
}
4838 allcanvs delete secsel
4842 proc reselectline
{} {
4845 if {[info exists selectedline
]} {
4846 selectline
$selectedline 0
4850 proc addtohistory
{cmd
} {
4851 global
history historyindex curview
4853 set elt
[list
$curview $cmd]
4854 if {$historyindex > 0
4855 && [lindex
$history [expr {$historyindex - 1}]] == $elt} {
4859 if {$historyindex < [llength
$history]} {
4860 set history [lreplace
$history $historyindex end
$elt]
4862 lappend
history $elt
4865 if {$historyindex > 1} {
4866 .tf.bar.leftbut conf
-state normal
4868 .tf.bar.leftbut conf
-state disabled
4870 .tf.bar.rightbut conf
-state disabled
4876 set view
[lindex
$elt 0]
4877 set cmd
[lindex
$elt 1]
4878 if {$curview != $view} {
4885 global
history historyindex
4888 if {$historyindex > 1} {
4889 incr historyindex
-1
4890 godo
[lindex
$history [expr {$historyindex - 1}]]
4891 .tf.bar.rightbut conf
-state normal
4893 if {$historyindex <= 1} {
4894 .tf.bar.leftbut conf
-state disabled
4899 global
history historyindex
4902 if {$historyindex < [llength
$history]} {
4903 set cmd
[lindex
$history $historyindex]
4906 .tf.bar.leftbut conf
-state normal
4908 if {$historyindex >= [llength
$history]} {
4909 .tf.bar.rightbut conf
-state disabled
4914 global treefilelist treeidlist diffids diffmergeid treepending
4915 global nullid nullid2
4918 catch
{unset diffmergeid
}
4919 if {![info exists treefilelist
($id)]} {
4920 if {![info exists treepending
]} {
4921 if {$id eq
$nullid} {
4922 set cmd
[list | git ls-files
]
4923 } elseif
{$id eq
$nullid2} {
4924 set cmd
[list | git ls-files
--stage -t]
4926 set cmd
[list | git ls-tree
-r $id]
4928 if {[catch
{set gtf
[open
$cmd r
]}]} {
4932 set treefilelist
($id) {}
4933 set treeidlist
($id) {}
4934 fconfigure
$gtf -blocking 0
4935 filerun
$gtf [list gettreeline
$gtf $id]
4942 proc gettreeline
{gtf id
} {
4943 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4946 while {[incr
nl] <= 1000 && [gets
$gtf line
] >= 0} {
4947 if {$diffids eq
$nullid} {
4950 if {$diffids ne
$nullid2 && [lindex
$line 1] ne
"blob"} continue
4951 set i
[string first
"\t" $line]
4952 if {$i < 0} continue
4953 set sha1
[lindex
$line 2]
4954 set fname
[string range
$line [expr {$i+1}] end
]
4955 if {[string index
$fname 0] eq
"\""} {
4956 set fname
[lindex
$fname 0]
4958 lappend treeidlist
($id) $sha1
4960 lappend treefilelist
($id) $fname
4963 return [expr {$nl >= 1000?
2: 1}]
4967 if {$cmitmode ne
"tree"} {
4968 if {![info exists diffmergeid
]} {
4969 gettreediffs
$diffids
4971 } elseif
{$id ne
$diffids} {
4980 global treefilelist treeidlist diffids nullid nullid2
4981 global ctext commentend
4983 set i
[lsearch
-exact $treefilelist($diffids) $f]
4985 puts
"oops, $f not in list for id $diffids"
4988 if {$diffids eq
$nullid} {
4989 if {[catch
{set bf
[open
$f r
]} err
]} {
4990 puts
"oops, can't read $f: $err"
4994 set blob
[lindex
$treeidlist($diffids) $i]
4995 if {[catch
{set bf
[open
[concat | git cat-file blob
$blob] r
]} err
]} {
4996 puts
"oops, error reading blob $blob: $err"
5000 fconfigure
$bf -blocking 0
5001 filerun
$bf [list getblobline
$bf $diffids]
5002 $ctext config
-state normal
5003 clear_ctext
$commentend
5004 $ctext insert end
"\n"
5005 $ctext insert end
"$f\n" filesep
5006 $ctext config
-state disabled
5007 $ctext yview
$commentend
5011 proc getblobline
{bf id
} {
5012 global diffids cmitmode ctext
5014 if {$id ne
$diffids ||
$cmitmode ne
"tree"} {
5018 $ctext config
-state normal
5020 while {[incr
nl] <= 1000 && [gets
$bf line
] >= 0} {
5021 $ctext insert end
"$line\n"
5024 # delete last newline
5025 $ctext delete
"end - 2c" "end - 1c"
5029 $ctext config
-state disabled
5030 return [expr {$nl >= 1000?
2: 1}]
5033 proc mergediff
{id l
} {
5034 global diffmergeid mdifffd
5038 global limitdiffs viewfiles curview
5042 # this doesn't seem to actually affect anything...
5043 set cmd
[concat | git diff-tree
--no-commit-id --cc -U$diffcontext $id]
5044 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5045 set cmd
[concat
$cmd -- $viewfiles($curview)]
5047 if {[catch
{set mdf
[open
$cmd r
]} err
]} {
5048 error_popup
"[mc "Error getting merge diffs
:"] $err"
5051 fconfigure
$mdf -blocking 0
5052 set mdifffd
($id) $mdf
5053 set np
[llength
[lindex
$parentlist $l]]
5055 filerun
$mdf [list getmergediffline
$mdf $id $np]
5058 proc getmergediffline
{mdf id np
} {
5059 global diffmergeid ctext cflist mergemax
5060 global difffilestart mdifffd
5062 $ctext conf
-state normal
5064 while {[incr nr
] <= 1000 && [gets
$mdf line
] >= 0} {
5065 if {![info exists diffmergeid
] ||
$id != $diffmergeid
5066 ||
$mdf != $mdifffd($id)} {
5070 if {[regexp
{^
diff --cc (.
*)} $line match fname
]} {
5071 # start of a new file
5072 $ctext insert end
"\n"
5073 set here
[$ctext index
"end - 1c"]
5074 lappend difffilestart
$here
5075 add_flist
[list
$fname]
5076 set l
[expr {(78 - [string length
$fname]) / 2}]
5077 set pad
[string range
"----------------------------------------" 1 $l]
5078 $ctext insert end
"$pad $fname $pad\n" filesep
5079 } elseif
{[regexp
{^@@
} $line]} {
5080 $ctext insert end
"$line\n" hunksep
5081 } elseif
{[regexp
{^
[0-9a-f]{40}$
} $line] ||
[regexp
{^index
} $line]} {
5084 # parse the prefix - one ' ', '-' or '+' for each parent
5089 for {set j
0} {$j < $np} {incr j
} {
5090 set c
[string range
$line $j $j]
5093 } elseif
{$c == "-"} {
5095 } elseif
{$c == "+"} {
5104 if {!$isbad && $minuses ne
{} && $pluses eq
{}} {
5105 # line doesn't appear in result, parents in $minuses have the line
5106 set num
[lindex
$minuses 0]
5107 } elseif
{!$isbad && $pluses ne
{} && $minuses eq
{}} {
5108 # line appears in result, parents in $pluses don't have the line
5109 lappend tags mresult
5110 set num
[lindex
$spaces 0]
5113 if {$num >= $mergemax} {
5118 $ctext insert end
"$line\n" $tags
5121 $ctext conf
-state disabled
5126 return [expr {$nr >= 1000?
2: 1}]
5129 proc startdiff
{ids
} {
5130 global treediffs diffids treepending diffmergeid nullid nullid2
5134 catch
{unset diffmergeid
}
5135 if {![info exists treediffs
($ids)] ||
5136 [lsearch
-exact $ids $nullid] >= 0 ||
5137 [lsearch
-exact $ids $nullid2] >= 0} {
5138 if {![info exists treepending
]} {
5146 proc path_filter
{filter name
} {
5148 set l
[string length
$p]
5149 if {[string index
$p end
] eq
"/"} {
5150 if {[string compare
-length $l $p $name] == 0} {
5154 if {[string compare
-length $l $p $name] == 0 &&
5155 ([string length
$name] == $l ||
5156 [string index
$name $l] eq
"/")} {
5164 proc addtocflist
{ids
} {
5167 add_flist
$treediffs($ids)
5171 proc diffcmd
{ids flags
} {
5172 global nullid nullid2
5174 set i
[lsearch
-exact $ids $nullid]
5175 set j
[lsearch
-exact $ids $nullid2]
5177 if {[llength
$ids] > 1 && $j < 0} {
5178 # comparing working directory with some specific revision
5179 set cmd
[concat | git diff-index
$flags]
5181 lappend cmd
-R [lindex
$ids 1]
5183 lappend cmd
[lindex
$ids 0]
5186 # comparing working directory with index
5187 set cmd
[concat | git diff-files
$flags]
5192 } elseif
{$j >= 0} {
5193 set cmd
[concat | git diff-index
--cached $flags]
5194 if {[llength
$ids] > 1} {
5195 # comparing index with specific revision
5197 lappend cmd
-R [lindex
$ids 1]
5199 lappend cmd
[lindex
$ids 0]
5202 # comparing index with HEAD
5206 set cmd
[concat | git diff-tree
-r $flags $ids]
5211 proc gettreediffs
{ids
} {
5212 global treediff treepending
5214 set treepending
$ids
5216 if {[catch
{set gdtf
[open
[diffcmd
$ids {--no-commit-id}] r
]}]} return
5217 fconfigure
$gdtf -blocking 0
5218 filerun
$gdtf [list gettreediffline
$gdtf $ids]
5221 proc gettreediffline
{gdtf ids
} {
5222 global treediff treediffs treepending diffids diffmergeid
5223 global cmitmode viewfiles curview limitdiffs
5226 while {[incr nr
] <= 1000 && [gets
$gdtf line
] >= 0} {
5227 set i
[string first
"\t" $line]
5229 set file [string range
$line [expr {$i+1}] end
]
5230 if {[string index
$file 0] eq
"\""} {
5231 set file [lindex
$file 0]
5233 lappend treediff
$file
5237 return [expr {$nr >= 1000?
2: 1}]
5240 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5242 foreach f
$treediff {
5243 if {[path_filter
$viewfiles($curview) $f]} {
5247 set treediffs
($ids) $flist
5249 set treediffs
($ids) $treediff
5252 if {$cmitmode eq
"tree"} {
5254 } elseif
{$ids != $diffids} {
5255 if {![info exists diffmergeid
]} {
5256 gettreediffs
$diffids
5264 # empty string or positive integer
5265 proc diffcontextvalidate
{v
} {
5266 return [regexp
{^
(|
[1-9][0-9]*)$
} $v]
5269 proc diffcontextchange
{n1 n2 op
} {
5270 global diffcontextstring diffcontext
5272 if {[string is integer
-strict $diffcontextstring]} {
5273 if {$diffcontextstring > 0} {
5274 set diffcontext
$diffcontextstring
5280 proc changeignorespace
{} {
5284 proc getblobdiffs
{ids
} {
5285 global blobdifffd diffids env
5286 global diffinhdr treediffs
5289 global limitdiffs viewfiles curview
5291 set cmd
[diffcmd
$ids "-p -C --no-commit-id -U$diffcontext"]
5295 if {$limitdiffs && $viewfiles($curview) ne
{}} {
5296 set cmd
[concat
$cmd -- $viewfiles($curview)]
5298 if {[catch
{set bdf
[open
$cmd r
]} err
]} {
5299 puts
"error getting diffs: $err"
5303 fconfigure
$bdf -blocking 0
5304 set blobdifffd
($ids) $bdf
5305 filerun
$bdf [list getblobdiffline
$bdf $diffids]
5308 proc setinlist
{var i val
} {
5311 while {[llength
[set $var]] < $i} {
5314 if {[llength
[set $var]] == $i} {
5321 proc makediffhdr
{fname ids
} {
5322 global ctext curdiffstart treediffs
5324 set i
[lsearch
-exact $treediffs($ids) $fname]
5326 setinlist difffilestart
$i $curdiffstart
5328 set l
[expr {(78 - [string length
$fname]) / 2}]
5329 set pad
[string range
"----------------------------------------" 1 $l]
5330 $ctext insert
$curdiffstart "$pad $fname $pad" filesep
5333 proc getblobdiffline
{bdf ids
} {
5334 global diffids blobdifffd ctext curdiffstart
5335 global diffnexthead diffnextnote difffilestart
5336 global diffinhdr treediffs
5339 $ctext conf
-state normal
5340 while {[incr nr
] <= 1000 && [gets
$bdf line
] >= 0} {
5341 if {$ids != $diffids ||
$bdf != $blobdifffd($ids)} {
5345 if {![string compare
-length 11 "diff --git " $line]} {
5346 # trim off "diff --git "
5347 set line
[string range
$line 11 end
]
5349 # start of a new file
5350 $ctext insert end
"\n"
5351 set curdiffstart
[$ctext index
"end - 1c"]
5352 $ctext insert end
"\n" filesep
5353 # If the name hasn't changed the length will be odd,
5354 # the middle char will be a space, and the two bits either
5355 # side will be a/name and b/name, or "a/name" and "b/name".
5356 # If the name has changed we'll get "rename from" and
5357 # "rename to" or "copy from" and "copy to" lines following this,
5358 # and we'll use them to get the filenames.
5359 # This complexity is necessary because spaces in the filename(s)
5360 # don't get escaped.
5361 set l
[string length
$line]
5362 set i
[expr {$l / 2}]
5363 if {!(($l & 1) && [string index
$line $i] eq
" " &&
5364 [string range
$line 2 [expr {$i - 1}]] eq \
5365 [string range
$line [expr {$i + 3}] end
])} {
5368 # unescape if quoted and chop off the a/ from the front
5369 if {[string index
$line 0] eq
"\""} {
5370 set fname
[string range
[lindex
$line 0] 2 end
]
5372 set fname
[string range
$line 2 [expr {$i - 1}]]
5374 makediffhdr
$fname $ids
5376 } elseif
{[regexp
{^@@
-([0-9]+)(,[0-9]+)? \
+([0-9]+)(,[0-9]+)? @@
(.
*)} \
5377 $line match f1l f1c f2l f2c rest
]} {
5378 $ctext insert end
"$line\n" hunksep
5381 } elseif
{$diffinhdr} {
5382 if {![string compare
-length 12 "rename from " $line]} {
5383 set fname
[string range
$line [expr 6 + [string first
" from " $line] ] end
]
5384 if {[string index
$fname 0] eq
"\""} {
5385 set fname
[lindex
$fname 0]
5387 set i
[lsearch
-exact $treediffs($ids) $fname]
5389 setinlist difffilestart
$i $curdiffstart
5391 } elseif
{![string compare
-length 10 $line "rename to "] ||
5392 ![string compare
-length 8 $line "copy to "]} {
5393 set fname
[string range
$line [expr 4 + [string first
" to " $line] ] end
]
5394 if {[string index
$fname 0] eq
"\""} {
5395 set fname
[lindex
$fname 0]
5397 makediffhdr
$fname $ids
5398 } elseif
{[string compare
-length 3 $line "---"] == 0} {
5401 } elseif
{[string compare
-length 3 $line "+++"] == 0} {
5405 $ctext insert end
"$line\n" filesep
5408 set x
[string range
$line 0 0]
5409 if {$x == "-" ||
$x == "+"} {
5410 set tag
[expr {$x == "+"}]
5411 $ctext insert end
"$line\n" d
$tag
5412 } elseif
{$x == " "} {
5413 $ctext insert end
"$line\n"
5415 # "\ No newline at end of file",
5416 # or something else we don't recognize
5417 $ctext insert end
"$line\n" hunksep
5421 $ctext conf
-state disabled
5426 return [expr {$nr >= 1000?
2: 1}]
5429 proc changediffdisp
{} {
5430 global ctext diffelide
5432 $ctext tag conf d0
-elide [lindex
$diffelide 0]
5433 $ctext tag conf d1
-elide [lindex
$diffelide 1]
5437 global difffilestart ctext
5438 set prev
[lindex
$difffilestart 0]
5439 set here
[$ctext index @
0,0]
5440 foreach loc
$difffilestart {
5441 if {[$ctext compare
$loc >= $here]} {
5451 global difffilestart ctext
5452 set here
[$ctext index @
0,0]
5453 foreach loc
$difffilestart {
5454 if {[$ctext compare
$loc > $here]} {
5461 proc clear_ctext
{{first
1.0}} {
5462 global ctext smarktop smarkbot
5465 set l
[lindex
[split $first .
] 0]
5466 if {![info exists smarktop
] ||
[$ctext compare
$first < $smarktop.0]} {
5469 if {![info exists smarkbot
] ||
[$ctext compare
$first < $smarkbot.0]} {
5472 $ctext delete
$first end
5473 if {$first eq
"1.0"} {
5474 catch
{unset pendinglinks
}
5478 proc settabs
{{firstab
{}}} {
5479 global firsttabstop tabstop ctext have_tk85
5481 if {$firstab ne
{} && $have_tk85} {
5482 set firsttabstop
$firstab
5484 set w
[font measure textfont
"0"]
5485 if {$firsttabstop != 0} {
5486 $ctext conf
-tabs [list
[expr {($firsttabstop + $tabstop) * $w}] \
5487 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5488 } elseif
{$have_tk85 ||
$tabstop != 8} {
5489 $ctext conf
-tabs [expr {$tabstop * $w}]
5491 $ctext conf
-tabs {}
5495 proc incrsearch
{name ix op
} {
5496 global ctext searchstring searchdirn
5498 $ctext tag remove found
1.0 end
5499 if {[catch
{$ctext index anchor
}]} {
5500 # no anchor set, use start of selection, or of visible area
5501 set sel
[$ctext tag ranges sel
]
5503 $ctext mark
set anchor
[lindex
$sel 0]
5504 } elseif
{$searchdirn eq
"-forwards"} {
5505 $ctext mark
set anchor @
0,0
5507 $ctext mark
set anchor @
0,[winfo height
$ctext]
5510 if {$searchstring ne
{}} {
5511 set here
[$ctext search
$searchdirn -- $searchstring anchor
]
5520 global sstring ctext searchstring searchdirn
5523 $sstring icursor end
5524 set searchdirn
-forwards
5525 if {$searchstring ne
{}} {
5526 set sel
[$ctext tag ranges sel
]
5528 set start
"[lindex $sel 0] + 1c"
5529 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5532 set match
[$ctext search
-count mlen
-- $searchstring $start]
5533 $ctext tag remove sel
1.0 end
5539 set mend
"$match + $mlen c"
5540 $ctext tag add sel
$match $mend
5541 $ctext mark
unset anchor
5545 proc dosearchback
{} {
5546 global sstring ctext searchstring searchdirn
5549 $sstring icursor end
5550 set searchdirn
-backwards
5551 if {$searchstring ne
{}} {
5552 set sel
[$ctext tag ranges sel
]
5554 set start
[lindex
$sel 0]
5555 } elseif
{[catch
{set start
[$ctext index anchor
]}]} {
5556 set start @
0,[winfo height
$ctext]
5558 set match
[$ctext search
-backwards -count ml
-- $searchstring $start]
5559 $ctext tag remove sel
1.0 end
5565 set mend
"$match + $ml c"
5566 $ctext tag add sel
$match $mend
5567 $ctext mark
unset anchor
5571 proc searchmark
{first last
} {
5572 global ctext searchstring
5576 set match
[$ctext search
-count mlen
-- $searchstring $mend $last.end
]
5577 if {$match eq
{}} break
5578 set mend
"$match + $mlen c"
5579 $ctext tag add found
$match $mend
5583 proc searchmarkvisible
{doall
} {
5584 global ctext smarktop smarkbot
5586 set topline
[lindex
[split [$ctext index @
0,0] .
] 0]
5587 set botline
[lindex
[split [$ctext index @
0,[winfo height
$ctext]] .
] 0]
5588 if {$doall ||
$botline < $smarktop ||
$topline > $smarkbot} {
5589 # no overlap with previous
5590 searchmark
$topline $botline
5591 set smarktop
$topline
5592 set smarkbot
$botline
5594 if {$topline < $smarktop} {
5595 searchmark
$topline [expr {$smarktop-1}]
5596 set smarktop
$topline
5598 if {$botline > $smarkbot} {
5599 searchmark
[expr {$smarkbot+1}] $botline
5600 set smarkbot
$botline
5605 proc scrolltext
{f0 f1
} {
5608 .bleft.sb
set $f0 $f1
5609 if {$searchstring ne
{}} {
5615 global linespc charspc canvx0 canvy0
5616 global xspc1 xspc2 lthickness
5618 set linespc
[font metrics mainfont
-linespace]
5619 set charspc
[font measure mainfont
"m"]
5620 set canvy0
[expr {int
(3 + 0.5 * $linespc)}]
5621 set canvx0
[expr {int
(3 + 0.5 * $linespc)}]
5622 set lthickness
[expr {int
($linespc / 9) + 1}]
5623 set xspc1
(0) $linespc
5631 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5632 if {$ymax eq
{} ||
$ymax == 0} return
5633 set span
[$canv yview
]
5636 allcanvs yview moveto
[lindex
$span 0]
5638 if {[info exists selectedline
]} {
5639 selectline
$selectedline 0
5640 allcanvs yview moveto
[lindex
$span 0]
5644 proc parsefont
{f n
} {
5647 set fontattr
($f,family
) [lindex
$n 0]
5649 if {$s eq
{} ||
$s == 0} {
5652 set s
[expr {int
(-$s / [winfo fpixels .
1p
] + 0.5)}]
5654 set fontattr
($f,size
) $s
5655 set fontattr
($f,weight
) normal
5656 set fontattr
($f,slant
) roman
5657 foreach style
[lrange
$n 2 end
] {
5660 "bold" {set fontattr
($f,weight
) $style}
5662 "italic" {set fontattr
($f,slant
) $style}
5667 proc fontflags
{f
{isbold
0}} {
5670 return [list
-family $fontattr($f,family
) -size $fontattr($f,size
) \
5671 -weight [expr {$isbold?
"bold": $fontattr($f,weight
)}] \
5672 -slant $fontattr($f,slant
)]
5678 set n
[list
$fontattr($f,family
) $fontattr($f,size
)]
5679 if {$fontattr($f,weight
) eq
"bold"} {
5682 if {$fontattr($f,slant
) eq
"italic"} {
5688 proc incrfont
{inc
} {
5689 global mainfont textfont ctext canv phase cflist showrefstop
5690 global stopped entries fontattr
5693 set s
$fontattr(mainfont
,size
)
5698 set fontattr
(mainfont
,size
) $s
5699 font config mainfont
-size $s
5700 font config mainfontbold
-size $s
5701 set mainfont
[fontname mainfont
]
5702 set s
$fontattr(textfont
,size
)
5707 set fontattr
(textfont
,size
) $s
5708 font config textfont
-size $s
5709 font config textfontbold
-size $s
5710 set textfont
[fontname textfont
]
5717 global sha1entry sha1string
5718 if {[string length
$sha1string] == 40} {
5719 $sha1entry delete
0 end
5723 proc sha1change
{n1 n2 op
} {
5724 global sha1string currentid sha1but
5725 if {$sha1string == {}
5726 ||
([info exists currentid
] && $sha1string == $currentid)} {
5731 if {[$sha1but cget
-state] == $state} return
5732 if {$state == "normal"} {
5733 $sha1but conf
-state normal
-relief raised
-text "[mc "Goto
:"] "
5735 $sha1but conf
-state disabled
-relief flat
-text "[mc "SHA1 ID
:"] "
5739 proc gotocommit
{} {
5740 global sha1string currentid commitrow tagids headids
5741 global displayorder numcommits curview
5743 if {$sha1string == {}
5744 ||
([info exists currentid
] && $sha1string == $currentid)} return
5745 if {[info exists tagids
($sha1string)]} {
5746 set id
$tagids($sha1string)
5747 } elseif
{[info exists headids
($sha1string)]} {
5748 set id
$headids($sha1string)
5750 set id
[string tolower
$sha1string]
5751 if {[regexp
{^
[0-9a-f]{4,39}$
} $id]} {
5753 foreach i
$displayorder {
5754 if {[string match
$id* $i]} {
5758 if {$matches ne
{}} {
5759 if {[llength
$matches] > 1} {
5760 error_popup
[mc
"Short SHA1 id %s is ambiguous" $id]
5763 set id
[lindex
$matches 0]
5767 if {[info exists commitrow
($curview,$id)]} {
5768 selectline
$commitrow($curview,$id) 1
5771 if {[regexp
{^
[0-9a-fA-F]{4,}$
} $sha1string]} {
5772 set msg
[mc
"SHA1 id %s is not known" $sha1string]
5774 set msg
[mc
"Tag/Head %s is not known" $sha1string]
5779 proc lineenter
{x y id
} {
5780 global hoverx hovery hoverid hovertimer
5781 global commitinfo canv
5783 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5787 if {[info exists hovertimer
]} {
5788 after cancel
$hovertimer
5790 set hovertimer
[after
500 linehover
]
5794 proc linemotion
{x y id
} {
5795 global hoverx hovery hoverid hovertimer
5797 if {[info exists hoverid
] && $id == $hoverid} {
5800 if {[info exists hovertimer
]} {
5801 after cancel
$hovertimer
5803 set hovertimer
[after
500 linehover
]
5807 proc lineleave
{id
} {
5808 global hoverid hovertimer canv
5810 if {[info exists hoverid
] && $id == $hoverid} {
5812 if {[info exists hovertimer
]} {
5813 after cancel
$hovertimer
5821 global hoverx hovery hoverid hovertimer
5822 global canv linespc lthickness
5825 set text
[lindex
$commitinfo($hoverid) 0]
5826 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5827 if {$ymax == {}} return
5828 set yfrac
[lindex
[$canv yview
] 0]
5829 set x
[expr {$hoverx + 2 * $linespc}]
5830 set y
[expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5831 set x0
[expr {$x - 2 * $lthickness}]
5832 set y0
[expr {$y - 2 * $lthickness}]
5833 set x1
[expr {$x + [font measure mainfont
$text] + 2 * $lthickness}]
5834 set y1
[expr {$y + $linespc + 2 * $lthickness}]
5835 set t
[$canv create rectangle
$x0 $y0 $x1 $y1 \
5836 -fill \
#ffff80 -outline black -width 1 -tags hover]
5838 set t
[$canv create text
$x $y -anchor nw
-text $text -tags hover \
5843 proc clickisonarrow
{id y
} {
5846 set ranges
[rowranges
$id]
5847 set thresh
[expr {2 * $lthickness + 6}]
5848 set n
[expr {[llength
$ranges] - 1}]
5849 for {set i
1} {$i < $n} {incr i
} {
5850 set row
[lindex
$ranges $i]
5851 if {abs
([yc
$row] - $y) < $thresh} {
5858 proc arrowjump
{id n y
} {
5861 # 1 <-> 2, 3 <-> 4, etc...
5862 set n
[expr {(($n - 1) ^
1) + 1}]
5863 set row
[lindex
[rowranges
$id] $n]
5865 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5866 if {$ymax eq
{} ||
$ymax <= 0} return
5867 set view
[$canv yview
]
5868 set yspan
[expr {[lindex
$view 1] - [lindex
$view 0]}]
5869 set yfrac
[expr {$yt / $ymax - $yspan / 2}]
5873 allcanvs yview moveto
$yfrac
5876 proc lineclick
{x y id isnew
} {
5877 global ctext commitinfo children canv thickerline curview commitrow
5879 if {![info exists commitinfo
($id)] && ![getcommit
$id]} return
5884 # draw this line thicker than normal
5888 set ymax
[lindex
[$canv cget
-scrollregion] 3]
5889 if {$ymax eq
{}} return
5890 set yfrac
[lindex
[$canv yview
] 0]
5891 set y
[expr {$y + $yfrac * $ymax}]
5893 set dirn
[clickisonarrow
$id $y]
5895 arrowjump
$id $dirn $y
5900 addtohistory
[list lineclick
$x $y $id 0]
5902 # fill the details pane with info about this line
5903 $ctext conf
-state normal
5906 $ctext insert end
"[mc "Parent
"]:\t"
5907 $ctext insert end
$id link0
5909 set info
$commitinfo($id)
5910 $ctext insert end
"\n\t[lindex $info 0]\n"
5911 $ctext insert end
"\t[mc "Author
"]:\t[lindex $info 1]\n"
5912 set date [formatdate
[lindex
$info 2]]
5913 $ctext insert end
"\t[mc "Date
"]:\t$date\n"
5914 set kids
$children($curview,$id)
5916 $ctext insert end
"\n[mc "Children
"]:"
5918 foreach child
$kids {
5920 if {![info exists commitinfo
($child)] && ![getcommit
$child]} continue
5921 set info
$commitinfo($child)
5922 $ctext insert end
"\n\t"
5923 $ctext insert end
$child link
$i
5924 setlink
$child link
$i
5925 $ctext insert end
"\n\t[lindex $info 0]"
5926 $ctext insert end
"\n\t[mc "Author
"]:\t[lindex $info 1]"
5927 set date [formatdate
[lindex
$info 2]]
5928 $ctext insert end
"\n\t[mc "Date
"]:\t$date\n"
5931 $ctext conf
-state disabled
5935 proc normalline
{} {
5937 if {[info exists thickerline
]} {
5945 global commitrow curview
5946 if {[info exists commitrow
($curview,$id)]} {
5947 selectline
$commitrow($curview,$id) 1
5953 if {![info exists startmstime
]} {
5954 set startmstime
[clock clicks
-milliseconds]
5956 return [format
"%.3f" [expr {([clock click
-milliseconds] - $startmstime) / 1000.0}]]
5959 proc rowmenu
{x y id
} {
5960 global rowctxmenu commitrow selectedline rowmenuid curview
5961 global nullid nullid2 fakerowmenu mainhead
5965 if {![info exists selectedline
]
5966 ||
$commitrow($curview,$id) eq
$selectedline} {
5971 if {$id ne
$nullid && $id ne
$nullid2} {
5972 set menu
$rowctxmenu
5973 $menu entryconfigure
7 -label [mc
"Reset %s branch to here" $mainhead]
5975 set menu
$fakerowmenu
5977 $menu entryconfigure
[mc
"Diff this -> selected"] -state $state
5978 $menu entryconfigure
[mc
"Diff selected -> this"] -state $state
5979 $menu entryconfigure
[mc
"Make patch"] -state $state
5980 tk_popup
$menu $x $y
5983 proc diffvssel
{dirn
} {
5984 global rowmenuid selectedline displayorder
5986 if {![info exists selectedline
]} return
5988 set oldid
[lindex
$displayorder $selectedline]
5989 set newid
$rowmenuid
5991 set oldid
$rowmenuid
5992 set newid
[lindex
$displayorder $selectedline]
5994 addtohistory
[list doseldiff
$oldid $newid]
5995 doseldiff
$oldid $newid
5998 proc doseldiff
{oldid newid
} {
6002 $ctext conf
-state normal
6004 init_flist
[mc
"Top"]
6005 $ctext insert end
"[mc "From
"] "
6006 $ctext insert end
$oldid link0
6007 setlink
$oldid link0
6008 $ctext insert end
"\n "
6009 $ctext insert end
[lindex
$commitinfo($oldid) 0]
6010 $ctext insert end
"\n\n[mc "To
"] "
6011 $ctext insert end
$newid link1
6012 setlink
$newid link1
6013 $ctext insert end
"\n "
6014 $ctext insert end
[lindex
$commitinfo($newid) 0]
6015 $ctext insert end
"\n"
6016 $ctext conf
-state disabled
6017 $ctext tag remove found
1.0 end
6018 startdiff
[list
$oldid $newid]
6022 global rowmenuid currentid commitinfo patchtop patchnum
6024 if {![info exists currentid
]} return
6025 set oldid
$currentid
6026 set oldhead
[lindex
$commitinfo($oldid) 0]
6027 set newid
$rowmenuid
6028 set newhead
[lindex
$commitinfo($newid) 0]
6031 catch
{destroy
$top}
6033 label
$top.title
-text [mc
"Generate patch"]
6034 grid
$top.title
- -pady 10
6035 label
$top.from
-text [mc
"From:"]
6036 entry
$top.fromsha1
-width 40 -relief flat
6037 $top.fromsha1 insert
0 $oldid
6038 $top.fromsha1 conf
-state readonly
6039 grid
$top.from
$top.fromsha1
-sticky w
6040 entry
$top.fromhead
-width 60 -relief flat
6041 $top.fromhead insert
0 $oldhead
6042 $top.fromhead conf
-state readonly
6043 grid x
$top.fromhead
-sticky w
6044 label
$top.to
-text [mc
"To:"]
6045 entry
$top.tosha1
-width 40 -relief flat
6046 $top.tosha1 insert
0 $newid
6047 $top.tosha1 conf
-state readonly
6048 grid
$top.to
$top.tosha1
-sticky w
6049 entry
$top.tohead
-width 60 -relief flat
6050 $top.tohead insert
0 $newhead
6051 $top.tohead conf
-state readonly
6052 grid x
$top.tohead
-sticky w
6053 button
$top.
rev -text [mc
"Reverse"] -command mkpatchrev
-padx 5
6054 grid
$top.
rev x
-pady 10
6055 label
$top.flab
-text [mc
"Output file:"]
6056 entry
$top.fname
-width 60
6057 $top.fname insert
0 [file normalize
"patch$patchnum.patch"]
6059 grid
$top.flab
$top.fname
-sticky w
6061 button
$top.buts.gen
-text [mc
"Generate"] -command mkpatchgo
6062 button
$top.buts.can
-text [mc
"Cancel"] -command mkpatchcan
6063 grid
$top.buts.gen
$top.buts.can
6064 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6065 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6066 grid
$top.buts
- -pady 10 -sticky ew
6070 proc mkpatchrev
{} {
6073 set oldid
[$patchtop.fromsha1 get
]
6074 set oldhead
[$patchtop.fromhead get
]
6075 set newid
[$patchtop.tosha1 get
]
6076 set newhead
[$patchtop.tohead get
]
6077 foreach e
[list fromsha1 fromhead tosha1 tohead
] \
6078 v
[list
$newid $newhead $oldid $oldhead] {
6079 $patchtop.
$e conf
-state normal
6080 $patchtop.
$e delete
0 end
6081 $patchtop.
$e insert
0 $v
6082 $patchtop.
$e conf
-state readonly
6087 global patchtop nullid nullid2
6089 set oldid
[$patchtop.fromsha1 get
]
6090 set newid
[$patchtop.tosha1 get
]
6091 set fname
[$patchtop.fname get
]
6092 set cmd
[diffcmd
[list
$oldid $newid] -p]
6093 # trim off the initial "|"
6094 set cmd
[lrange
$cmd 1 end
]
6095 lappend cmd
>$fname &
6096 if {[catch
{eval exec $cmd} err
]} {
6097 error_popup
"[mc "Error creating
patch:"] $err"
6099 catch
{destroy
$patchtop}
6103 proc mkpatchcan
{} {
6106 catch
{destroy
$patchtop}
6111 global rowmenuid mktagtop commitinfo
6115 catch
{destroy
$top}
6117 label
$top.title
-text [mc
"Create tag"]
6118 grid
$top.title
- -pady 10
6119 label
$top.id
-text [mc
"ID:"]
6120 entry
$top.sha1
-width 40 -relief flat
6121 $top.sha1 insert
0 $rowmenuid
6122 $top.sha1 conf
-state readonly
6123 grid
$top.id
$top.sha1
-sticky w
6124 entry
$top.
head -width 60 -relief flat
6125 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6126 $top.
head conf
-state readonly
6127 grid x
$top.
head -sticky w
6128 label
$top.tlab
-text [mc
"Tag name:"]
6129 entry
$top.tag
-width 60
6130 grid
$top.tlab
$top.tag
-sticky w
6132 button
$top.buts.gen
-text [mc
"Create"] -command mktaggo
6133 button
$top.buts.can
-text [mc
"Cancel"] -command mktagcan
6134 grid
$top.buts.gen
$top.buts.can
6135 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6136 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6137 grid
$top.buts
- -pady 10 -sticky ew
6142 global mktagtop env tagids idtags
6144 set id
[$mktagtop.sha1 get
]
6145 set tag
[$mktagtop.tag get
]
6147 error_popup
[mc
"No tag name specified"]
6150 if {[info exists tagids
($tag)]} {
6151 error_popup
[mc
"Tag \"%s\" already exists" $tag]
6155 exec git tag
$tag $id
6157 error_popup
"[mc "Error creating tag
:"] $err"
6161 set tagids
($tag) $id
6162 lappend idtags
($id) $tag
6169 proc redrawtags
{id
} {
6170 global canv linehtag commitrow idpos selectedline curview
6171 global canvxmax iddrawn
6173 if {![info exists commitrow
($curview,$id)]} return
6174 if {![info exists iddrawn
($id)]} return
6175 drawcommits
$commitrow($curview,$id)
6176 $canv delete tag.
$id
6177 set xt
[eval drawtags
$id $idpos($id)]
6178 $canv coords
$linehtag($commitrow($curview,$id)) $xt [lindex
$idpos($id) 2]
6179 set text
[$canv itemcget
$linehtag($commitrow($curview,$id)) -text]
6180 set xr
[expr {$xt + [font measure mainfont
$text]}]
6181 if {$xr > $canvxmax} {
6185 if {[info exists selectedline
]
6186 && $selectedline == $commitrow($curview,$id)} {
6187 selectline
$selectedline 0
6194 catch
{destroy
$mktagtop}
6203 proc writecommit
{} {
6204 global rowmenuid wrcomtop commitinfo wrcomcmd
6206 set top .writecommit
6208 catch
{destroy
$top}
6210 label
$top.title
-text [mc
"Write commit to file"]
6211 grid
$top.title
- -pady 10
6212 label
$top.id
-text [mc
"ID:"]
6213 entry
$top.sha1
-width 40 -relief flat
6214 $top.sha1 insert
0 $rowmenuid
6215 $top.sha1 conf
-state readonly
6216 grid
$top.id
$top.sha1
-sticky w
6217 entry
$top.
head -width 60 -relief flat
6218 $top.
head insert
0 [lindex
$commitinfo($rowmenuid) 0]
6219 $top.
head conf
-state readonly
6220 grid x
$top.
head -sticky w
6221 label
$top.clab
-text [mc
"Command:"]
6222 entry
$top.cmd
-width 60 -textvariable wrcomcmd
6223 grid
$top.clab
$top.cmd
-sticky w
-pady 10
6224 label
$top.flab
-text [mc
"Output file:"]
6225 entry
$top.fname
-width 60
6226 $top.fname insert
0 [file normalize
"commit-[string range $rowmenuid 0 6]"]
6227 grid
$top.flab
$top.fname
-sticky w
6229 button
$top.buts.gen
-text [mc
"Write"] -command wrcomgo
6230 button
$top.buts.can
-text [mc
"Cancel"] -command wrcomcan
6231 grid
$top.buts.gen
$top.buts.can
6232 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6233 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6234 grid
$top.buts
- -pady 10 -sticky ew
6241 set id
[$wrcomtop.sha1 get
]
6242 set cmd
"echo $id | [$wrcomtop.cmd get]"
6243 set fname
[$wrcomtop.fname get
]
6244 if {[catch
{exec sh
-c $cmd >$fname &} err
]} {
6245 error_popup
"[mc "Error writing commit
:"] $err"
6247 catch
{destroy
$wrcomtop}
6254 catch
{destroy
$wrcomtop}
6259 global rowmenuid mkbrtop
6262 catch
{destroy
$top}
6264 label
$top.title
-text [mc
"Create new branch"]
6265 grid
$top.title
- -pady 10
6266 label
$top.id
-text [mc
"ID:"]
6267 entry
$top.sha1
-width 40 -relief flat
6268 $top.sha1 insert
0 $rowmenuid
6269 $top.sha1 conf
-state readonly
6270 grid
$top.id
$top.sha1
-sticky w
6271 label
$top.nlab
-text [mc
"Name:"]
6272 entry
$top.name
-width 40
6273 grid
$top.nlab
$top.name
-sticky w
6275 button
$top.buts.go
-text [mc
"Create"] -command [list mkbrgo
$top]
6276 button
$top.buts.can
-text [mc
"Cancel"] -command "catch {destroy $top}"
6277 grid
$top.buts.go
$top.buts.can
6278 grid columnconfigure
$top.buts
0 -weight 1 -uniform a
6279 grid columnconfigure
$top.buts
1 -weight 1 -uniform a
6280 grid
$top.buts
- -pady 10 -sticky ew
6285 global headids idheads
6287 set name
[$top.name get
]
6288 set id
[$top.sha1 get
]
6290 error_popup
[mc
"Please specify a name for the new branch"]
6293 catch
{destroy
$top}
6297 exec git branch
$name $id
6302 set headids
($name) $id
6303 lappend idheads
($id) $name
6312 proc cherrypick
{} {
6313 global rowmenuid curview commitrow
6316 set oldhead
[exec git rev-parse HEAD
]
6317 set dheads
[descheads
$rowmenuid]
6318 if {$dheads ne
{} && [lsearch
-exact $dheads $oldhead] >= 0} {
6319 set ok
[confirm_popup
[mc
"Commit %s is already\
6320 included in branch %s -- really re-apply it?" \
6321 [string range
$rowmenuid 0 7] $mainhead]]
6324 nowbusy cherrypick
[mc
"Cherry-picking"]
6326 # Unfortunately git-cherry-pick writes stuff to stderr even when
6327 # no error occurs, and exec takes that as an indication of error...
6328 if {[catch
{exec sh
-c "git cherry-pick -r $rowmenuid 2>&1"} err
]} {
6333 set newhead
[exec git rev-parse HEAD
]
6334 if {$newhead eq
$oldhead} {
6336 error_popup
[mc
"No changes committed"]
6339 addnewchild
$newhead $oldhead
6340 if {[info exists commitrow
($curview,$oldhead)]} {
6341 insertrow
$commitrow($curview,$oldhead) $newhead
6342 if {$mainhead ne
{}} {
6343 movehead
$newhead $mainhead
6344 movedhead
$newhead $mainhead
6353 global mainheadid mainhead rowmenuid confirm_ok resettype
6356 set w
".confirmreset"
6359 wm title
$w [mc
"Confirm reset"]
6360 message
$w.m
-text \
6361 [mc
"Reset branch %s to %s?" $mainhead [string range
$rowmenuid 0 7]] \
6362 -justify center
-aspect 1000
6363 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
6364 frame
$w.f
-relief sunken
-border 2
6365 message
$w.f.rt
-text [mc
"Reset type:"] -aspect 1000
6366 grid
$w.f.rt
-sticky w
6368 radiobutton
$w.f.soft
-value soft
-variable resettype
-justify left \
6369 -text [mc
"Soft: Leave working tree and index untouched"]
6370 grid
$w.f.soft
-sticky w
6371 radiobutton
$w.f.mixed
-value mixed
-variable resettype
-justify left \
6372 -text [mc
"Mixed: Leave working tree untouched, reset index"]
6373 grid
$w.f.mixed
-sticky w
6374 radiobutton
$w.f.hard
-value hard
-variable resettype
-justify left \
6375 -text [mc
"Hard: Reset working tree and index\n(discard ALL local changes)"]
6376 grid
$w.f.hard
-sticky w
6377 pack
$w.f
-side top
-fill x
6378 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
6379 pack
$w.ok
-side left
-fill x
-padx 20 -pady 20
6380 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
6381 pack
$w.cancel
-side right
-fill x
-padx 20 -pady 20
6382 bind $w <Visibility
> "grab $w; focus $w"
6384 if {!$confirm_ok} return
6385 if {[catch
{set fd
[open \
6386 [list | sh
-c "git reset --$resettype $rowmenuid 2>&1"] r
]} err
]} {
6390 filerun
$fd [list readresetstat
$fd]
6391 nowbusy
reset [mc
"Resetting"]
6395 proc readresetstat
{fd
} {
6396 global mainhead mainheadid showlocalchanges rprogcoord
6398 if {[gets
$fd line
] >= 0} {
6399 if {[regexp
{([0-9]+)% \
(([0-9]+)/([0-9]+)\
)} $line match p m n
]} {
6400 set rprogcoord
[expr {1.0 * $m / $n}]
6408 if {[catch
{close
$fd} err
]} {
6411 set oldhead
$mainheadid
6412 set newhead
[exec git rev-parse HEAD
]
6413 if {$newhead ne
$oldhead} {
6414 movehead
$newhead $mainhead
6415 movedhead
$newhead $mainhead
6416 set mainheadid
$newhead
6420 if {$showlocalchanges} {
6426 # context menu for a head
6427 proc headmenu
{x y id
head} {
6428 global headmenuid headmenuhead headctxmenu mainhead
6432 set headmenuhead
$head
6434 if {$head eq
$mainhead} {
6437 $headctxmenu entryconfigure
0 -state $state
6438 $headctxmenu entryconfigure
1 -state $state
6439 tk_popup
$headctxmenu $x $y
6443 global headmenuid headmenuhead mainhead headids
6444 global showlocalchanges mainheadid
6446 # check the tree is clean first??
6447 set oldmainhead
$mainhead
6448 nowbusy checkout
[mc
"Checking out"]
6452 exec git checkout
-q $headmenuhead
6458 set mainhead
$headmenuhead
6459 set mainheadid
$headmenuid
6460 if {[info exists headids
($oldmainhead)]} {
6461 redrawtags
$headids($oldmainhead)
6463 redrawtags
$headmenuid
6465 if {$showlocalchanges} {
6471 global headmenuid headmenuhead mainhead
6474 set head $headmenuhead
6476 # this check shouldn't be needed any more...
6477 if {$head eq
$mainhead} {
6478 error_popup
[mc
"Cannot delete the currently checked-out branch"]
6481 set dheads
[descheads
$id]
6482 if {[llength
$dheads] == 1 && $idheads($dheads) eq
$head} {
6483 # the stuff on this branch isn't on any other branch
6484 if {![confirm_popup
[mc
"The commits on branch %s aren't on any other\
6485 branch.\nReally delete branch %s?" $head $head]]} return
6489 if {[catch
{exec git branch
-D $head} err
]} {
6494 removehead
$id $head
6495 removedhead
$id $head
6502 # Display a list of tags and heads
6504 global showrefstop bgcolor fgcolor selectbgcolor
6505 global bglist fglist reflistfilter reflist maincursor
6508 set showrefstop
$top
6509 if {[winfo exists
$top]} {
6515 wm title
$top [mc
"Tags and heads: %s" [file tail [pwd]]]
6516 text
$top.list
-background $bgcolor -foreground $fgcolor \
6517 -selectbackground $selectbgcolor -font mainfont \
6518 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6519 -width 30 -height 20 -cursor $maincursor \
6520 -spacing1 1 -spacing3 1 -state disabled
6521 $top.list tag configure highlight
-background $selectbgcolor
6522 lappend bglist
$top.list
6523 lappend fglist
$top.list
6524 scrollbar
$top.ysb
-command "$top.list yview" -orient vertical
6525 scrollbar
$top.xsb
-command "$top.list xview" -orient horizontal
6526 grid
$top.list
$top.ysb
-sticky nsew
6527 grid
$top.xsb x
-sticky ew
6529 label
$top.f.l
-text "[mc "Filter
"]: "
6530 entry
$top.f.e
-width 20 -textvariable reflistfilter
6531 set reflistfilter
"*"
6532 trace add variable reflistfilter
write reflistfilter_change
6533 pack
$top.f.e
-side right
-fill x
-expand 1
6534 pack
$top.f.l
-side left
6535 grid
$top.f
- -sticky ew
-pady 2
6536 button
$top.close
-command [list destroy
$top] -text [mc
"Close"]
6538 grid columnconfigure
$top 0 -weight 1
6539 grid rowconfigure
$top 0 -weight 1
6540 bind $top.list
<1> {break}
6541 bind $top.list
<B1-Motion
> {break}
6542 bind $top.list
<ButtonRelease-1
> {sel_reflist
%W
%x
%y
; break}
6547 proc sel_reflist
{w x y
} {
6548 global showrefstop reflist headids tagids otherrefids
6550 if {![winfo exists
$showrefstop]} return
6551 set l
[lindex
[split [$w index
"@$x,$y"] "."] 0]
6552 set ref
[lindex
$reflist [expr {$l-1}]]
6553 set n
[lindex
$ref 0]
6554 switch
-- [lindex
$ref 1] {
6555 "H" {selbyid
$headids($n)}
6556 "T" {selbyid
$tagids($n)}
6557 "o" {selbyid
$otherrefids($n)}
6559 $showrefstop.list tag add highlight
$l.0 "$l.0 lineend"
6562 proc unsel_reflist
{} {
6565 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6566 $showrefstop.list tag remove highlight
0.0 end
6569 proc reflistfilter_change
{n1 n2 op
} {
6570 global reflistfilter
6572 after cancel refill_reflist
6573 after
200 refill_reflist
6576 proc refill_reflist
{} {
6577 global reflist reflistfilter showrefstop headids tagids otherrefids
6578 global commitrow curview commitinterest
6580 if {![info exists showrefstop
] ||
![winfo exists
$showrefstop]} return
6582 foreach n
[array names headids
] {
6583 if {[string match
$reflistfilter $n]} {
6584 if {[info exists commitrow
($curview,$headids($n))]} {
6585 lappend refs
[list
$n H
]
6587 set commitinterest
($headids($n)) {run refill_reflist
}
6591 foreach n
[array names tagids
] {
6592 if {[string match
$reflistfilter $n]} {
6593 if {[info exists commitrow
($curview,$tagids($n))]} {
6594 lappend refs
[list
$n T
]
6596 set commitinterest
($tagids($n)) {run refill_reflist
}
6600 foreach n
[array names otherrefids
] {
6601 if {[string match
$reflistfilter $n]} {
6602 if {[info exists commitrow
($curview,$otherrefids($n))]} {
6603 lappend refs
[list
$n o
]
6605 set commitinterest
($otherrefids($n)) {run refill_reflist
}
6609 set refs
[lsort
-index 0 $refs]
6610 if {$refs eq
$reflist} return
6612 # Update the contents of $showrefstop.list according to the
6613 # differences between $reflist (old) and $refs (new)
6614 $showrefstop.list conf
-state normal
6615 $showrefstop.list insert end
"\n"
6618 while {$i < [llength
$reflist] ||
$j < [llength
$refs]} {
6619 if {$i < [llength
$reflist]} {
6620 if {$j < [llength
$refs]} {
6621 set cmp [string compare
[lindex
$reflist $i 0] \
6622 [lindex
$refs $j 0]]
6624 set cmp [string compare
[lindex
$reflist $i 1] \
6625 [lindex
$refs $j 1]]
6635 $showrefstop.list delete
"[expr {$j+1}].0" "[expr {$j+2}].0"
6643 set l
[expr {$j + 1}]
6644 $showrefstop.list image create
$l.0 -align baseline \
6645 -image reficon-
[lindex
$refs $j 1] -padx 2
6646 $showrefstop.list insert
$l.1 "[lindex $refs $j 0]\n"
6652 # delete last newline
6653 $showrefstop.list delete end-2c end-1c
6654 $showrefstop.list conf
-state disabled
6657 # Stuff for finding nearby tags
6658 proc getallcommits
{} {
6659 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6660 global idheads idtags idotherrefs allparents tagobjid
6662 if {![info exists allcommits
]} {
6668 set allccache
[file join [gitdir
] "gitk.cache"]
6670 set f
[open
$allccache r
]
6679 set cmd
[list | git rev-list
--parents]
6680 set allcupdate
[expr {$seeds ne
{}}]
6684 set refs
[concat
[array names idheads
] [array names idtags
] \
6685 [array names idotherrefs
]]
6688 foreach name
[array names tagobjid
] {
6689 lappend tagobjs
$tagobjid($name)
6691 foreach id
[lsort
-unique $refs] {
6692 if {![info exists allparents
($id)] &&
6693 [lsearch
-exact $tagobjs $id] < 0} {
6704 set fd
[open
[concat
$cmd $ids] r
]
6705 fconfigure
$fd -blocking 0
6708 filerun
$fd [list getallclines
$fd]
6714 # Since most commits have 1 parent and 1 child, we group strings of
6715 # such commits into "arcs" joining branch/merge points (BMPs), which
6716 # are commits that either don't have 1 parent or don't have 1 child.
6718 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6719 # arcout(id) - outgoing arcs for BMP
6720 # arcids(a) - list of IDs on arc including end but not start
6721 # arcstart(a) - BMP ID at start of arc
6722 # arcend(a) - BMP ID at end of arc
6723 # growing(a) - arc a is still growing
6724 # arctags(a) - IDs out of arcids (excluding end) that have tags
6725 # archeads(a) - IDs out of arcids (excluding end) that have heads
6726 # The start of an arc is at the descendent end, so "incoming" means
6727 # coming from descendents, and "outgoing" means going towards ancestors.
6729 proc getallclines
{fd
} {
6730 global allparents allchildren idtags idheads nextarc
6731 global arcnos arcids arctags arcout arcend arcstart archeads growing
6732 global seeds allcommits cachedarcs allcupdate
6735 while {[incr nid
] <= 1000 && [gets
$fd line
] >= 0} {
6736 set id
[lindex
$line 0]
6737 if {[info exists allparents
($id)]} {
6742 set olds
[lrange
$line 1 end
]
6743 set allparents
($id) $olds
6744 if {![info exists allchildren
($id)]} {
6745 set allchildren
($id) {}
6750 if {[llength
$olds] == 1 && [llength
$a] == 1} {
6751 lappend arcids
($a) $id
6752 if {[info exists idtags
($id)]} {
6753 lappend arctags
($a) $id
6755 if {[info exists idheads
($id)]} {
6756 lappend archeads
($a) $id
6758 if {[info exists allparents
($olds)]} {
6759 # seen parent already
6760 if {![info exists arcout
($olds)]} {
6763 lappend arcids
($a) $olds
6764 set arcend
($a) $olds
6767 lappend allchildren
($olds) $id
6768 lappend arcnos
($olds) $a
6772 foreach a
$arcnos($id) {
6773 lappend arcids
($a) $id
6780 lappend allchildren
($p) $id
6781 set a
[incr nextarc
]
6782 set arcstart
($a) $id
6789 if {[info exists allparents
($p)]} {
6790 # seen it already, may need to make a new branch
6791 if {![info exists arcout
($p)]} {
6794 lappend arcids
($a) $p
6798 lappend arcnos
($p) $a
6803 global cached_dheads cached_dtags cached_atags
6804 catch
{unset cached_dheads
}
6805 catch
{unset cached_dtags
}
6806 catch
{unset cached_atags
}
6809 return [expr {$nid >= 1000?
2: 1}]
6813 fconfigure
$fd -blocking 1
6816 # got an error reading the list of commits
6817 # if we were updating, try rereading the whole thing again
6823 error_popup
"[mc "Error reading commit topology information
;\
6824 branch and preceding
/following tag information\
6825 will be incomplete.
"]\n($err)"
6828 if {[incr allcommits
-1] == 0} {
6838 proc recalcarc
{a
} {
6839 global arctags archeads arcids idtags idheads
6843 foreach id
[lrange
$arcids($a) 0 end-1
] {
6844 if {[info exists idtags
($id)]} {
6847 if {[info exists idheads
($id)]} {
6852 set archeads
($a) $ah
6856 global arcnos arcids nextarc arctags archeads idtags idheads
6857 global arcstart arcend arcout allparents growing
6860 if {[llength
$a] != 1} {
6861 puts
"oops splitarc called but [llength $a] arcs already"
6865 set i
[lsearch
-exact $arcids($a) $p]
6867 puts
"oops splitarc $p not in arc $a"
6870 set na
[incr nextarc
]
6871 if {[info exists arcend
($a)]} {
6872 set arcend
($na) $arcend($a)
6874 set l
[lindex
$allparents([lindex
$arcids($a) end
]) 0]
6875 set j
[lsearch
-exact $arcnos($l) $a]
6876 set arcnos
($l) [lreplace
$arcnos($l) $j $j $na]
6878 set tail [lrange
$arcids($a) [expr {$i+1}] end
]
6879 set arcids
($a) [lrange
$arcids($a) 0 $i]
6881 set arcstart
($na) $p
6883 set arcids
($na) $tail
6884 if {[info exists growing
($a)]} {
6890 if {[llength
$arcnos($id)] == 1} {
6893 set j
[lsearch
-exact $arcnos($id) $a]
6894 set arcnos
($id) [lreplace
$arcnos($id) $j $j $na]
6898 # reconstruct tags and heads lists
6899 if {$arctags($a) ne
{} ||
$archeads($a) ne
{}} {
6904 set archeads
($na) {}
6908 # Update things for a new commit added that is a child of one
6909 # existing commit. Used when cherry-picking.
6910 proc addnewchild
{id p
} {
6911 global allparents allchildren idtags nextarc
6912 global arcnos arcids arctags arcout arcend arcstart archeads growing
6913 global seeds allcommits
6915 if {![info exists allcommits
] ||
![info exists arcnos
($p)]} return
6916 set allparents
($id) [list
$p]
6917 set allchildren
($id) {}
6920 lappend allchildren
($p) $id
6921 set a
[incr nextarc
]
6922 set arcstart
($a) $id
6925 set arcids
($a) [list
$p]
6927 if {![info exists arcout
($p)]} {
6930 lappend arcnos
($p) $a
6931 set arcout
($id) [list
$a]
6934 # This implements a cache for the topology information.
6935 # The cache saves, for each arc, the start and end of the arc,
6936 # the ids on the arc, and the outgoing arcs from the end.
6937 proc readcache
{f
} {
6938 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6939 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6944 if {$lim - $a > 500} {
6945 set lim
[expr {$a + 500}]
6949 # finish reading the cache and setting up arctags, etc.
6951 if {$line ne
"1"} {error
"bad final version"}
6953 foreach id
[array names idtags
] {
6954 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
6955 [llength
$allparents($id)] == 1} {
6956 set a
[lindex
$arcnos($id) 0]
6957 if {$arctags($a) eq
{}} {
6962 foreach id
[array names idheads
] {
6963 if {[info exists arcnos
($id)] && [llength
$arcnos($id)] == 1 &&
6964 [llength
$allparents($id)] == 1} {
6965 set a
[lindex
$arcnos($id) 0]
6966 if {$archeads($a) eq
{}} {
6971 foreach id
[lsort
-unique $possible_seeds] {
6972 if {$arcnos($id) eq
{}} {
6978 while {[incr a
] <= $lim} {
6980 if {[llength
$line] != 3} {error
"bad line"}
6981 set s
[lindex
$line 0]
6983 lappend arcout
($s) $a
6984 if {![info exists arcnos
($s)]} {
6985 lappend possible_seeds
$s
6988 set e
[lindex
$line 1]
6993 if {![info exists arcout
($e)]} {
6997 set arcids
($a) [lindex
$line 2]
6998 foreach id
$arcids($a) {
6999 lappend allparents
($s) $id
7001 lappend arcnos
($id) $a
7003 if {![info exists allparents
($s)]} {
7004 set allparents
($s) {}
7009 set nextarc
[expr {$a - 1}]
7022 global nextarc cachedarcs possible_seeds
7026 if {[llength
$line] != 2 ||
[lindex
$line 0] ne
"1"} {error
"bad version"}
7027 # make sure it's an integer
7028 set cachedarcs
[expr {int
([lindex
$line 1])}]
7029 if {$cachedarcs < 0} {error
"bad number of arcs"}
7031 set possible_seeds
{}
7039 proc dropcache
{err
} {
7040 global allcwait nextarc cachedarcs seeds
7042 #puts "dropping cache ($err)"
7043 foreach v
{arcnos arcout arcids arcstart arcend growing \
7044 arctags archeads allparents allchildren
} {
7055 proc writecache
{f
} {
7056 global cachearc cachedarcs allccache
7057 global arcstart arcend arcnos arcids arcout
7061 if {$lim - $a > 1000} {
7062 set lim
[expr {$a + 1000}]
7065 while {[incr a
] <= $lim} {
7066 if {[info exists arcend
($a)]} {
7067 puts
$f [list
$arcstart($a) $arcend($a) $arcids($a)]
7069 puts
$f [list
$arcstart($a) {} $arcids($a)]
7074 catch
{file delete
$allccache}
7075 #puts "writing cache failed ($err)"
7078 set cachearc
[expr {$a - 1}]
7079 if {$a > $cachedarcs} {
7088 global nextarc cachedarcs cachearc allccache
7090 if {$nextarc == $cachedarcs} return
7092 set cachedarcs
$nextarc
7094 set f
[open
$allccache w
]
7095 puts
$f [list
1 $cachedarcs]
7100 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7101 # or 0 if neither is true.
7102 proc anc_or_desc
{a b
} {
7103 global arcout arcstart arcend arcnos cached_isanc
7105 if {$arcnos($a) eq
$arcnos($b)} {
7106 # Both are on the same arc(s); either both are the same BMP,
7107 # or if one is not a BMP, the other is also not a BMP or is
7108 # the BMP at end of the arc (and it only has 1 incoming arc).
7109 # Or both can be BMPs with no incoming arcs.
7110 if {$a eq
$b ||
$arcnos($a) eq
{}} {
7113 # assert {[llength $arcnos($a)] == 1}
7114 set arc
[lindex
$arcnos($a) 0]
7115 set i
[lsearch
-exact $arcids($arc) $a]
7116 set j
[lsearch
-exact $arcids($arc) $b]
7117 if {$i < 0 ||
$i > $j} {
7124 if {![info exists arcout
($a)]} {
7125 set arc
[lindex
$arcnos($a) 0]
7126 if {[info exists arcend
($arc)]} {
7127 set aend
$arcend($arc)
7131 set a
$arcstart($arc)
7135 if {![info exists arcout
($b)]} {
7136 set arc
[lindex
$arcnos($b) 0]
7137 if {[info exists arcend
($arc)]} {
7138 set bend
$arcend($arc)
7142 set b
$arcstart($arc)
7152 if {[info exists cached_isanc
($a,$bend)]} {
7153 if {$cached_isanc($a,$bend)} {
7157 if {[info exists cached_isanc
($b,$aend)]} {
7158 if {$cached_isanc($b,$aend)} {
7161 if {[info exists cached_isanc
($a,$bend)]} {
7166 set todo
[list
$a $b]
7169 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7170 set x
[lindex
$todo $i]
7171 if {$anc($x) eq
{}} {
7174 foreach arc
$arcnos($x) {
7175 set xd
$arcstart($arc)
7177 set cached_isanc
($a,$bend) 1
7178 set cached_isanc
($b,$aend) 0
7180 } elseif
{$xd eq
$aend} {
7181 set cached_isanc
($b,$aend) 1
7182 set cached_isanc
($a,$bend) 0
7185 if {![info exists anc
($xd)]} {
7186 set anc
($xd) $anc($x)
7188 } elseif
{$anc($xd) ne
$anc($x)} {
7193 set cached_isanc
($a,$bend) 0
7194 set cached_isanc
($b,$aend) 0
7198 # This identifies whether $desc has an ancestor that is
7199 # a growing tip of the graph and which is not an ancestor of $anc
7200 # and returns 0 if so and 1 if not.
7201 # If we subsequently discover a tag on such a growing tip, and that
7202 # turns out to be a descendent of $anc (which it could, since we
7203 # don't necessarily see children before parents), then $desc
7204 # isn't a good choice to display as a descendent tag of
7205 # $anc (since it is the descendent of another tag which is
7206 # a descendent of $anc). Similarly, $anc isn't a good choice to
7207 # display as a ancestor tag of $desc.
7209 proc is_certain
{desc anc
} {
7210 global arcnos arcout arcstart arcend growing problems
7213 if {[llength
$arcnos($anc)] == 1} {
7214 # tags on the same arc are certain
7215 if {$arcnos($desc) eq
$arcnos($anc)} {
7218 if {![info exists arcout
($anc)]} {
7219 # if $anc is partway along an arc, use the start of the arc instead
7220 set a
[lindex
$arcnos($anc) 0]
7221 set anc
$arcstart($a)
7224 if {[llength
$arcnos($desc)] > 1 ||
[info exists arcout
($desc)]} {
7227 set a
[lindex
$arcnos($desc) 0]
7233 set anclist
[list
$x]
7237 for {set i
0} {$i < [llength
$anclist] && ($nnh > 0 ||
$ngrowanc > 0)} {incr i
} {
7238 set x
[lindex
$anclist $i]
7243 foreach a
$arcout($x) {
7244 if {[info exists growing
($a)]} {
7245 if {![info exists growanc
($x)] && $dl($x)} {
7251 if {[info exists dl
($y)]} {
7255 if {![info exists
done($y)]} {
7258 if {[info exists growanc
($x)]} {
7262 for {set k
0} {$k < [llength
$xl]} {incr k
} {
7263 set z
[lindex
$xl $k]
7264 foreach c
$arcout($z) {
7265 if {[info exists arcend
($c)]} {
7267 if {[info exists dl
($v)] && $dl($v)} {
7269 if {![info exists
done($v)]} {
7272 if {[info exists growanc
($v)]} {
7282 } elseif
{$y eq
$anc ||
!$dl($x)} {
7293 foreach x
[array names growanc
] {
7302 proc validate_arctags
{a
} {
7303 global arctags idtags
7307 foreach id
$arctags($a) {
7309 if {![info exists idtags
($id)]} {
7310 set na
[lreplace
$na $i $i]
7317 proc validate_archeads
{a
} {
7318 global archeads idheads
7321 set na
$archeads($a)
7322 foreach id
$archeads($a) {
7324 if {![info exists idheads
($id)]} {
7325 set na
[lreplace
$na $i $i]
7329 set archeads
($a) $na
7332 # Return the list of IDs that have tags that are descendents of id,
7333 # ignoring IDs that are descendents of IDs already reported.
7334 proc desctags
{id
} {
7335 global arcnos arcstart arcids arctags idtags allparents
7336 global growing cached_dtags
7338 if {![info exists allparents
($id)]} {
7341 set t1
[clock clicks
-milliseconds]
7343 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7344 # part-way along an arc; check that arc first
7345 set a
[lindex
$arcnos($id) 0]
7346 if {$arctags($a) ne
{}} {
7348 set i
[lsearch
-exact $arcids($a) $id]
7350 foreach t
$arctags($a) {
7351 set j
[lsearch
-exact $arcids($a) $t]
7359 set id
$arcstart($a)
7360 if {[info exists idtags
($id)]} {
7364 if {[info exists cached_dtags
($id)]} {
7365 return $cached_dtags($id)
7372 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7373 set id
[lindex
$todo $i]
7375 set ta
[info exists hastaggedancestor
($id)]
7379 # ignore tags on starting node
7380 if {!$ta && $i > 0} {
7381 if {[info exists idtags
($id)]} {
7384 } elseif
{[info exists cached_dtags
($id)]} {
7385 set tagloc
($id) $cached_dtags($id)
7389 foreach a
$arcnos($id) {
7391 if {!$ta && $arctags($a) ne
{}} {
7393 if {$arctags($a) ne
{}} {
7394 lappend tagloc
($id) [lindex
$arctags($a) end
]
7397 if {$ta ||
$arctags($a) ne
{}} {
7398 set tomark
[list
$d]
7399 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7400 set dd [lindex
$tomark $j]
7401 if {![info exists hastaggedancestor
($dd)]} {
7402 if {[info exists
done($dd)]} {
7403 foreach b
$arcnos($dd) {
7404 lappend tomark
$arcstart($b)
7406 if {[info exists tagloc
($dd)]} {
7409 } elseif
{[info exists queued
($dd)]} {
7412 set hastaggedancestor
($dd) 1
7416 if {![info exists queued
($d)]} {
7419 if {![info exists hastaggedancestor
($d)]} {
7426 foreach id
[array names tagloc
] {
7427 if {![info exists hastaggedancestor
($id)]} {
7428 foreach t
$tagloc($id) {
7429 if {[lsearch
-exact $tags $t] < 0} {
7435 set t2
[clock clicks
-milliseconds]
7438 # remove tags that are descendents of other tags
7439 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7440 set a
[lindex
$tags $i]
7441 for {set j
0} {$j < $i} {incr j
} {
7442 set b
[lindex
$tags $j]
7443 set r
[anc_or_desc
$a $b]
7445 set tags
[lreplace
$tags $j $j]
7448 } elseif
{$r == -1} {
7449 set tags
[lreplace
$tags $i $i]
7456 if {[array names growing
] ne
{}} {
7457 # graph isn't finished, need to check if any tag could get
7458 # eclipsed by another tag coming later. Simply ignore any
7459 # tags that could later get eclipsed.
7462 if {[is_certain
$t $origid]} {
7466 if {$tags eq
$ctags} {
7467 set cached_dtags
($origid) $tags
7472 set cached_dtags
($origid) $tags
7474 set t3
[clock clicks
-milliseconds]
7475 if {0 && $t3 - $t1 >= 100} {
7476 puts
"iterating descendents ($loopix/[llength $todo] nodes) took\
7477 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7483 global arcnos arcids arcout arcend arctags idtags allparents
7484 global growing cached_atags
7486 if {![info exists allparents
($id)]} {
7489 set t1
[clock clicks
-milliseconds]
7491 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7492 # part-way along an arc; check that arc first
7493 set a
[lindex
$arcnos($id) 0]
7494 if {$arctags($a) ne
{}} {
7496 set i
[lsearch
-exact $arcids($a) $id]
7497 foreach t
$arctags($a) {
7498 set j
[lsearch
-exact $arcids($a) $t]
7504 if {![info exists arcend
($a)]} {
7508 if {[info exists idtags
($id)]} {
7512 if {[info exists cached_atags
($id)]} {
7513 return $cached_atags($id)
7521 for {set i
0} {$i < [llength
$todo] && $nc > 0} {incr i
} {
7522 set id
[lindex
$todo $i]
7524 set td
[info exists hastaggeddescendent
($id)]
7528 # ignore tags on starting node
7529 if {!$td && $i > 0} {
7530 if {[info exists idtags
($id)]} {
7533 } elseif
{[info exists cached_atags
($id)]} {
7534 set tagloc
($id) $cached_atags($id)
7538 foreach a
$arcout($id) {
7539 if {!$td && $arctags($a) ne
{}} {
7541 if {$arctags($a) ne
{}} {
7542 lappend tagloc
($id) [lindex
$arctags($a) 0]
7545 if {![info exists arcend
($a)]} continue
7547 if {$td ||
$arctags($a) ne
{}} {
7548 set tomark
[list
$d]
7549 for {set j
0} {$j < [llength
$tomark]} {incr j
} {
7550 set dd [lindex
$tomark $j]
7551 if {![info exists hastaggeddescendent
($dd)]} {
7552 if {[info exists
done($dd)]} {
7553 foreach b
$arcout($dd) {
7554 if {[info exists arcend
($b)]} {
7555 lappend tomark
$arcend($b)
7558 if {[info exists tagloc
($dd)]} {
7561 } elseif
{[info exists queued
($dd)]} {
7564 set hastaggeddescendent
($dd) 1
7568 if {![info exists queued
($d)]} {
7571 if {![info exists hastaggeddescendent
($d)]} {
7577 set t2
[clock clicks
-milliseconds]
7580 foreach id
[array names tagloc
] {
7581 if {![info exists hastaggeddescendent
($id)]} {
7582 foreach t
$tagloc($id) {
7583 if {[lsearch
-exact $tags $t] < 0} {
7590 # remove tags that are ancestors of other tags
7591 for {set i
0} {$i < [llength
$tags]} {incr i
} {
7592 set a
[lindex
$tags $i]
7593 for {set j
0} {$j < $i} {incr j
} {
7594 set b
[lindex
$tags $j]
7595 set r
[anc_or_desc
$a $b]
7597 set tags
[lreplace
$tags $j $j]
7600 } elseif
{$r == 1} {
7601 set tags
[lreplace
$tags $i $i]
7608 if {[array names growing
] ne
{}} {
7609 # graph isn't finished, need to check if any tag could get
7610 # eclipsed by another tag coming later. Simply ignore any
7611 # tags that could later get eclipsed.
7614 if {[is_certain
$origid $t]} {
7618 if {$tags eq
$ctags} {
7619 set cached_atags
($origid) $tags
7624 set cached_atags
($origid) $tags
7626 set t3
[clock clicks
-milliseconds]
7627 if {0 && $t3 - $t1 >= 100} {
7628 puts
"iterating ancestors ($loopix/[llength $todo] nodes) took\
7629 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7634 # Return the list of IDs that have heads that are descendents of id,
7635 # including id itself if it has a head.
7636 proc descheads
{id
} {
7637 global arcnos arcstart arcids archeads idheads cached_dheads
7640 if {![info exists allparents
($id)]} {
7644 if {[llength
$arcnos($id)] == 1 && [llength
$allparents($id)] == 1} {
7645 # part-way along an arc; check it first
7646 set a
[lindex
$arcnos($id) 0]
7647 if {$archeads($a) ne
{}} {
7648 validate_archeads
$a
7649 set i
[lsearch
-exact $arcids($a) $id]
7650 foreach t
$archeads($a) {
7651 set j
[lsearch
-exact $arcids($a) $t]
7656 set id
$arcstart($a)
7662 for {set i
0} {$i < [llength
$todo]} {incr i
} {
7663 set id
[lindex
$todo $i]
7664 if {[info exists cached_dheads
($id)]} {
7665 set ret
[concat
$ret $cached_dheads($id)]
7667 if {[info exists idheads
($id)]} {
7670 foreach a
$arcnos($id) {
7671 if {$archeads($a) ne
{}} {
7672 validate_archeads
$a
7673 if {$archeads($a) ne
{}} {
7674 set ret
[concat
$ret $archeads($a)]
7678 if {![info exists seen
($d)]} {
7685 set ret
[lsort
-unique $ret]
7686 set cached_dheads
($origid) $ret
7687 return [concat
$ret $aret]
7690 proc addedtag
{id
} {
7691 global arcnos arcout cached_dtags cached_atags
7693 if {![info exists arcnos
($id)]} return
7694 if {![info exists arcout
($id)]} {
7695 recalcarc
[lindex
$arcnos($id) 0]
7697 catch
{unset cached_dtags
}
7698 catch
{unset cached_atags
}
7701 proc addedhead
{hid
head} {
7702 global arcnos arcout cached_dheads
7704 if {![info exists arcnos
($hid)]} return
7705 if {![info exists arcout
($hid)]} {
7706 recalcarc
[lindex
$arcnos($hid) 0]
7708 catch
{unset cached_dheads
}
7711 proc removedhead
{hid
head} {
7712 global cached_dheads
7714 catch
{unset cached_dheads
}
7717 proc movedhead
{hid
head} {
7718 global arcnos arcout cached_dheads
7720 if {![info exists arcnos
($hid)]} return
7721 if {![info exists arcout
($hid)]} {
7722 recalcarc
[lindex
$arcnos($hid) 0]
7724 catch
{unset cached_dheads
}
7727 proc changedrefs
{} {
7728 global cached_dheads cached_dtags cached_atags
7729 global arctags archeads arcnos arcout idheads idtags
7731 foreach id
[concat
[array names idheads
] [array names idtags
]] {
7732 if {[info exists arcnos
($id)] && ![info exists arcout
($id)]} {
7733 set a
[lindex
$arcnos($id) 0]
7734 if {![info exists donearc
($a)]} {
7740 catch
{unset cached_dtags
}
7741 catch
{unset cached_atags
}
7742 catch
{unset cached_dheads
}
7745 proc rereadrefs
{} {
7746 global idtags idheads idotherrefs mainhead
7748 set refids
[concat
[array names idtags
] \
7749 [array names idheads
] [array names idotherrefs
]]
7750 foreach id
$refids {
7751 if {![info exists ref
($id)]} {
7752 set ref
($id) [listrefs
$id]
7755 set oldmainhead
$mainhead
7758 set refids
[lsort
-unique [concat
$refids [array names idtags
] \
7759 [array names idheads
] [array names idotherrefs
]]]
7760 foreach id
$refids {
7761 set v
[listrefs
$id]
7762 if {![info exists ref
($id)] ||
$ref($id) != $v ||
7763 ($id eq
$oldmainhead && $id ne
$mainhead) ||
7764 ($id eq
$mainhead && $id ne
$oldmainhead)} {
7771 proc listrefs
{id
} {
7772 global idtags idheads idotherrefs
7775 if {[info exists idtags
($id)]} {
7779 if {[info exists idheads
($id)]} {
7783 if {[info exists idotherrefs
($id)]} {
7784 set z
$idotherrefs($id)
7786 return [list
$x $y $z]
7789 proc showtag
{tag isnew
} {
7790 global ctext tagcontents tagids linknum tagobjid
7793 addtohistory
[list showtag
$tag 0]
7795 $ctext conf
-state normal
7799 if {![info exists tagcontents
($tag)]} {
7801 set tagcontents
($tag) [exec git cat-file tag
$tagobjid($tag)]
7804 if {[info exists tagcontents
($tag)]} {
7805 set text
$tagcontents($tag)
7807 set text
"[mc "Tag
"]: $tag\n[mc "Id
"]: $tagids($tag)"
7809 appendwithlinks
$text {}
7810 $ctext conf
-state disabled
7821 proc mkfontdisp
{font top
which} {
7822 global fontattr fontpref
$font
7824 set fontpref
($font) [set $font]
7825 button
$top.
${font}but
-text $which -font optionfont \
7826 -command [list choosefont
$font $which]
7827 label
$top.
$font -relief flat
-font $font \
7828 -text $fontattr($font,family
) -justify left
7829 grid x
$top.
${font}but
$top.
$font -sticky w
7832 proc choosefont
{font
which} {
7833 global fontparam fontlist fonttop fontattr
7835 set fontparam
(which) $which
7836 set fontparam
(font
) $font
7837 set fontparam
(family
) [font actual
$font -family]
7838 set fontparam
(size
) $fontattr($font,size
)
7839 set fontparam
(weight
) $fontattr($font,weight
)
7840 set fontparam
(slant
) $fontattr($font,slant
)
7843 if {![winfo exists
$top]} {
7845 eval font config sample
[font actual
$font]
7847 wm title
$top [mc
"Gitk font chooser"]
7848 label
$top.l
-textvariable fontparam
(which)
7849 pack
$top.l
-side top
7850 set fontlist
[lsort
[font families
]]
7852 listbox
$top.f.fam
-listvariable fontlist \
7853 -yscrollcommand [list
$top.f.sb
set]
7854 bind $top.f.fam
<<ListboxSelect>> selfontfam
7855 scrollbar $top.f.sb -command [list $top.f.fam yview]
7856 pack $top.f.sb -side right -fill y
7857 pack $top.f.fam -side left -fill both -expand 1
7858 pack $top.f -side top -fill both -expand 1
7860 spinbox $top.g.size -from 4 -to 40 -width 4 \
7861 -textvariable fontparam(size) \
7862 -validatecommand {string is integer -strict %s}
7863 checkbutton $top.g.bold -padx 5 \
7864 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7865 -variable fontparam(weight) -onvalue bold -offvalue normal
7866 checkbutton $top.g.ital -padx 5 \
7867 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7868 -variable fontparam(slant) -onvalue italic -offvalue roman
7869 pack $top.g.size $top.g.bold $top.g.ital -side left
7870 pack $top.g -side top
7871 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7873 $top.c create text 100 25 -anchor center -text $which -font sample \
7874 -fill black -tags text
7875 bind $top.c <Configure> [list centertext $top.c]
7876 pack $top.c -side top -fill x
7878 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7879 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7880 grid $top.buts.ok $top.buts.can
7881 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7882 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7883 pack $top.buts -side bottom -fill x
7884 trace add variable fontparam write chg_fontparam
7887 $top.c itemconf text -text $which
7889 set i [lsearch -exact $fontlist $fontparam(family)]
7891 $top.f.fam selection set $i
7896 proc centertext {w} {
7897 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7901 global fontparam fontpref prefstop
7903 set f $fontparam(font)
7904 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7905 if {$fontparam(weight) eq "bold"} {
7906 lappend fontpref($f) "bold"
7908 if {$fontparam(slant) eq "italic"} {
7909 lappend fontpref($f) "italic"
7912 $w conf -text $fontparam(family) -font $fontpref($f)
7918 global fonttop fontparam
7920 if {[info exists fonttop]} {
7921 catch {destroy $fonttop}
7922 catch {font delete sample}
7928 proc selfontfam {} {
7929 global fonttop fontparam
7931 set i [$fonttop.f.fam curselection]
7933 set fontparam(family) [$fonttop.f.fam get $i]
7937 proc chg_fontparam {v sub op} {
7940 font config sample -$sub $fontparam($sub)
7944 global maxwidth maxgraphpct
7945 global oldprefs prefstop showneartags showlocalchanges
7946 global bgcolor fgcolor ctext diffcolors selectbgcolor
7947 global tabstop limitdiffs
7951 if {[winfo exists $top]} {
7955 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7956 limitdiffs tabstop} {
7957 set oldprefs($v) [set $v]
7960 wm title $top [mc "Gitk preferences"]
7961 label $top.ldisp -text [mc "Commit list display options"]
7962 grid $top.ldisp - -sticky w -pady 10
7963 label $top.spacer -text " "
7964 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7966 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7967 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7968 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7970 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7971 grid x $top.maxpctl $top.maxpct -sticky w
7972 frame $top.showlocal
7973 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7974 checkbutton $top.showlocal.b -variable showlocalchanges
7975 pack $top.showlocal.b $top.showlocal.l -side left
7976 grid x $top.showlocal -sticky w
7978 label $top.ddisp -text [mc "Diff display options"]
7979 grid $top.ddisp - -sticky w -pady 10
7980 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7981 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7982 grid x $top.tabstopl $top.tabstop -sticky w
7984 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7985 checkbutton $top.ntag.b -variable showneartags
7986 pack $top.ntag.b $top.ntag.l -side left
7987 grid x $top.ntag -sticky w
7989 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7990 checkbutton $top.ldiff.b -variable limitdiffs
7991 pack $top.ldiff.b $top.ldiff.l -side left
7992 grid x $top.ldiff -sticky w
7994 label $top.cdisp -text [mc "Colors: press to choose"]
7995 grid $top.cdisp - -sticky w -pady 10
7996 label $top.bg -padx 40 -relief sunk -background $bgcolor
7997 button $top.bgbut -text [mc "Background"] -font optionfont \
7998 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7999 grid x $top.bgbut $top.bg -sticky w
8000 label $top.fg -padx 40 -relief sunk -background $fgcolor
8001 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8002 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8003 grid x $top.fgbut $top.fg -sticky w
8004 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8005 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8006 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8007 [list $ctext tag conf d0 -foreground]]
8008 grid x $top.diffoldbut $top.diffold -sticky w
8009 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8010 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8011 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8012 [list $ctext tag conf d1 -foreground]]
8013 grid x $top.diffnewbut $top.diffnew -sticky w
8014 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8015 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8016 -command [list choosecolor diffcolors 2 $top.hunksep \
8017 "diff hunk header" \
8018 [list $ctext tag conf hunksep -foreground]]
8019 grid x $top.hunksepbut $top.hunksep -sticky w
8020 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8021 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8022 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8023 grid x $top.selbgbut $top.selbgsep -sticky w
8025 label $top.cfont -text [mc "Fonts: press to choose"]
8026 grid $top.cfont - -sticky w -pady 10
8027 mkfontdisp mainfont $top [mc "Main font"]
8028 mkfontdisp textfont $top [mc "Diff display font"]
8029 mkfontdisp uifont $top [mc "User interface font"]
8032 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8033 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8034 grid $top.buts.ok $top.buts.can
8035 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8036 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8037 grid $top.buts - - -pady 10 -sticky ew
8038 bind $top <Visibility> "focus $top.buts.ok"
8041 proc choosecolor {v vi w x cmd} {
8044 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8045 -title [mc "Gitk: choose color for %s" $x]]
8046 if {$c eq {}} return
8047 $w conf -background $c
8053 global bglist cflist
8055 $w configure -selectbackground $c
8057 $cflist tag configure highlight \
8058 -background [$cflist cget -selectbackground]
8059 allcanvs itemconf secsel -fill $c
8066 $w conf -background $c
8074 $w conf -foreground $c
8076 allcanvs itemconf text -fill $c
8077 $canv itemconf circle -outline $c
8081 global oldprefs prefstop
8083 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8084 limitdiffs tabstop} {
8086 set $v $oldprefs($v)
8088 catch {destroy $prefstop}
8094 global maxwidth maxgraphpct
8095 global oldprefs prefstop showneartags showlocalchanges
8096 global fontpref mainfont textfont uifont
8097 global limitdiffs treediffs
8099 catch {destroy $prefstop}
8103 if {$mainfont ne $fontpref(mainfont)} {
8104 set mainfont $fontpref(mainfont)
8105 parsefont mainfont $mainfont
8106 eval font configure mainfont [fontflags mainfont]
8107 eval font configure mainfontbold [fontflags mainfont 1]
8111 if {$textfont ne $fontpref(textfont)} {
8112 set textfont $fontpref(textfont)
8113 parsefont textfont $textfont
8114 eval font configure textfont [fontflags textfont]
8115 eval font configure textfontbold [fontflags textfont 1]
8117 if {$uifont ne $fontpref(uifont)} {
8118 set uifont $fontpref(uifont)
8119 parsefont uifont $uifont
8120 eval font configure uifont [fontflags uifont]
8123 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8124 if {$showlocalchanges} {
8130 if {$limitdiffs != $oldprefs(limitdiffs)} {
8131 # treediffs elements are limited by path
8132 catch {unset treediffs}
8134 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8135 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8137 } elseif {$showneartags != $oldprefs(showneartags) ||
8138 $limitdiffs != $oldprefs(limitdiffs)} {
8143 proc formatdate {d} {
8144 global datetimeformat
8146 set d [clock format $d -format $datetimeformat]
8151 # This list of encoding names and aliases is distilled from
8152 # http://www.iana.org/assignments/character-sets.
8153 # Not all of them are supported by Tcl.
8154 set encoding_aliases {
8155 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8156 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8157 { ISO-10646-UTF-1 csISO10646UTF1 }
8158 { ISO_646.basic:1983 ref csISO646basic1983 }
8159 { INVARIANT csINVARIANT }
8160 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8161 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8162 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8163 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8164 { NATS-DANO iso-ir-9-1 csNATSDANO }
8165 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8166 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8167 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8168 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8169 { ISO-2022-KR csISO2022KR }
8171 { ISO-2022-JP csISO2022JP }
8172 { ISO-2022-JP-2 csISO2022JP2 }
8173 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8175 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8176 { IT iso-ir-15 ISO646-IT csISO15Italian }
8177 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8178 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8179 { greek7-old iso-ir-18 csISO18Greek7Old }
8180 { latin-greek iso-ir-19 csISO19LatinGreek }
8181 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8182 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8183 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8184 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8185 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8186 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8187 { INIS iso-ir-49 csISO49INIS }
8188 { INIS-8 iso-ir-50 csISO50INIS8 }
8189 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8190 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8191 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8192 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8193 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8194 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8196 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8197 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8198 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8199 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8200 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8201 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8202 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8203 { greek7 iso-ir-88 csISO88Greek7 }
8204 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8205 { iso-ir-90 csISO90 }
8206 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8207 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8208 csISO92JISC62991984b }
8209 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8210 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8211 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8212 csISO95JIS62291984handadd }
8213 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8214 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8215 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8216 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8218 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8219 { T.61-7bit iso-ir-102 csISO102T617bit }
8220 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8221 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8222 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8223 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8224 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8225 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8226 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8227 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8228 arabic csISOLatinArabic }
8229 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8230 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8231 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8232 greek greek8 csISOLatinGreek }
8233 { T.101-G2 iso-ir-128 csISO128T101G2 }
8234 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8236 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8237 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8238 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8239 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8240 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8241 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8242 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8243 csISOLatinCyrillic }
8244 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8245 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8246 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8247 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8248 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8249 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8250 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8251 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8252 { ISO_10367-box iso-ir-155 csISO10367Box }
8253 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8254 { latin-lap lap iso-ir-158 csISO158Lap }
8255 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8256 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8259 { JIS_X0201 X0201 csHalfWidthKatakana }
8260 { KSC5636 ISO646-KR csKSC5636 }
8261 { ISO-10646-UCS-2 csUnicode }
8262 { ISO-10646-UCS-4 csUCS4 }
8263 { DEC-MCS dec csDECMCS }
8264 { hp-roman8 roman8 r8 csHPRoman8 }
8265 { macintosh mac csMacintosh }
8266 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8268 { IBM038 EBCDIC-INT cp038 csIBM038 }
8269 { IBM273 CP273 csIBM273 }
8270 { IBM274 EBCDIC-BE CP274 csIBM274 }
8271 { IBM275 EBCDIC-BR cp275 csIBM275 }
8272 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8273 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8274 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8275 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8276 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8277 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8278 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8279 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8280 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8281 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8282 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8283 { IBM437 cp437 437 csPC8CodePage437 }
8284 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8285 { IBM775 cp775 csPC775Baltic }
8286 { IBM850 cp850 850 csPC850Multilingual }
8287 { IBM851 cp851 851 csIBM851 }
8288 { IBM852 cp852 852 csPCp852 }
8289 { IBM855 cp855 855 csIBM855 }
8290 { IBM857 cp857 857 csIBM857 }
8291 { IBM860 cp860 860 csIBM860 }
8292 { IBM861 cp861 861 cp-is csIBM861 }
8293 { IBM862 cp862 862 csPC862LatinHebrew }
8294 { IBM863 cp863 863 csIBM863 }
8295 { IBM864 cp864 csIBM864 }
8296 { IBM865 cp865 865 csIBM865 }
8297 { IBM866 cp866 866 csIBM866 }
8298 { IBM868 CP868 cp-ar csIBM868 }
8299 { IBM869 cp869 869 cp-gr csIBM869 }
8300 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8301 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8302 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8303 { IBM891 cp891 csIBM891 }
8304 { IBM903 cp903 csIBM903 }
8305 { IBM904 cp904 904 csIBBM904 }
8306 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8307 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8308 { IBM1026 CP1026 csIBM1026 }
8309 { EBCDIC-AT-DE csIBMEBCDICATDE }
8310 { EBCDIC-AT-DE-A csEBCDICATDEA }
8311 { EBCDIC-CA-FR csEBCDICCAFR }
8312 { EBCDIC-DK-NO csEBCDICDKNO }
8313 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8314 { EBCDIC-FI-SE csEBCDICFISE }
8315 { EBCDIC-FI-SE-A csEBCDICFISEA }
8316 { EBCDIC-FR csEBCDICFR }
8317 { EBCDIC-IT csEBCDICIT }
8318 { EBCDIC-PT csEBCDICPT }
8319 { EBCDIC-ES csEBCDICES }
8320 { EBCDIC-ES-A csEBCDICESA }
8321 { EBCDIC-ES-S csEBCDICESS }
8322 { EBCDIC-UK csEBCDICUK }
8323 { EBCDIC-US csEBCDICUS }
8324 { UNKNOWN-8BIT csUnknown8BiT }
8325 { MNEMONIC csMnemonic }
8330 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8331 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8332 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8333 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8334 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8335 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8336 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8337 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8338 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8339 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8340 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8341 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8342 { IBM1047 IBM-1047 }
8343 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8344 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8345 { UNICODE-1-1 csUnicode11 }
8348 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8349 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8351 { ISO-8859-15 ISO_8859-15 Latin-9 }
8352 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8353 { GBK CP936 MS936 windows-936 }
8354 { JIS_Encoding csJISEncoding }
8355 { Shift_JIS MS_Kanji csShiftJIS }
8356 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8358 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8359 { ISO-10646-UCS-Basic csUnicodeASCII }
8360 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8361 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8362 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8363 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8364 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8365 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8366 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8367 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8368 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8369 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8370 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8371 { Ventura-US csVenturaUS }
8372 { Ventura-International csVenturaInternational }
8373 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8374 { PC8-Turkish csPC8Turkish }
8375 { IBM-Symbols csIBMSymbols }
8376 { IBM-Thai csIBMThai }
8377 { HP-Legal csHPLegal }
8378 { HP-Pi-font csHPPiFont }
8379 { HP-Math8 csHPMath8 }
8380 { Adobe-Symbol-Encoding csHPPSMath }
8381 { HP-DeskTop csHPDesktop }
8382 { Ventura-Math csVenturaMath }
8383 { Microsoft-Publishing csMicrosoftPublishing }
8384 { Windows-31J csWindows31J }
8389 proc tcl_encoding {enc} {
8390 global encoding_aliases
8391 set names [encoding names]
8392 set lcnames [string tolower $names]
8393 set enc [string tolower $enc]
8394 set i [lsearch -exact $lcnames $enc]
8396 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8397 if {[regsub {^iso[-_]} $enc iso encx]} {
8398 set i [lsearch -exact $lcnames $encx]
8402 foreach l $encoding_aliases {
8403 set ll [string tolower $l]
8404 if {[lsearch -exact $ll $enc] < 0} continue
8405 # look through the aliases for one that tcl knows about
8407 set i [lsearch -exact $lcnames $e]
8409 if {[regsub {^iso[-_]} $e iso ex]} {
8410 set i [lsearch -exact $lcnames $ex]
8419 return [lindex $names $i]
8424 # First check that Tcl/Tk is recent enough
8425 if {[catch {package require Tk 8.4} err]} {
8426 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8427 Gitk requires at least Tcl/Tk 8.4."]
8433 set wrcomcmd "git diff-tree --stdin -p --pretty"
8437 set gitencoding [exec git config --get i18n.commitencoding]
8439 if {$gitencoding == ""} {
8440 set gitencoding "utf-8"
8442 set tclencoding [tcl_encoding $gitencoding]
8443 if {$tclencoding == {}} {
8444 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8447 set mainfont {Helvetica 9}
8448 set textfont {Courier 9}
8449 set uifont {Helvetica 9 bold}
8451 set findmergefiles 0
8459 set cmitmode "patch"
8460 set wrapcomment "none"
8464 set showlocalchanges 1
8466 set datetimeformat "%Y-%m-%d %H:%M:%S"
8468 set colors {green red blue magenta darkgrey brown orange}
8471 set diffcolors {red "#00a000" blue}
8474 set selectbgcolor gray85
8476 ## For msgcat loading, first locate the installation location.
8477 if { [info exists ::env(GITK_MSGSDIR)] } {
8478 ## Msgsdir was manually set in the environment.
8479 set gitk_msgsdir $::env(GITK_MSGSDIR)
8481 ## Let's guess the prefix from argv0.
8482 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8483 set gitk_libdir [file join $gitk_prefix share gitk lib]
8484 set gitk_msgsdir [file join $gitk_libdir msgs]
8488 ## Internationalization (i18n) through msgcat and gettext. See
8489 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8490 package require msgcat
8491 namespace import ::msgcat::mc
8492 ## And eventually load the actual message catalog
8493 ::msgcat::mcload $gitk_msgsdir
8495 catch {source ~/.gitk}
8497 font create optionfont -family sans-serif -size -12
8499 parsefont mainfont $mainfont
8500 eval font create mainfont [fontflags mainfont]
8501 eval font create mainfontbold [fontflags mainfont 1]
8503 parsefont textfont $textfont
8504 eval font create textfont [fontflags textfont]
8505 eval font create textfontbold [fontflags textfont 1]
8507 parsefont uifont $uifont
8508 eval font create uifont [fontflags uifont]
8512 # check that we can find a .git directory somewhere...
8513 if {[catch {set gitdir [gitdir]}]} {
8514 show_error {} . [mc "Cannot find a git repository here."]
8517 if {![file isdirectory $gitdir]} {
8518 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8524 set cmdline_files {}
8529 "-d" { set datemode 1 }
8532 lappend revtreeargs $arg
8535 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8539 lappend revtreeargs $arg
8545 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8546 # no -- on command line, but some arguments (other than -d)
8548 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8549 set cmdline_files [split $f "\n"]
8550 set n [llength $cmdline_files]
8551 set revtreeargs [lrange $revtreeargs 0 end-$n]
8552 # Unfortunately git rev-parse doesn't produce an error when
8553 # something is both a revision and a filename. To be consistent
8554 # with git log and git rev-list, check revtreeargs for filenames.
8555 foreach arg $revtreeargs {
8556 if {[file exists $arg]} {
8557 show_error {} . [mc "Ambiguous argument '%s': both revision\
8563 # unfortunately we get both stdout and stderr in $err,
8564 # so look for "fatal:".
8565 set i [string first "fatal:" $err]
8567 set err [string range $err [expr {$i + 6}] end]
8569 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8575 # find the list of unmerged files
8579 set fd [open "| git ls-files -u" r]
8581 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8584 while {[gets $fd line] >= 0} {
8585 set i [string first "\t" $line]
8586 if {$i < 0} continue
8587 set fname [string range $line [expr {$i+1}] end]
8588 if {[lsearch -exact $mlist $fname] >= 0} continue
8590 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8591 lappend mlist $fname
8596 if {$nr_unmerged == 0} {
8597 show_error {} . [mc "No files selected: --merge specified but\
8598 no files are unmerged."]
8600 show_error {} . [mc "No files selected: --merge specified but\
8601 no unmerged files are within file limit."]
8605 set cmdline_files $mlist
8608 set nullid "0000000000000000000000000000000000000000"
8609 set nullid2 "0000000000000000000000000000000000000001"
8611 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8618 set highlight_paths {}
8620 set searchdirn -forwards
8624 set markingmatches 0
8625 set linkentercount 0
8626 set need_redisplay 0
8633 set selectedhlview [mc "None"]
8634 set highlight_related [mc "None"]
8635 set highlight_files {}
8649 # wait for the window to become visible
8651 wm title . "[file tail $argv0]: [file tail [pwd]]"
8654 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8655 # create a view for the files/dirs specified on the command line
8659 set viewname(1) [mc "Command line"]
8660 set viewfiles(1) $cmdline_files
8661 set viewargs(1) $revtreeargs
8664 .bar.view entryconf [mc "Edit view..."] -state normal
8665 .bar.view entryconf [mc "Delete view"] -state normal
8668 if {[info exists permviews]} {
8669 foreach v $permviews {
8672 set viewname($n) [lindex $v 0]
8673 set viewfiles($n) [lindex $v 1]
8674 set viewargs($n) [lindex $v 2]