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 file rename -force "~/.gitk-new" "~/.gitk"
1212 proc resizeclistpanes {win w} {
1214 if {[info exists oldwidth($win)]} {
1215 set s0 [$win sash coord 0]
1216 set s1 [$win sash coord 1]
1218 set sash0 [expr {int($w/2 - 2)}]
1219 set sash1 [expr {int($w*5/6 - 2)}]
1221 set factor [expr {1.0 * $w / $oldwidth($win)}]
1222 set sash0 [expr {int($factor * [lindex $s0 0])}]
1223 set sash1 [expr {int($factor * [lindex $s1 0])}]
1227 if {$sash1 < $sash0 + 20} {
1228 set sash1 [expr {$sash0 + 20}]
1230 if {$sash1 > $w - 10} {
1231 set sash1 [expr {$w - 10}]
1232 if {$sash0 > $sash1 - 20} {
1233 set sash0 [expr {$sash1 - 20}]
1237 $win sash place 0 $sash0 [lindex $s0 1]
1238 $win sash place 1 $sash1 [lindex $s1 1]
1240 set oldwidth($win) $w
1243 proc resizecdetpanes {win w} {
1245 if {[info exists oldwidth($win)]} {
1246 set s0 [$win sash coord 0]
1248 set sash0 [expr {int($w*3/4 - 2)}]
1250 set factor [expr {1.0 * $w / $oldwidth($win)}]
1251 set sash0 [expr {int($factor * [lindex $s0 0])}]
1255 if {$sash0 > $w - 15} {
1256 set sash0 [expr {$w - 15}]
1259 $win sash place 0 $sash0 [lindex $s0 1]
1261 set oldwidth($win) $w
1264 proc allcanvs args {
1265 global canv canv2 canv3
1271 proc bindall {event action} {
1272 global canv canv2 canv3
1273 bind $canv $event $action
1274 bind $canv2 $event $action
1275 bind $canv3 $event $action
1281 if {[winfo exists $w]} {
1286 wm title $w [mc "About gitk"]
1287 message $w.m -text [mc "
1288 Gitk - a commit viewer for git
1290 Copyright © 2005-2006 Paul Mackerras
1292 Use and redistribute under the terms of the GNU General Public License"] \
1293 -justify center -aspect 400 -border 2 -bg white -relief groove
1294 pack $w.m -side top -fill x -padx 2 -pady 2
1295 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1296 pack $w.ok -side bottom
1297 bind $w <Visibility> "focus $w.ok"
1298 bind $w <Key-Escape> "destroy $w"
1299 bind $w <Key-Return> "destroy $w"
1304 if {[winfo exists $w]} {
1308 if {[tk windowingsystem] eq {aqua}} {
1314 wm title $w [mc "Gitk key bindings"]
1315 message $w.m -text "
1316 [mc "Gitk key bindings:"]
1318 [mc "<%s-Q> Quit" $M1T]
1319 [mc "<Home> Move to first commit"]
1320 [mc "<End> Move to last commit"]
1321 [mc "<Up>, p, i Move up one commit"]
1322 [mc "<Down>, n, k Move down one commit"]
1323 [mc "<Left>, z, j Go back in history list"]
1324 [mc "<Right>, x, l Go forward in history list"]
1325 [mc "<PageUp> Move up one page in commit list"]
1326 [mc "<PageDown> Move down one page in commit list"]
1327 [mc "<%s-Home> Scroll to top of commit list" $M1T]
1328 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
1329 [mc "<%s-Up> Scroll commit list up one line" $M1T]
1330 [mc "<%s-Down> Scroll commit list down one line" $M1T]
1331 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
1332 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
1333 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
1334 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
1335 [mc "<Delete>, b Scroll diff view up one page"]
1336 [mc "<Backspace> Scroll diff view up one page"]
1337 [mc "<Space> Scroll diff view down one page"]
1338 [mc "u Scroll diff view up 18 lines"]
1339 [mc "d Scroll diff view down 18 lines"]
1340 [mc "<%s-F> Find" $M1T]
1341 [mc "<%s-G> Move to next find hit" $M1T]
1342 [mc "<Return> Move to next find hit"]
1343 [mc "/ Move to next find hit, or redo find"]
1344 [mc "? Move to previous find hit"]
1345 [mc "f Scroll diff view to next file"]
1346 [mc "<%s-S> Search for next hit in diff view" $M1T]
1347 [mc "<%s-R> Search for previous hit in diff view" $M1T]
1348 [mc "<%s-KP+> Increase font size" $M1T]
1349 [mc "<%s-plus> Increase font size" $M1T]
1350 [mc "<%s-KP-> Decrease font size" $M1T]
1351 [mc "<%s-minus> Decrease font size" $M1T]
1354 -justify left -bg white -border 2 -relief groove
1355 pack $w.m -side top -fill both -padx 2 -pady 2
1356 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1357 pack $w.ok -side bottom
1358 bind $w <Visibility> "focus $w.ok"
1359 bind $w <Key-Escape> "destroy $w"
1360 bind $w <Key-Return> "destroy $w"
1363 # Procedures for manipulating the file list window at the
1364 # bottom right of the overall window.
1366 proc treeview {w l openlevs} {
1367 global treecontents treediropen treeheight treeparent treeindex
1377 set treecontents() {}
1378 $w conf -state normal
1380 while {[string range $f 0 $prefixend] ne $prefix} {
1381 if {$lev <= $openlevs} {
1382 $w mark set e:$treeindex($prefix) "end -1c"
1383 $w mark gravity e:$treeindex($prefix) left
1385 set treeheight($prefix) $ht
1386 incr ht [lindex $htstack end]
1387 set htstack [lreplace $htstack end end]
1388 set prefixend [lindex $prefendstack end]
1389 set prefendstack [lreplace $prefendstack end end]
1390 set prefix [string range $prefix 0 $prefixend]
1393 set tail [string range $f [expr {$prefixend+1}] end]
1394 while {[set slash [string first "/" $tail]] >= 0} {
1397 lappend prefendstack $prefixend
1398 incr prefixend [expr {$slash + 1}]
1399 set d [string range $tail 0 $slash]
1400 lappend treecontents($prefix) $d
1401 set oldprefix $prefix
1403 set treecontents($prefix) {}
1404 set treeindex($prefix) [incr ix]
1405 set treeparent($prefix) $oldprefix
1406 set tail [string range $tail [expr {$slash+1}] end]
1407 if {$lev <= $openlevs} {
1409 set treediropen($prefix) [expr {$lev < $openlevs}]
1410 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1411 $w mark set d:$ix "end -1c"
1412 $w mark gravity d:$ix left
1414 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1416 $w image create end -align center -image $bm -padx 1 \
1418 $w insert end $d [highlight_tag $prefix]
1419 $w mark set s:$ix "end -1c"
1420 $w mark gravity s:$ix left
1425 if {$lev <= $openlevs} {
1428 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1430 $w insert end $tail [highlight_tag $f]
1432 lappend treecontents($prefix) $tail
1435 while {$htstack ne {}} {
1436 set treeheight($prefix) $ht
1437 incr ht [lindex $htstack end]
1438 set htstack [lreplace $htstack end end]
1439 set prefixend [lindex $prefendstack end]
1440 set prefendstack [lreplace $prefendstack end end]
1441 set prefix [string range $prefix 0 $prefixend]
1443 $w conf -state disabled
1446 proc linetoelt {l} {
1447 global treeheight treecontents
1452 foreach e $treecontents($prefix) {
1457 if {[string index $e end] eq "/"} {
1458 set n $treeheight($prefix$e)
1470 proc highlight_tree {y prefix} {
1471 global treeheight treecontents cflist
1473 foreach e $treecontents($prefix) {
1475 if {[highlight_tag $path] ne {}} {
1476 $cflist tag add bold $y.0 "$y.0 lineend"
1479 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1480 set y [highlight_tree $y $path]
1486 proc treeclosedir {w dir} {
1487 global treediropen treeheight treeparent treeindex
1489 set ix $treeindex($dir)
1490 $w conf -state normal
1491 $w delete s:$ix e:$ix
1492 set treediropen($dir) 0
1493 $w image configure a:$ix -image tri-rt
1494 $w conf -state disabled
1495 set n [expr {1 - $treeheight($dir)}]
1496 while {$dir ne {}} {
1497 incr treeheight($dir) $n
1498 set dir $treeparent($dir)
1502 proc treeopendir {w dir} {
1503 global treediropen treeheight treeparent treecontents treeindex
1505 set ix $treeindex($dir)
1506 $w conf -state normal
1507 $w image configure a:$ix -image tri-dn
1508 $w mark set e:$ix s:$ix
1509 $w mark gravity e:$ix right
1512 set n [llength $treecontents($dir)]
1513 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1516 incr treeheight($x) $n
1518 foreach e $treecontents($dir) {
1520 if {[string index $e end] eq "/"} {
1521 set iy $treeindex($de)
1522 $w mark set d:$iy e:$ix
1523 $w mark gravity d:$iy left
1524 $w insert e:$ix $str
1525 set treediropen($de) 0
1526 $w image create e:$ix -align center -image tri-rt -padx 1 \
1528 $w insert e:$ix $e [highlight_tag $de]
1529 $w mark set s:$iy e:$ix
1530 $w mark gravity s:$iy left
1531 set treeheight($de) 1
1533 $w insert e:$ix $str
1534 $w insert e:$ix $e [highlight_tag $de]
1537 $w mark gravity e:$ix left
1538 $w conf -state disabled
1539 set treediropen($dir) 1
1540 set top [lindex [split [$w index @0,0] .] 0]
1541 set ht [$w cget -height]
1542 set l [lindex [split [$w index s:$ix] .] 0]
1545 } elseif {$l + $n + 1 > $top + $ht} {
1546 set top [expr {$l + $n + 2 - $ht}]
1554 proc treeclick {w x y} {
1555 global treediropen cmitmode ctext cflist cflist_top
1557 if {$cmitmode ne "tree"} return
1558 if {![info exists cflist_top]} return
1559 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1560 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1561 $cflist tag add highlight $l.0 "$l.0 lineend"
1567 set e [linetoelt $l]
1568 if {[string index $e end] ne "/"} {
1570 } elseif {$treediropen($e)} {
1577 proc setfilelist {id} {
1578 global treefilelist cflist
1580 treeview $cflist $treefilelist($id) 0
1583 image create bitmap tri-rt -background black -foreground blue -data {
1584 #define tri-rt_width 13
1585 #define tri-rt_height 13
1586 static unsigned char tri-rt_bits[] = {
1587 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1588 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1591 #define tri-rt-mask_width 13
1592 #define tri-rt-mask_height 13
1593 static unsigned char tri-rt-mask_bits[] = {
1594 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1595 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1598 image create bitmap tri-dn -background black -foreground blue -data {
1599 #define tri-dn_width 13
1600 #define tri-dn_height 13
1601 static unsigned char tri-dn_bits[] = {
1602 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1603 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1606 #define tri-dn-mask_width 13
1607 #define tri-dn-mask_height 13
1608 static unsigned char tri-dn-mask_bits[] = {
1609 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1610 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1614 image create bitmap reficon-T -background black -foreground yellow -data {
1615 #define tagicon_width 13
1616 #define tagicon_height 9
1617 static unsigned char tagicon_bits[] = {
1618 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1619 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1621 #define tagicon-mask_width 13
1622 #define tagicon-mask_height 9
1623 static unsigned char tagicon-mask_bits[] = {
1624 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1625 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1628 #define headicon_width 13
1629 #define headicon_height 9
1630 static unsigned char headicon_bits[] = {
1631 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1632 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1635 #define headicon-mask_width 13
1636 #define headicon-mask_height 9
1637 static unsigned char headicon-mask_bits[] = {
1638 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1639 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1641 image create bitmap reficon-H -background black -foreground green \
1642 -data $rectdata -maskdata $rectmask
1643 image create bitmap reficon-o -background black -foreground "#ddddff" \
1644 -data $rectdata -maskdata $rectmask
1646 proc init_flist {first} {
1647 global cflist cflist_top selectedline difffilestart
1649 $cflist conf -state normal
1650 $cflist delete 0.0 end
1652 $cflist insert end $first
1654 $cflist tag add highlight 1.0 "1.0 lineend"
1656 catch {unset cflist_top}
1658 $cflist conf -state disabled
1659 set difffilestart {}
1662 proc highlight_tag {f} {
1663 global highlight_paths
1665 foreach p $highlight_paths {
1666 if {[string match $p $f]} {
1673 proc highlight_filelist {} {
1674 global cmitmode cflist
1676 $cflist conf -state normal
1677 if {$cmitmode ne "tree"} {
1678 set end [lindex [split [$cflist index end] .] 0]
1679 for {set l 2} {$l < $end} {incr l} {
1680 set line [$cflist get $l.0 "$l.0 lineend"]
1681 if {[highlight_tag $line] ne {}} {
1682 $cflist tag add bold $l.0 "$l.0 lineend"
1688 $cflist conf -state disabled
1691 proc unhighlight_filelist {} {
1694 $cflist conf -state normal
1695 $cflist tag remove bold 1.0 end
1696 $cflist conf -state disabled
1699 proc add_flist {fl} {
1702 $cflist conf -state normal
1704 $cflist insert end "\n"
1705 $cflist insert end $f [highlight_tag $f]
1707 $cflist conf -state disabled
1710 proc sel_flist {w x y} {
1711 global ctext difffilestart cflist cflist_top cmitmode
1713 if {$cmitmode eq "tree"} return
1714 if {![info exists cflist_top]} return
1715 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1716 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1717 $cflist tag add highlight $l.0 "$l.0 lineend"
1722 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1726 proc pop_flist_menu {w X Y x y} {
1727 global ctext cflist cmitmode flist_menu flist_menu_file
1728 global treediffs diffids
1731 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1733 if {$cmitmode eq "tree"} {
1734 set e [linetoelt $l]
1735 if {[string index $e end] eq "/"} return
1737 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1739 set flist_menu_file $e
1740 tk_popup $flist_menu $X $Y
1743 proc flist_hl {only} {
1744 global flist_menu_file findstring gdttype
1746 set x [shellquote $flist_menu_file]
1747 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1750 append findstring " " $x
1752 set gdttype [mc "touching paths:"]
1755 # Functions for adding and removing shell-type quoting
1757 proc shellquote {str} {
1758 if {![string match "*\['\"\\ \t]*" $str]} {
1761 if {![string match "*\['\"\\]*" $str]} {
1764 if {![string match "*'*" $str]} {
1767 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1770 proc shellarglist {l} {
1776 append str [shellquote $a]
1781 proc shelldequote {str} {
1786 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1787 append ret [string range $str $used end]
1788 set used [string length $str]
1791 set first [lindex $first 0]
1792 set ch [string index $str $first]
1793 if {$first > $used} {
1794 append ret [string range $str $used [expr {$first - 1}]]
1797 if {$ch eq " " || $ch eq "\t"} break
1800 set first [string first "'" $str $used]
1802 error "unmatched single-quote"
1804 append ret [string range $str $used [expr {$first - 1}]]
1809 if {$used >= [string length $str]} {
1810 error "trailing backslash"
1812 append ret [string index $str $used]
1817 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1818 error "unmatched double-quote"
1820 set first [lindex $first 0]
1821 set ch [string index $str $first]
1822 if {$first > $used} {
1823 append ret [string range $str $used [expr {$first - 1}]]
1826 if {$ch eq "\""} break
1828 append ret [string index $str $used]
1832 return [list $used $ret]
1835 proc shellsplit {str} {
1838 set str [string trimleft $str]
1839 if {$str eq {}} break
1840 set dq [shelldequote $str]
1841 set n [lindex $dq 0]
1842 set word [lindex $dq 1]
1843 set str [string range $str $n end]
1849 # Code to implement multiple views
1851 proc newview {ishighlight} {
1852 global nextviewnum newviewname newviewperm newishighlight
1853 global newviewargs revtreeargs
1855 set newishighlight $ishighlight
1857 if {[winfo exists $top]} {
1861 set newviewname($nextviewnum) "View $nextviewnum"
1862 set newviewperm($nextviewnum) 0
1863 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1864 vieweditor $top $nextviewnum [mc "Gitk view definition"]
1869 global viewname viewperm newviewname newviewperm
1870 global viewargs newviewargs
1872 set top .gitkvedit-$curview
1873 if {[winfo exists $top]} {
1877 set newviewname($curview) $viewname($curview)
1878 set newviewperm($curview) $viewperm($curview)
1879 set newviewargs($curview) [shellarglist $viewargs($curview)]
1880 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1883 proc vieweditor {top n title} {
1884 global newviewname newviewperm viewfiles bgcolor
1887 wm title $top $title
1888 label $top.nl -text [mc "Name"]
1889 entry $top.name -width 20 -textvariable newviewname($n)
1890 grid $top.nl $top.name -sticky w -pady 5
1891 checkbutton $top.perm -text [mc "Remember this view"] \
1892 -variable newviewperm($n)
1893 grid $top.perm - -pady 5 -sticky w
1894 message $top.al -aspect 1000 \
1895 -text [mc "Commits to include (arguments to git rev-list):"]
1896 grid $top.al - -sticky w -pady 5
1897 entry $top.args -width 50 -textvariable newviewargs($n) \
1898 -background $bgcolor
1899 grid $top.args - -sticky ew -padx 5
1900 message $top.l -aspect 1000 \
1901 -text [mc "Enter files and directories to include, one per line:"]
1902 grid $top.l - -sticky w
1903 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1904 if {[info exists viewfiles($n)]} {
1905 foreach f $viewfiles($n) {
1906 $top.t insert end $f
1907 $top.t insert end "\n"
1909 $top.t delete {end - 1c} end
1910 $top.t mark set insert 0.0
1912 grid $top.t - -sticky ew -padx 5
1914 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1915 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1916 grid $top.buts.ok $top.buts.can
1917 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1918 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1919 grid $top.buts - -pady 10 -sticky ew
1923 proc doviewmenu {m first cmd op argv} {
1924 set nmenu [$m index end]
1925 for {set i $first} {$i <= $nmenu} {incr i} {
1926 if {[$m entrycget $i -command] eq $cmd} {
1927 eval $m $op $i $argv
1933 proc allviewmenus {n op args} {
1936 doviewmenu .bar.view 5 [list showview $n] $op $args
1937 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1940 proc newviewok {top n} {
1941 global nextviewnum newviewperm newviewname newishighlight
1942 global viewname viewfiles viewperm selectedview curview
1943 global viewargs newviewargs viewhlmenu
1946 set newargs [shellsplit $newviewargs($n)]
1948 error_popup "[mc "Error in commit selection arguments:"] $err"
1954 foreach f [split [$top.t get 0.0 end] "\n"] {
1955 set ft [string trim $f]
1960 if {![info exists viewfiles($n)]} {
1961 # creating a new view
1963 set viewname($n) $newviewname($n)
1964 set viewperm($n) $newviewperm($n)
1965 set viewfiles($n) $files
1966 set viewargs($n) $newargs
1968 if {!$newishighlight} {
1971 run addvhighlight $n
1974 # editing an existing view
1975 set viewperm($n) $newviewperm($n)
1976 if {$newviewname($n) ne $viewname($n)} {
1977 set viewname($n) $newviewname($n)
1978 doviewmenu .bar.view 5 [list showview $n] \
1979 entryconf [list -label $viewname($n)]
1980 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1981 # entryconf [list -label $viewname($n) -value $viewname($n)]
1983 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1984 set viewfiles($n) $files
1985 set viewargs($n) $newargs
1986 if {$curview == $n} {
1991 catch {destroy $top}
1995 global curview viewdata viewperm hlview selectedhlview
1997 if {$curview == 0} return
1998 if {[info exists hlview] && $hlview == $curview} {
1999 set selectedhlview [mc "None"]
2002 allviewmenus $curview delete
2003 set viewdata($curview) {}
2004 set viewperm($curview) 0
2008 proc addviewmenu {n} {
2009 global viewname viewhlmenu
2011 .bar.view add radiobutton -label $viewname($n) \
2012 -command [list showview $n] -variable selectedview -value $n
2013 #$viewhlmenu add radiobutton -label $viewname($n) \
2014 # -command [list addvhighlight $n] -variable selectedhlview
2017 proc flatten {var} {
2021 foreach i [array names $var] {
2022 lappend ret $i [set $var\($i\)]
2027 proc unflatten {var l} {
2037 global curview viewdata viewfiles
2038 global displayorder parentlist rowidlist rowisopt rowfinal
2039 global colormap rowtextx commitrow nextcolor canvxmax
2040 global numcommits commitlisted
2041 global selectedline currentid canv canvy0
2043 global pending_select phase
2046 global selectedview selectfirst
2047 global vparentlist vdisporder vcmitlisted
2048 global hlview selectedhlview commitinterest
2050 if {$n == $curview} return
2052 if {[info exists selectedline]} {
2053 set selid $currentid
2054 set y [yc $selectedline]
2055 set ymax [lindex [$canv cget -scrollregion] 3]
2056 set span [$canv yview]
2057 set ytop [expr {[lindex $span 0] * $ymax}]
2058 set ybot [expr {[lindex $span 1] * $ymax}]
2059 if {$ytop < $y && $y < $ybot} {
2060 set yscreen [expr {$y - $ytop}]
2062 set yscreen [expr {($ybot - $ytop) / 2}]
2064 } elseif {[info exists pending_select]} {
2065 set selid $pending_select
2066 unset pending_select
2070 if {$curview >= 0} {
2071 set vparentlist($curview) $parentlist
2072 set vdisporder($curview) $displayorder
2073 set vcmitlisted($curview) $commitlisted
2075 ![info exists viewdata($curview)] ||
2076 [lindex $viewdata($curview) 0] ne {}} {
2077 set viewdata($curview) \
2078 [list $phase $rowidlist $rowisopt $rowfinal]
2081 catch {unset treediffs}
2083 if {[info exists hlview] && $hlview == $n} {
2085 set selectedhlview [mc "None"]
2087 catch {unset commitinterest}
2091 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2092 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2095 if {![info exists viewdata($n)]} {
2097 set pending_select $selid
2104 set phase [lindex $v 0]
2105 set displayorder $vdisporder($n)
2106 set parentlist $vparentlist($n)
2107 set commitlisted $vcmitlisted($n)
2108 set rowidlist [lindex $v 1]
2109 set rowisopt [lindex $v 2]
2110 set rowfinal [lindex $v 3]
2111 set numcommits $commitidx($n)
2113 catch {unset colormap}
2114 catch {unset rowtextx}
2116 set canvxmax [$canv cget -width]
2123 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2124 set row $commitrow($n,$selid)
2125 # try to get the selected row in the same position on the screen
2126 set ymax [lindex [$canv cget -scrollregion] 3]
2127 set ytop [expr {[yc $row] - $yscreen}]
2131 set yf [expr {$ytop * 1.0 / $ymax}]
2133 allcanvs yview moveto $yf
2137 } elseif {$selid ne {}} {
2138 set pending_select $selid
2140 set row [first_real_row]
2141 if {$row < $numcommits} {
2148 if {$phase eq "getcommits"} {
2149 show_status [mc "Reading commits..."]
2152 } elseif {$numcommits == 0} {
2153 show_status [mc "No commits selected"]
2157 # Stuff relating to the highlighting facility
2159 proc ishighlighted {row} {
2160 global vhighlights fhighlights nhighlights rhighlights
2162 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2163 return $nhighlights($row)
2165 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2166 return $vhighlights($row)
2168 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2169 return $fhighlights($row)
2171 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2172 return $rhighlights($row)
2177 proc bolden {row font} {
2178 global canv linehtag selectedline boldrows
2180 lappend boldrows $row
2181 $canv itemconf $linehtag($row) -font $font
2182 if {[info exists selectedline] && $row == $selectedline} {
2184 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2185 -outline {{}} -tags secsel \
2186 -fill [$canv cget -selectbackground]]
2191 proc bolden_name {row font} {
2192 global canv2 linentag selectedline boldnamerows
2194 lappend boldnamerows $row
2195 $canv2 itemconf $linentag($row) -font $font
2196 if {[info exists selectedline] && $row == $selectedline} {
2197 $canv2 delete secsel
2198 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2199 -outline {{}} -tags secsel \
2200 -fill [$canv2 cget -selectbackground]]
2209 foreach row $boldrows {
2210 if {![ishighlighted $row]} {
2211 bolden $row mainfont
2213 lappend stillbold $row
2216 set boldrows $stillbold
2219 proc addvhighlight {n} {
2220 global hlview curview viewdata vhl_done vhighlights commitidx
2222 if {[info exists hlview]} {
2226 if {$n != $curview && ![info exists viewdata($n)]} {
2227 set viewdata($n) [list getcommits {{}} 0 0 0]
2228 set vparentlist($n) {}
2229 set vdisporder($n) {}
2230 set vcmitlisted($n) {}
2233 set vhl_done $commitidx($hlview)
2234 if {$vhl_done > 0} {
2239 proc delvhighlight {} {
2240 global hlview vhighlights
2242 if {![info exists hlview]} return
2244 catch {unset vhighlights}
2248 proc vhighlightmore {} {
2249 global hlview vhl_done commitidx vhighlights
2250 global displayorder vdisporder curview
2252 set max $commitidx($hlview)
2253 if {$hlview == $curview} {
2254 set disp $displayorder
2256 set disp $vdisporder($hlview)
2258 set vr [visiblerows]
2259 set r0 [lindex $vr 0]
2260 set r1 [lindex $vr 1]
2261 for {set i $vhl_done} {$i < $max} {incr i} {
2262 set id [lindex $disp $i]
2263 if {[info exists commitrow($curview,$id)]} {
2264 set row $commitrow($curview,$id)
2265 if {$r0 <= $row && $row <= $r1} {
2266 if {![highlighted $row]} {
2267 bolden $row mainfontbold
2269 set vhighlights($row) 1
2276 proc askvhighlight {row id} {
2277 global hlview vhighlights commitrow iddrawn
2279 if {[info exists commitrow($hlview,$id)]} {
2280 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2281 bolden $row mainfontbold
2283 set vhighlights($row) 1
2285 set vhighlights($row) 0
2289 proc hfiles_change {} {
2290 global highlight_files filehighlight fhighlights fh_serial
2291 global highlight_paths gdttype
2293 if {[info exists filehighlight]} {
2294 # delete previous highlights
2295 catch {close $filehighlight}
2297 catch {unset fhighlights}
2299 unhighlight_filelist
2301 set highlight_paths {}
2302 after cancel do_file_hl $fh_serial
2304 if {$highlight_files ne {}} {
2305 after 300 do_file_hl $fh_serial
2309 proc gdttype_change {name ix op} {
2310 global gdttype highlight_files findstring findpattern
2313 if {$findstring ne {}} {
2314 if {$gdttype eq [mc "containing:"]} {
2315 if {$highlight_files ne {}} {
2316 set highlight_files {}
2321 if {$findpattern ne {}} {
2325 set highlight_files $findstring
2330 # enable/disable findtype/findloc menus too
2333 proc find_change {name ix op} {
2334 global gdttype findstring highlight_files
2337 if {$gdttype eq [mc "containing:"]} {
2340 if {$highlight_files ne $findstring} {
2341 set highlight_files $findstring
2348 proc findcom_change args {
2349 global nhighlights boldnamerows
2350 global findpattern findtype findstring gdttype
2353 # delete previous highlights, if any
2354 foreach row $boldnamerows {
2355 bolden_name $row mainfont
2358 catch {unset nhighlights}
2361 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2363 } elseif {$findtype eq [mc "Regexp"]} {
2364 set findpattern $findstring
2366 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2368 set findpattern "*$e*"
2372 proc makepatterns {l} {
2375 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2376 if {[string index $ee end] eq "/"} {
2386 proc do_file_hl {serial} {
2387 global highlight_files filehighlight highlight_paths gdttype fhl_list
2389 if {$gdttype eq [mc "touching paths:"]} {
2390 if {[catch {set paths [shellsplit $highlight_files]}]} return
2391 set highlight_paths [makepatterns $paths]
2393 set gdtargs [concat -- $paths]
2394 } elseif {$gdttype eq [mc "adding/removing string:"]} {
2395 set gdtargs [list "-S$highlight_files"]
2397 # must be "containing:", i.e. we're searching commit info
2400 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2401 set filehighlight [open $cmd r+]
2402 fconfigure $filehighlight -blocking 0
2403 filerun $filehighlight readfhighlight
2409 proc flushhighlights {} {
2410 global filehighlight fhl_list
2412 if {[info exists filehighlight]} {
2414 puts $filehighlight ""
2415 flush $filehighlight
2419 proc askfilehighlight {row id} {
2420 global filehighlight fhighlights fhl_list
2422 lappend fhl_list $id
2423 set fhighlights($row) -1
2424 puts $filehighlight $id
2427 proc readfhighlight {} {
2428 global filehighlight fhighlights commitrow curview iddrawn
2429 global fhl_list find_dirn
2431 if {![info exists filehighlight]} {
2435 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2436 set line [string trim $line]
2437 set i [lsearch -exact $fhl_list $line]
2438 if {$i < 0} continue
2439 for {set j 0} {$j < $i} {incr j} {
2440 set id [lindex $fhl_list $j]
2441 if {[info exists commitrow($curview,$id)]} {
2442 set fhighlights($commitrow($curview,$id)) 0
2445 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2446 if {$line eq {}} continue
2447 if {![info exists commitrow($curview,$line)]} continue
2448 set row $commitrow($curview,$line)
2449 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2450 bolden $row mainfontbold
2452 set fhighlights($row) 1
2454 if {[eof $filehighlight]} {
2456 puts "oops, git diff-tree died"
2457 catch {close $filehighlight}
2461 if {[info exists find_dirn]} {
2467 proc doesmatch {f} {
2468 global findtype findpattern
2470 if {$findtype eq [mc "Regexp"]} {
2471 return [regexp $findpattern $f]
2472 } elseif {$findtype eq [mc "IgnCase"]} {
2473 return [string match -nocase $findpattern $f]
2475 return [string match $findpattern $f]
2479 proc askfindhighlight {row id} {
2480 global nhighlights commitinfo iddrawn
2482 global markingmatches
2484 if {![info exists commitinfo($id)]} {
2487 set info $commitinfo($id)
2489 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2490 foreach f $info ty $fldtypes {
2491 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2493 if {$ty eq [mc "Author"]} {
2500 if {$isbold && [info exists iddrawn($id)]} {
2501 if {![ishighlighted $row]} {
2502 bolden $row mainfontbold
2504 bolden_name $row mainfontbold
2507 if {$markingmatches} {
2508 markrowmatches $row $id
2511 set nhighlights($row) $isbold
2514 proc markrowmatches {row id} {
2515 global canv canv2 linehtag linentag commitinfo findloc
2517 set headline [lindex $commitinfo($id) 0]
2518 set author [lindex $commitinfo($id) 1]
2519 $canv delete match$row
2520 $canv2 delete match$row
2521 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2522 set m [findmatches $headline]
2524 markmatches $canv $row $headline $linehtag($row) $m \
2525 [$canv itemcget $linehtag($row) -font] $row
2528 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2529 set m [findmatches $author]
2531 markmatches $canv2 $row $author $linentag($row) $m \
2532 [$canv2 itemcget $linentag($row) -font] $row
2537 proc vrel_change {name ix op} {
2538 global highlight_related
2541 if {$highlight_related ne [mc "None"]} {
2546 # prepare for testing whether commits are descendents or ancestors of a
2547 proc rhighlight_sel {a} {
2548 global descendent desc_todo ancestor anc_todo
2549 global highlight_related rhighlights
2551 catch {unset descendent}
2552 set desc_todo [list $a]
2553 catch {unset ancestor}
2554 set anc_todo [list $a]
2555 if {$highlight_related ne [mc "None"]} {
2561 proc rhighlight_none {} {
2564 catch {unset rhighlights}
2568 proc is_descendent {a} {
2569 global curview children commitrow descendent desc_todo
2572 set la $commitrow($v,$a)
2576 for {set i 0} {$i < [llength $todo]} {incr i} {
2577 set do [lindex $todo $i]
2578 if {$commitrow($v,$do) < $la} {
2579 lappend leftover $do
2582 foreach nk $children($v,$do) {
2583 if {![info exists descendent($nk)]} {
2584 set descendent($nk) 1
2592 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2596 set descendent($a) 0
2597 set desc_todo $leftover
2600 proc is_ancestor {a} {
2601 global curview parentlist commitrow ancestor anc_todo
2604 set la $commitrow($v,$a)
2608 for {set i 0} {$i < [llength $todo]} {incr i} {
2609 set do [lindex $todo $i]
2610 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2611 lappend leftover $do
2614 foreach np [lindex $parentlist $commitrow($v,$do)] {
2615 if {![info exists ancestor($np)]} {
2624 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2629 set anc_todo $leftover
2632 proc askrelhighlight {row id} {
2633 global descendent highlight_related iddrawn rhighlights
2634 global selectedline ancestor
2636 if {![info exists selectedline]} return
2638 if {$highlight_related eq [mc "Descendant"] ||
2639 $highlight_related eq [mc "Not descendant"]} {
2640 if {![info exists descendent($id)]} {
2643 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2646 } elseif {$highlight_related eq [mc "Ancestor"] ||
2647 $highlight_related eq [mc "Not ancestor"]} {
2648 if {![info exists ancestor($id)]} {
2651 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2655 if {[info exists iddrawn($id)]} {
2656 if {$isbold && ![ishighlighted $row]} {
2657 bolden $row mainfontbold
2660 set rhighlights($row) $isbold
2663 # Graph layout functions
2665 proc shortids {ids} {
2668 if {[llength $id] > 1} {
2669 lappend res [shortids $id]
2670 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2671 lappend res [string range $id 0 7]
2682 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2683 if {($n & $mask) != 0} {
2684 set ret [concat $ret $o]
2686 set o [concat $o $o]
2691 # Work out where id should go in idlist so that order-token
2692 # values increase from left to right
2693 proc idcol {idlist id {i 0}} {
2694 global ordertok curview
2696 set t $ordertok($curview,$id)
2697 if {$i >= [llength $idlist] ||
2698 $t < $ordertok($curview,[lindex $idlist $i])} {
2699 if {$i > [llength $idlist]} {
2700 set i [llength $idlist]
2702 while {[incr i -1] >= 0 &&
2703 $t < $ordertok($curview,[lindex $idlist $i])} {}
2706 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2707 while {[incr i] < [llength $idlist] &&
2708 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2714 proc initlayout {} {
2715 global rowidlist rowisopt rowfinal displayorder commitlisted
2716 global numcommits canvxmax canv
2719 global colormap rowtextx
2730 set canvxmax [$canv cget -width]
2731 catch {unset colormap}
2732 catch {unset rowtextx}
2736 proc setcanvscroll {} {
2737 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2739 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2740 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2741 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2742 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2745 proc visiblerows {} {
2746 global canv numcommits linespc
2748 set ymax [lindex [$canv cget -scrollregion] 3]
2749 if {$ymax eq {} || $ymax == 0} return
2751 set y0 [expr {int([lindex $f 0] * $ymax)}]
2752 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2756 set y1 [expr {int([lindex $f 1] * $ymax)}]
2757 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2758 if {$r1 >= $numcommits} {
2759 set r1 [expr {$numcommits - 1}]
2761 return [list $r0 $r1]
2764 proc layoutmore {} {
2765 global commitidx viewcomplete numcommits
2766 global uparrowlen downarrowlen mingaplen curview
2768 set show $commitidx($curview)
2769 if {$show > $numcommits || $viewcomplete($curview)} {
2770 showstuff $show $viewcomplete($curview)
2774 proc showstuff {canshow last} {
2775 global numcommits commitrow pending_select selectedline curview
2776 global mainheadid displayorder selectfirst
2777 global lastscrollset commitinterest
2779 if {$numcommits == 0} {
2781 set phase "incrdraw"
2785 set prev $numcommits
2786 set numcommits $canshow
2787 set t [clock clicks -milliseconds]
2788 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2789 set lastscrollset $t
2792 set rows [visiblerows]
2793 set r1 [lindex $rows 1]
2794 if {$r1 >= $canshow} {
2795 set r1 [expr {$canshow - 1}]
2800 if {[info exists pending_select] &&
2801 [info exists commitrow($curview,$pending_select)] &&
2802 $commitrow($curview,$pending_select) < $numcommits} {
2803 selectline $commitrow($curview,$pending_select) 1
2806 if {[info exists selectedline] || [info exists pending_select]} {
2809 set l [first_real_row]
2816 proc doshowlocalchanges {} {
2817 global curview mainheadid phase commitrow
2819 if {[info exists commitrow($curview,$mainheadid)] &&
2820 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2822 } elseif {$phase ne {}} {
2823 lappend commitinterest($mainheadid) {}
2827 proc dohidelocalchanges {} {
2828 global localfrow localirow lserial
2830 if {$localfrow >= 0} {
2831 removerow $localfrow
2833 if {$localirow > 0} {
2837 if {$localirow >= 0} {
2838 removerow $localirow
2844 # spawn off a process to do git diff-index --cached HEAD
2845 proc dodiffindex {} {
2846 global localirow localfrow lserial showlocalchanges
2848 if {!$showlocalchanges} return
2852 set fd [open "|git diff-index --cached HEAD" r]
2853 fconfigure $fd -blocking 0
2854 filerun $fd [list readdiffindex $fd $lserial]
2857 proc readdiffindex {fd serial} {
2858 global localirow commitrow mainheadid nullid2 curview
2859 global commitinfo commitdata lserial
2862 if {[gets $fd line] < 0} {
2868 # we only need to see one line and we don't really care what it says...
2871 # now see if there are any local changes not checked in to the index
2872 if {$serial == $lserial} {
2873 set fd [open "|git diff-files" r]
2874 fconfigure $fd -blocking 0
2875 filerun $fd [list readdifffiles $fd $serial]
2878 if {$isdiff && $serial == $lserial && $localirow == -1} {
2879 # add the line for the changes in the index to the graph
2880 set localirow $commitrow($curview,$mainheadid)
2881 set hl [mc "Local changes checked in to index but not committed"]
2882 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2883 set commitdata($nullid2) "\n $hl\n"
2884 insertrow $localirow $nullid2
2889 proc readdifffiles {fd serial} {
2890 global localirow localfrow commitrow mainheadid nullid curview
2891 global commitinfo commitdata lserial
2894 if {[gets $fd line] < 0} {
2900 # we only need to see one line and we don't really care what it says...
2903 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2904 # add the line for the local diff to the graph
2905 if {$localirow >= 0} {
2906 set localfrow $localirow
2909 set localfrow $commitrow($curview,$mainheadid)
2911 set hl [mc "Local uncommitted changes, not checked in to index"]
2912 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2913 set commitdata($nullid) "\n $hl\n"
2914 insertrow $localfrow $nullid
2919 proc nextuse {id row} {
2920 global commitrow curview children
2922 if {[info exists children($curview,$id)]} {
2923 foreach kid $children($curview,$id) {
2924 if {![info exists commitrow($curview,$kid)]} {
2927 if {$commitrow($curview,$kid) > $row} {
2928 return $commitrow($curview,$kid)
2932 if {[info exists commitrow($curview,$id)]} {
2933 return $commitrow($curview,$id)
2938 proc prevuse {id row} {
2939 global commitrow curview children
2942 if {[info exists children($curview,$id)]} {
2943 foreach kid $children($curview,$id) {
2944 if {![info exists commitrow($curview,$kid)]} break
2945 if {$commitrow($curview,$kid) < $row} {
2946 set ret $commitrow($curview,$kid)
2953 proc make_idlist {row} {
2954 global displayorder parentlist uparrowlen downarrowlen mingaplen
2955 global commitidx curview ordertok children commitrow
2957 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2961 set ra [expr {$row - $downarrowlen}]
2965 set rb [expr {$row + $uparrowlen}]
2966 if {$rb > $commitidx($curview)} {
2967 set rb $commitidx($curview)
2970 for {} {$r < $ra} {incr r} {
2971 set nextid [lindex $displayorder [expr {$r + 1}]]
2972 foreach p [lindex $parentlist $r] {
2973 if {$p eq $nextid} continue
2974 set rn [nextuse $p $r]
2976 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2977 lappend ids [list $ordertok($curview,$p) $p]
2981 for {} {$r < $row} {incr r} {
2982 set nextid [lindex $displayorder [expr {$r + 1}]]
2983 foreach p [lindex $parentlist $r] {
2984 if {$p eq $nextid} continue
2985 set rn [nextuse $p $r]
2986 if {$rn < 0 || $rn >= $row} {
2987 lappend ids [list $ordertok($curview,$p) $p]
2991 set id [lindex $displayorder $row]
2992 lappend ids [list $ordertok($curview,$id) $id]
2994 foreach p [lindex $parentlist $r] {
2995 set firstkid [lindex $children($curview,$p) 0]
2996 if {$commitrow($curview,$firstkid) < $row} {
2997 lappend ids [list $ordertok($curview,$p) $p]
3001 set id [lindex $displayorder $r]
3003 set firstkid [lindex $children($curview,$id) 0]
3004 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3005 lappend ids [list $ordertok($curview,$id) $id]
3010 foreach idx [lsort -unique $ids] {
3011 lappend idlist [lindex $idx 1]
3016 proc rowsequal {a b} {
3017 while {[set i [lsearch -exact $a {}]] >= 0} {
3018 set a [lreplace $a $i $i]
3020 while {[set i [lsearch -exact $b {}]] >= 0} {
3021 set b [lreplace $b $i $i]
3023 return [expr {$a eq $b}]
3026 proc makeupline {id row rend col} {
3027 global rowidlist uparrowlen downarrowlen mingaplen
3029 for {set r $rend} {1} {set r $rstart} {
3030 set rstart [prevuse $id $r]
3031 if {$rstart < 0} return
3032 if {$rstart < $row} break
3034 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3035 set rstart [expr {$rend - $uparrowlen - 1}]
3037 for {set r $rstart} {[incr r] <= $row} {} {
3038 set idlist [lindex $rowidlist $r]
3039 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3040 set col [idcol $idlist $id $col]
3041 lset rowidlist $r [linsert $idlist $col $id]
3047 proc layoutrows {row endrow} {
3048 global rowidlist rowisopt rowfinal displayorder
3049 global uparrowlen downarrowlen maxwidth mingaplen
3050 global children parentlist
3051 global commitidx viewcomplete curview commitrow
3055 set rm1 [expr {$row - 1}]
3056 foreach id [lindex $rowidlist $rm1] {
3061 set final [lindex $rowfinal $rm1]
3063 for {} {$row < $endrow} {incr row} {
3064 set rm1 [expr {$row - 1}]
3065 if {$rm1 < 0 || $idlist eq {}} {
3066 set idlist [make_idlist $row]
3069 set id [lindex $displayorder $rm1]
3070 set col [lsearch -exact $idlist $id]
3071 set idlist [lreplace $idlist $col $col]
3072 foreach p [lindex $parentlist $rm1] {
3073 if {[lsearch -exact $idlist $p] < 0} {
3074 set col [idcol $idlist $p $col]
3075 set idlist [linsert $idlist $col $p]
3076 # if not the first child, we have to insert a line going up
3077 if {$id ne [lindex $children($curview,$p) 0]} {
3078 makeupline $p $rm1 $row $col
3082 set id [lindex $displayorder $row]
3083 if {$row > $downarrowlen} {
3084 set termrow [expr {$row - $downarrowlen - 1}]
3085 foreach p [lindex $parentlist $termrow] {
3086 set i [lsearch -exact $idlist $p]
3087 if {$i < 0} continue
3088 set nr [nextuse $p $termrow]
3089 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3090 set idlist [lreplace $idlist $i $i]
3094 set col [lsearch -exact $idlist $id]
3096 set col [idcol $idlist $id]
3097 set idlist [linsert $idlist $col $id]
3098 if {$children($curview,$id) ne {}} {
3099 makeupline $id $rm1 $row $col
3102 set r [expr {$row + $uparrowlen - 1}]
3103 if {$r < $commitidx($curview)} {
3105 foreach p [lindex $parentlist $r] {
3106 if {[lsearch -exact $idlist $p] >= 0} continue
3107 set fk [lindex $children($curview,$p) 0]
3108 if {$commitrow($curview,$fk) < $row} {
3109 set x [idcol $idlist $p $x]
3110 set idlist [linsert $idlist $x $p]
3113 if {[incr r] < $commitidx($curview)} {
3114 set p [lindex $displayorder $r]
3115 if {[lsearch -exact $idlist $p] < 0} {
3116 set fk [lindex $children($curview,$p) 0]
3117 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3118 set x [idcol $idlist $p $x]
3119 set idlist [linsert $idlist $x $p]
3125 if {$final && !$viewcomplete($curview) &&
3126 $row + $uparrowlen + $mingaplen + $downarrowlen
3127 >= $commitidx($curview)} {
3130 set l [llength $rowidlist]
3132 lappend rowidlist $idlist
3134 lappend rowfinal $final
3135 } elseif {$row < $l} {
3136 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3137 lset rowidlist $row $idlist
3140 lset rowfinal $row $final
3142 set pad [ntimes [expr {$row - $l}] {}]
3143 set rowidlist [concat $rowidlist $pad]
3144 lappend rowidlist $idlist
3145 set rowfinal [concat $rowfinal $pad]
3146 lappend rowfinal $final
3147 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3153 proc changedrow {row} {
3154 global displayorder iddrawn rowisopt need_redisplay
3156 set l [llength $rowisopt]
3158 lset rowisopt $row 0
3159 if {$row + 1 < $l} {
3160 lset rowisopt [expr {$row + 1}] 0
3161 if {$row + 2 < $l} {
3162 lset rowisopt [expr {$row + 2}] 0
3166 set id [lindex $displayorder $row]
3167 if {[info exists iddrawn($id)]} {
3168 set need_redisplay 1
3172 proc insert_pad {row col npad} {
3175 set pad [ntimes $npad {}]
3176 set idlist [lindex $rowidlist $row]
3177 set bef [lrange $idlist 0 [expr {$col - 1}]]
3178 set aft [lrange $idlist $col end]
3179 set i [lsearch -exact $aft {}]
3181 set aft [lreplace $aft $i $i]
3183 lset rowidlist $row [concat $bef $pad $aft]
3187 proc optimize_rows {row col endrow} {
3188 global rowidlist rowisopt displayorder curview children
3193 for {} {$row < $endrow} {incr row; set col 0} {
3194 if {[lindex $rowisopt $row]} continue
3196 set y0 [expr {$row - 1}]
3197 set ym [expr {$row - 2}]
3198 set idlist [lindex $rowidlist $row]
3199 set previdlist [lindex $rowidlist $y0]
3200 if {$idlist eq {} || $previdlist eq {}} continue
3202 set pprevidlist [lindex $rowidlist $ym]
3203 if {$pprevidlist eq {}} continue
3209 for {} {$col < [llength $idlist]} {incr col} {
3210 set id [lindex $idlist $col]
3211 if {[lindex $previdlist $col] eq $id} continue
3216 set x0 [lsearch -exact $previdlist $id]
3217 if {$x0 < 0} continue
3218 set z [expr {$x0 - $col}]
3222 set xm [lsearch -exact $pprevidlist $id]
3224 set z0 [expr {$xm - $x0}]
3228 # if row y0 is the first child of $id then it's not an arrow
3229 if {[lindex $children($curview,$id) 0] ne
3230 [lindex $displayorder $y0]} {
3234 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3235 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3238 # Looking at lines from this row to the previous row,
3239 # make them go straight up if they end in an arrow on
3240 # the previous row; otherwise make them go straight up
3242 if {$z < -1 || ($z < 0 && $isarrow)} {
3243 # Line currently goes left too much;
3244 # insert pads in the previous row, then optimize it
3245 set npad [expr {-1 - $z + $isarrow}]
3246 insert_pad $y0 $x0 $npad
3248 optimize_rows $y0 $x0 $row
3250 set previdlist [lindex $rowidlist $y0]
3251 set x0 [lsearch -exact $previdlist $id]
3252 set z [expr {$x0 - $col}]
3254 set pprevidlist [lindex $rowidlist $ym]
3255 set xm [lsearch -exact $pprevidlist $id]
3256 set z0 [expr {$xm - $x0}]
3258 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3259 # Line currently goes right too much;
3260 # insert pads in this line
3261 set npad [expr {$z - 1 + $isarrow}]
3262 insert_pad $row $col $npad
3263 set idlist [lindex $rowidlist $row]
3265 set z [expr {$x0 - $col}]
3268 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3269 # this line links to its first child on row $row-2
3270 set id [lindex $displayorder $ym]
3271 set xc [lsearch -exact $pprevidlist $id]
3273 set z0 [expr {$xc - $x0}]
3276 # avoid lines jigging left then immediately right
3277 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3278 insert_pad $y0 $x0 1
3280 optimize_rows $y0 $x0 $row
3281 set previdlist [lindex $rowidlist $y0]
3285 # Find the first column that doesn't have a line going right
3286 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3287 set id [lindex $idlist $col]
3288 if {$id eq {}} break
3289 set x0 [lsearch -exact $previdlist $id]
3291 # check if this is the link to the first child
3292 set kid [lindex $displayorder $y0]
3293 if {[lindex $children($curview,$id) 0] eq $kid} {
3294 # it is, work out offset to child
3295 set x0 [lsearch -exact $previdlist $kid]
3298 if {$x0 <= $col} break
3300 # Insert a pad at that column as long as it has a line and
3301 # isn't the last column
3302 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3303 set idlist [linsert $idlist $col {}]
3304 lset rowidlist $row $idlist
3312 global canvx0 linespc
3313 return [expr {$canvx0 + $col * $linespc}]
3317 global canvy0 linespc
3318 return [expr {$canvy0 + $row * $linespc}]
3321 proc linewidth {id} {
3322 global thickerline lthickness
3325 if {[info exists thickerline] && $id eq $thickerline} {
3326 set wid [expr {2 * $lthickness}]
3331 proc rowranges {id} {
3332 global commitrow curview children uparrowlen downarrowlen
3335 set kids $children($curview,$id)
3341 foreach child $kids {
3342 if {![info exists commitrow($curview,$child)]} break
3343 set row $commitrow($curview,$child)
3344 if {![info exists prev]} {
3345 lappend ret [expr {$row + 1}]
3347 if {$row <= $prevrow} {
3348 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3350 # see if the line extends the whole way from prevrow to row
3351 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3352 [lsearch -exact [lindex $rowidlist \
3353 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3354 # it doesn't, see where it ends
3355 set r [expr {$prevrow + $downarrowlen}]
3356 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3357 while {[incr r -1] > $prevrow &&
3358 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3360 while {[incr r] <= $row &&
3361 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3365 # see where it starts up again
3366 set r [expr {$row - $uparrowlen}]
3367 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3368 while {[incr r] < $row &&
3369 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3371 while {[incr r -1] >= $prevrow &&
3372 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3378 if {$child eq $id} {
3387 proc drawlineseg {id row endrow arrowlow} {
3388 global rowidlist displayorder iddrawn linesegs
3389 global canv colormap linespc curview maxlinelen parentlist
3391 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3392 set le [expr {$row + 1}]
3395 set c [lsearch -exact [lindex $rowidlist $le] $id]
3401 set x [lindex $displayorder $le]
3406 if {[info exists iddrawn($x)] || $le == $endrow} {
3407 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3423 if {[info exists linesegs($id)]} {
3424 set lines $linesegs($id)
3426 set r0 [lindex $li 0]
3428 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3438 set li [lindex $lines [expr {$i-1}]]
3439 set r1 [lindex $li 1]
3440 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3445 set x [lindex $cols [expr {$le - $row}]]
3446 set xp [lindex $cols [expr {$le - 1 - $row}]]
3447 set dir [expr {$xp - $x}]
3449 set ith [lindex $lines $i 2]
3450 set coords [$canv coords $ith]
3451 set ah [$canv itemcget $ith -arrow]
3452 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3453 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3454 if {$x2 ne {} && $x - $x2 == $dir} {
3455 set coords [lrange $coords 0 end-2]
3458 set coords [list [xc $le $x] [yc $le]]
3461 set itl [lindex $lines [expr {$i-1}] 2]
3462 set al [$canv itemcget $itl -arrow]
3463 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3464 } elseif {$arrowlow} {
3465 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3466 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3470 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3471 for {set y $le} {[incr y -1] > $row} {} {
3473 set xp [lindex $cols [expr {$y - 1 - $row}]]
3474 set ndir [expr {$xp - $x}]
3475 if {$dir != $ndir || $xp < 0} {
3476 lappend coords [xc $y $x] [yc $y]
3482 # join parent line to first child
3483 set ch [lindex $displayorder $row]
3484 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3486 puts "oops: drawlineseg: child $ch not on row $row"
3487 } elseif {$xc != $x} {
3488 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3489 set d [expr {int(0.5 * $linespc)}]
3492 set x2 [expr {$x1 - $d}]
3494 set x2 [expr {$x1 + $d}]
3497 set y1 [expr {$y2 + $d}]
3498 lappend coords $x1 $y1 $x2 $y2
3499 } elseif {$xc < $x - 1} {
3500 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3501 } elseif {$xc > $x + 1} {
3502 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3506 lappend coords [xc $row $x] [yc $row]
3508 set xn [xc $row $xp]
3510 lappend coords $xn $yn
3514 set t [$canv create line $coords -width [linewidth $id] \
3515 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3518 set lines [linsert $lines $i [list $row $le $t]]
3520 $canv coords $ith $coords
3521 if {$arrow ne $ah} {
3522 $canv itemconf $ith -arrow $arrow
3524 lset lines $i 0 $row
3527 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3528 set ndir [expr {$xo - $xp}]
3529 set clow [$canv coords $itl]
3530 if {$dir == $ndir} {
3531 set clow [lrange $clow 2 end]
3533 set coords [concat $coords $clow]
3535 lset lines [expr {$i-1}] 1 $le
3537 # coalesce two pieces
3539 set b [lindex $lines [expr {$i-1}] 0]
3540 set e [lindex $lines $i 1]
3541 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3543 $canv coords $itl $coords
3544 if {$arrow ne $al} {
3545 $canv itemconf $itl -arrow $arrow
3549 set linesegs($id) $lines
3553 proc drawparentlinks {id row} {
3554 global rowidlist canv colormap curview parentlist
3555 global idpos linespc
3557 set rowids [lindex $rowidlist $row]
3558 set col [lsearch -exact $rowids $id]
3559 if {$col < 0} return
3560 set olds [lindex $parentlist $row]
3561 set row2 [expr {$row + 1}]
3562 set x [xc $row $col]
3565 set d [expr {int(0.5 * $linespc)}]
3566 set ymid [expr {$y + $d}]
3567 set ids [lindex $rowidlist $row2]
3568 # rmx = right-most X coord used
3571 set i [lsearch -exact $ids $p]
3573 puts "oops, parent $p of $id not in list"
3576 set x2 [xc $row2 $i]
3580 set j [lsearch -exact $rowids $p]
3582 # drawlineseg will do this one for us
3586 # should handle duplicated parents here...
3587 set coords [list $x $y]
3589 # if attaching to a vertical segment, draw a smaller
3590 # slant for visual distinctness
3593 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3595 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3597 } elseif {$i < $col && $i < $j} {
3598 # segment slants towards us already
3599 lappend coords [xc $row $j] $y
3601 if {$i < $col - 1} {
3602 lappend coords [expr {$x2 + $linespc}] $y
3603 } elseif {$i > $col + 1} {
3604 lappend coords [expr {$x2 - $linespc}] $y
3606 lappend coords $x2 $y2
3609 lappend coords $x2 $y2
3611 set t [$canv create line $coords -width [linewidth $p] \
3612 -fill $colormap($p) -tags lines.$p]
3616 if {$rmx > [lindex $idpos($id) 1]} {
3617 lset idpos($id) 1 $rmx
3622 proc drawlines {id} {
3625 $canv itemconf lines.$id -width [linewidth $id]
3628 proc drawcmittext {id row col} {
3629 global linespc canv canv2 canv3 canvy0 fgcolor curview
3630 global commitlisted commitinfo rowidlist parentlist
3631 global rowtextx idpos idtags idheads idotherrefs
3632 global linehtag linentag linedtag selectedline
3633 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3635 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3636 set listed [lindex $commitlisted $row]
3637 if {$id eq $nullid} {
3639 } elseif {$id eq $nullid2} {
3642 set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
3644 set x [xc $row $col]
3646 set orad [expr {$linespc / 3}]
3648 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3649 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3650 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3651 } elseif {$listed == 3} {
3652 # triangle pointing left for left-side commits
3653 set t [$canv create polygon \
3654 [expr {$x - $orad}] $y \
3655 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3656 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3657 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3659 # triangle pointing right for right-side commits
3660 set t [$canv create polygon \
3661 [expr {$x + $orad - 1}] $y \
3662 [expr {$x - $orad}] [expr {$y - $orad}] \
3663 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3664 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3667 $canv bind $t <1> {selcanvline {} %x %y}
3668 set rmx [llength [lindex $rowidlist $row]]
3669 set olds [lindex $parentlist $row]
3671 set nextids [lindex $rowidlist [expr {$row + 1}]]
3673 set i [lsearch -exact $nextids $p]
3679 set xt [xc $row $rmx]
3680 set rowtextx($row) $xt
3681 set idpos($id) [list $x $xt $y]
3682 if {[info exists idtags($id)] || [info exists idheads($id)]
3683 || [info exists idotherrefs($id)]} {
3684 set xt [drawtags $id $x $xt $y]
3686 set headline [lindex $commitinfo($id) 0]
3687 set name [lindex $commitinfo($id) 1]
3688 set date [lindex $commitinfo($id) 2]
3689 set date [formatdate $date]
3692 set isbold [ishighlighted $row]
3694 lappend boldrows $row
3695 set font mainfontbold
3697 lappend boldnamerows $row
3698 set nfont mainfontbold
3701 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3702 -text $headline -font $font -tags text]
3703 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3704 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3705 -text $name -font $nfont -tags text]
3706 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3707 -text $date -font mainfont -tags text]
3708 if {[info exists selectedline] && $selectedline == $row} {
3711 set xr [expr {$xt + [font measure $font $headline]}]
3712 if {$xr > $canvxmax} {
3718 proc drawcmitrow {row} {
3719 global displayorder rowidlist nrows_drawn
3720 global iddrawn markingmatches
3721 global commitinfo parentlist numcommits
3722 global filehighlight fhighlights findpattern nhighlights
3723 global hlview vhighlights
3724 global highlight_related rhighlights
3726 if {$row >= $numcommits} return
3728 set id [lindex $displayorder $row]
3729 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3730 askvhighlight $row $id
3732 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3733 askfilehighlight $row $id
3735 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3736 askfindhighlight $row $id
3738 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3739 askrelhighlight $row $id
3741 if {![info exists iddrawn($id)]} {
3742 set col [lsearch -exact [lindex $rowidlist $row] $id]
3744 puts "oops, row $row id $id not in list"
3747 if {![info exists commitinfo($id)]} {
3751 drawcmittext $id $row $col
3755 if {$markingmatches} {
3756 markrowmatches $row $id
3760 proc drawcommits {row {endrow {}}} {
3761 global numcommits iddrawn displayorder curview need_redisplay
3762 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3767 if {$endrow eq {}} {
3770 if {$endrow >= $numcommits} {
3771 set endrow [expr {$numcommits - 1}]
3774 set rl1 [expr {$row - $downarrowlen - 3}]
3778 set ro1 [expr {$row - 3}]
3782 set r2 [expr {$endrow + $uparrowlen + 3}]
3783 if {$r2 > $numcommits} {
3786 for {set r $rl1} {$r < $r2} {incr r} {
3787 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3791 set rl1 [expr {$r + 1}]
3797 optimize_rows $ro1 0 $r2
3798 if {$need_redisplay || $nrows_drawn > 2000} {
3803 # make the lines join to already-drawn rows either side
3804 set r [expr {$row - 1}]
3805 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3808 set er [expr {$endrow + 1}]
3809 if {$er >= $numcommits ||
3810 ![info exists iddrawn([lindex $displayorder $er])]} {
3813 for {} {$r <= $er} {incr r} {
3814 set id [lindex $displayorder $r]
3815 set wasdrawn [info exists iddrawn($id)]
3817 if {$r == $er} break
3818 set nextid [lindex $displayorder [expr {$r + 1}]]
3819 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3820 drawparentlinks $id $r
3822 set rowids [lindex $rowidlist $r]
3823 foreach lid $rowids {
3824 if {$lid eq {}} continue
3825 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3827 # see if this is the first child of any of its parents
3828 foreach p [lindex $parentlist $r] {
3829 if {[lsearch -exact $rowids $p] < 0} {
3830 # make this line extend up to the child
3831 set lineend($p) [drawlineseg $p $r $er 0]
3835 set lineend($lid) [drawlineseg $lid $r $er 1]
3841 proc drawfrac {f0 f1} {
3844 set ymax [lindex [$canv cget -scrollregion] 3]
3845 if {$ymax eq {} || $ymax == 0} return
3846 set y0 [expr {int($f0 * $ymax)}]
3847 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3848 set y1 [expr {int($f1 * $ymax)}]
3849 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3850 drawcommits $row $endrow
3853 proc drawvisible {} {
3855 eval drawfrac [$canv yview]
3858 proc clear_display {} {
3859 global iddrawn linesegs need_redisplay nrows_drawn
3860 global vhighlights fhighlights nhighlights rhighlights
3863 catch {unset iddrawn}
3864 catch {unset linesegs}
3865 catch {unset vhighlights}
3866 catch {unset fhighlights}
3867 catch {unset nhighlights}
3868 catch {unset rhighlights}
3869 set need_redisplay 0
3873 proc findcrossings {id} {
3874 global rowidlist parentlist numcommits displayorder
3878 foreach {s e} [rowranges $id] {
3879 if {$e >= $numcommits} {
3880 set e [expr {$numcommits - 1}]
3882 if {$e <= $s} continue
3883 for {set row $e} {[incr row -1] >= $s} {} {
3884 set x [lsearch -exact [lindex $rowidlist $row] $id]
3886 set olds [lindex $parentlist $row]
3887 set kid [lindex $displayorder $row]
3888 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3889 if {$kidx < 0} continue
3890 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3892 set px [lsearch -exact $nextrow $p]
3893 if {$px < 0} continue
3894 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3895 if {[lsearch -exact $ccross $p] >= 0} continue
3896 if {$x == $px + ($kidx < $px? -1: 1)} {
3898 } elseif {[lsearch -exact $cross $p] < 0} {
3905 return [concat $ccross {{}} $cross]
3908 proc assigncolor {id} {
3909 global colormap colors nextcolor
3910 global commitrow parentlist children children curview
3912 if {[info exists colormap($id)]} return
3913 set ncolors [llength $colors]
3914 if {[info exists children($curview,$id)]} {
3915 set kids $children($curview,$id)
3919 if {[llength $kids] == 1} {
3920 set child [lindex $kids 0]
3921 if {[info exists colormap($child)]
3922 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3923 set colormap($id) $colormap($child)
3929 foreach x [findcrossings $id] {
3931 # delimiter between corner crossings and other crossings
3932 if {[llength $badcolors] >= $ncolors - 1} break
3933 set origbad $badcolors
3935 if {[info exists colormap($x)]
3936 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3937 lappend badcolors $colormap($x)
3940 if {[llength $badcolors] >= $ncolors} {
3941 set badcolors $origbad
3943 set origbad $badcolors
3944 if {[llength $badcolors] < $ncolors - 1} {
3945 foreach child $kids {
3946 if {[info exists colormap($child)]
3947 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3948 lappend badcolors $colormap($child)
3950 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3951 if {[info exists colormap($p)]
3952 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3953 lappend badcolors $colormap($p)
3957 if {[llength $badcolors] >= $ncolors} {
3958 set badcolors $origbad
3961 for {set i 0} {$i <= $ncolors} {incr i} {
3962 set c [lindex $colors $nextcolor]
3963 if {[incr nextcolor] >= $ncolors} {
3966 if {[lsearch -exact $badcolors $c]} break
3968 set colormap($id) $c
3971 proc bindline {t id} {
3974 $canv bind $t <Enter> "lineenter %x %y $id"
3975 $canv bind $t <Motion> "linemotion %x %y $id"
3976 $canv bind $t <Leave> "lineleave $id"
3977 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3980 proc drawtags {id x xt y1} {
3981 global idtags idheads idotherrefs mainhead
3982 global linespc lthickness
3983 global canv commitrow rowtextx curview fgcolor bgcolor
3988 if {[info exists idtags($id)]} {
3989 set marks $idtags($id)
3990 set ntags [llength $marks]
3992 if {[info exists idheads($id)]} {
3993 set marks [concat $marks $idheads($id)]
3994 set nheads [llength $idheads($id)]
3996 if {[info exists idotherrefs($id)]} {
3997 set marks [concat $marks $idotherrefs($id)]
4003 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4004 set yt [expr {$y1 - 0.5 * $linespc}]
4005 set yb [expr {$yt + $linespc - 1}]
4009 foreach tag $marks {
4011 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4012 set wid [font measure mainfontbold $tag]
4014 set wid [font measure mainfont $tag]
4018 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4020 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4021 -width $lthickness -fill black -tags tag.$id]
4023 foreach tag $marks x $xvals wid $wvals {
4024 set xl [expr {$x + $delta}]
4025 set xr [expr {$x + $delta + $wid + $lthickness}]
4027 if {[incr ntags -1] >= 0} {
4029 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4030 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4031 -width 1 -outline black -fill yellow -tags tag.$id]
4032 $canv bind $t <1> [list showtag $tag 1]
4033 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4035 # draw a head or other ref
4036 if {[incr nheads -1] >= 0} {
4038 if {$tag eq $mainhead} {
4039 set font mainfontbold
4044 set xl [expr {$xl - $delta/2}]
4045 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4046 -width 1 -outline black -fill $col -tags tag.$id
4047 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4048 set rwid [font measure mainfont $remoteprefix]
4049 set xi [expr {$x + 1}]
4050 set yti [expr {$yt + 1}]
4051 set xri [expr {$x + $rwid}]
4052 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4053 -width 0 -fill "#ffddaa" -tags tag.$id
4056 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4057 -font $font -tags [list tag.$id text]]
4059 $canv bind $t <1> [list showtag $tag 1]
4060 } elseif {$nheads >= 0} {
4061 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4067 proc xcoord {i level ln} {
4068 global canvx0 xspc1 xspc2
4070 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4071 if {$i > 0 && $i == $level} {
4072 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4073 } elseif {$i > $level} {
4074 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4079 proc show_status {msg} {
4083 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4084 -tags text -fill $fgcolor
4087 # Insert a new commit as the child of the commit on row $row.
4088 # The new commit will be displayed on row $row and the commits
4089 # on that row and below will move down one row.
4090 proc insertrow {row newcmit} {
4091 global displayorder parentlist commitlisted children
4092 global commitrow curview rowidlist rowisopt rowfinal numcommits
4094 global selectedline commitidx ordertok
4096 if {$row >= $numcommits} {
4097 puts "oops, inserting new row $row but only have $numcommits rows"
4100 set p [lindex $displayorder $row]
4101 set displayorder [linsert $displayorder $row $newcmit]
4102 set parentlist [linsert $parentlist $row $p]
4103 set kids $children($curview,$p)
4104 lappend kids $newcmit
4105 set children($curview,$p) $kids
4106 set children($curview,$newcmit) {}
4107 set commitlisted [linsert $commitlisted $row 1]
4108 set l [llength $displayorder]
4109 for {set r $row} {$r < $l} {incr r} {
4110 set id [lindex $displayorder $r]
4111 set commitrow($curview,$id) $r
4113 incr commitidx($curview)
4114 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4116 if {$row < [llength $rowidlist]} {
4117 set idlist [lindex $rowidlist $row]
4118 if {$idlist ne {}} {
4119 if {[llength $kids] == 1} {
4120 set col [lsearch -exact $idlist $p]
4121 lset idlist $col $newcmit
4123 set col [llength $idlist]
4124 lappend idlist $newcmit
4127 set rowidlist [linsert $rowidlist $row $idlist]
4128 set rowisopt [linsert $rowisopt $row 0]
4129 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4134 if {[info exists selectedline] && $selectedline >= $row} {
4140 # Remove a commit that was inserted with insertrow on row $row.
4141 proc removerow {row} {
4142 global displayorder parentlist commitlisted children
4143 global commitrow curview rowidlist rowisopt rowfinal numcommits
4145 global linesegends selectedline commitidx
4147 if {$row >= $numcommits} {
4148 puts "oops, removing row $row but only have $numcommits rows"
4151 set rp1 [expr {$row + 1}]
4152 set id [lindex $displayorder $row]
4153 set p [lindex $parentlist $row]
4154 set displayorder [lreplace $displayorder $row $row]
4155 set parentlist [lreplace $parentlist $row $row]
4156 set commitlisted [lreplace $commitlisted $row $row]
4157 set kids $children($curview,$p)
4158 set i [lsearch -exact $kids $id]
4160 set kids [lreplace $kids $i $i]
4161 set children($curview,$p) $kids
4163 set l [llength $displayorder]
4164 for {set r $row} {$r < $l} {incr r} {
4165 set id [lindex $displayorder $r]
4166 set commitrow($curview,$id) $r
4168 incr commitidx($curview) -1
4170 if {$row < [llength $rowidlist]} {
4171 set rowidlist [lreplace $rowidlist $row $row]
4172 set rowisopt [lreplace $rowisopt $row $row]
4173 set rowfinal [lreplace $rowfinal $row $row]
4178 if {[info exists selectedline] && $selectedline > $row} {
4179 incr selectedline -1
4184 # Don't change the text pane cursor if it is currently the hand cursor,
4185 # showing that we are over a sha1 ID link.
4186 proc settextcursor {c} {
4187 global ctext curtextcursor
4189 if {[$ctext cget -cursor] == $curtextcursor} {
4190 $ctext config -cursor $c
4192 set curtextcursor $c
4195 proc nowbusy {what {name {}}} {
4196 global isbusy busyname statusw
4198 if {[array names isbusy] eq {}} {
4199 . config -cursor watch
4203 set busyname($what) $name
4205 $statusw conf -text $name
4209 proc notbusy {what} {
4210 global isbusy maincursor textcursor busyname statusw
4214 if {$busyname($what) ne {} &&
4215 [$statusw cget -text] eq $busyname($what)} {
4216 $statusw conf -text {}
4219 if {[array names isbusy] eq {}} {
4220 . config -cursor $maincursor
4221 settextcursor $textcursor
4225 proc findmatches {f} {
4226 global findtype findstring
4227 if {$findtype == [mc "Regexp"]} {
4228 set matches [regexp -indices -all -inline $findstring $f]
4231 if {$findtype == [mc "IgnCase"]} {
4232 set f [string tolower $f]
4233 set fs [string tolower $fs]
4237 set l [string length $fs]
4238 while {[set j [string first $fs $f $i]] >= 0} {
4239 lappend matches [list $j [expr {$j+$l-1}]]
4240 set i [expr {$j + $l}]
4246 proc dofind {{dirn 1} {wrap 1}} {
4247 global findstring findstartline findcurline selectedline numcommits
4248 global gdttype filehighlight fh_serial find_dirn findallowwrap
4250 if {[info exists find_dirn]} {
4251 if {$find_dirn == $dirn} return
4255 if {$findstring eq {} || $numcommits == 0} return
4256 if {![info exists selectedline]} {
4257 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4259 set findstartline $selectedline
4261 set findcurline $findstartline
4262 nowbusy finding [mc "Searching"]
4263 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4264 after cancel do_file_hl $fh_serial
4265 do_file_hl $fh_serial
4268 set findallowwrap $wrap
4272 proc stopfinding {} {
4273 global find_dirn findcurline fprogcoord
4275 if {[info exists find_dirn]} {
4285 global commitdata commitinfo numcommits findpattern findloc
4286 global findstartline findcurline displayorder
4287 global find_dirn gdttype fhighlights fprogcoord
4288 global findallowwrap
4290 if {![info exists find_dirn]} {
4293 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4296 if {$find_dirn > 0} {
4298 if {$l >= $numcommits} {
4301 if {$l <= $findstartline} {
4302 set lim [expr {$findstartline + 1}]
4305 set moretodo $findallowwrap
4312 if {$l >= $findstartline} {
4313 set lim [expr {$findstartline - 1}]
4316 set moretodo $findallowwrap
4319 set n [expr {($lim - $l) * $find_dirn}]
4326 if {$gdttype eq [mc "containing:"]} {
4327 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4328 set id [lindex $displayorder $l]
4329 # shouldn't happen unless git log doesn't give all the commits...
4330 if {![info exists commitdata($id)]} continue
4331 if {![doesmatch $commitdata($id)]} continue
4332 if {![info exists commitinfo($id)]} {
4335 set info $commitinfo($id)
4336 foreach f $info ty $fldtypes {
4337 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4346 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4347 set id [lindex $displayorder $l]
4348 if {![info exists fhighlights($l)]} {
4349 askfilehighlight $l $id
4352 set findcurline [expr {$l - $find_dirn}]
4354 } elseif {$fhighlights($l)} {
4360 if {$found || ($domore && !$moretodo)} {
4376 set findcurline [expr {$l - $find_dirn}]
4378 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4382 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4387 proc findselectline {l} {
4388 global findloc commentend ctext findcurline markingmatches gdttype
4390 set markingmatches 1
4393 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4394 # highlight the matches in the comments
4395 set f [$ctext get 1.0 $commentend]
4396 set matches [findmatches $f]
4397 foreach match $matches {
4398 set start [lindex $match 0]
4399 set end [expr {[lindex $match 1] + 1}]
4400 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4406 # mark the bits of a headline or author that match a find string
4407 proc markmatches {canv l str tag matches font row} {
4410 set bbox [$canv bbox $tag]
4411 set x0 [lindex $bbox 0]
4412 set y0 [lindex $bbox 1]
4413 set y1 [lindex $bbox 3]
4414 foreach match $matches {
4415 set start [lindex $match 0]
4416 set end [lindex $match 1]
4417 if {$start > $end} continue
4418 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4419 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4420 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4421 [expr {$x0+$xlen+2}] $y1 \
4422 -outline {} -tags [list match$l matches] -fill yellow]
4424 if {[info exists selectedline] && $row == $selectedline} {
4425 $canv raise $t secsel
4430 proc unmarkmatches {} {
4431 global markingmatches
4433 allcanvs delete matches
4434 set markingmatches 0
4438 proc selcanvline {w x y} {
4439 global canv canvy0 ctext linespc
4441 set ymax [lindex [$canv cget -scrollregion] 3]
4442 if {$ymax == {}} return
4443 set yfrac [lindex [$canv yview] 0]
4444 set y [expr {$y + $yfrac * $ymax}]
4445 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4450 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4456 proc commit_descriptor {p} {
4458 if {![info exists commitinfo($p)]} {
4462 if {[llength $commitinfo($p)] > 1} {
4463 set l [lindex $commitinfo($p) 0]
4468 # append some text to the ctext widget, and make any SHA1 ID
4469 # that we know about be a clickable link.
4470 proc appendwithlinks {text tags} {
4471 global ctext commitrow linknum curview pendinglinks
4473 set start [$ctext index "end - 1c"]
4474 $ctext insert end $text $tags
4475 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4479 set linkid [string range $text $s $e]
4481 $ctext tag delete link$linknum
4482 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4483 setlink $linkid link$linknum
4488 proc setlink {id lk} {
4489 global curview commitrow ctext pendinglinks commitinterest
4491 if {[info exists commitrow($curview,$id)]} {
4492 $ctext tag conf $lk -foreground blue -underline 1
4493 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4494 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4495 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4497 lappend pendinglinks($id) $lk
4498 lappend commitinterest($id) {makelink %I}
4502 proc makelink {id} {
4505 if {![info exists pendinglinks($id)]} return
4506 foreach lk $pendinglinks($id) {
4509 unset pendinglinks($id)
4512 proc linkcursor {w inc} {
4513 global linkentercount curtextcursor
4515 if {[incr linkentercount $inc] > 0} {
4516 $w configure -cursor hand2
4518 $w configure -cursor $curtextcursor
4519 if {$linkentercount < 0} {
4520 set linkentercount 0
4525 proc viewnextline {dir} {
4529 set ymax [lindex [$canv cget -scrollregion] 3]
4530 set wnow [$canv yview]
4531 set wtop [expr {[lindex $wnow 0] * $ymax}]
4532 set newtop [expr {$wtop + $dir * $linespc}]
4535 } elseif {$newtop > $ymax} {
4538 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4541 # add a list of tag or branch names at position pos
4542 # returns the number of names inserted
4543 proc appendrefs {pos ids var} {
4544 global ctext commitrow linknum curview $var maxrefs
4546 if {[catch {$ctext index $pos}]} {
4549 $ctext conf -state normal
4550 $ctext delete $pos "$pos lineend"
4553 foreach tag [set $var\($id\)] {
4554 lappend tags [list $tag $id]
4557 if {[llength $tags] > $maxrefs} {
4558 $ctext insert $pos "many ([llength $tags])"
4560 set tags [lsort -index 0 -decreasing $tags]
4563 set id [lindex $ti 1]
4566 $ctext tag delete $lk
4567 $ctext insert $pos $sep
4568 $ctext insert $pos [lindex $ti 0] $lk
4573 $ctext conf -state disabled
4574 return [llength $tags]
4577 # called when we have finished computing the nearby tags
4578 proc dispneartags {delay} {
4579 global selectedline currentid showneartags tagphase
4581 if {![info exists selectedline] || !$showneartags} return
4582 after cancel dispnexttag
4584 after 200 dispnexttag
4587 after idle dispnexttag
4592 proc dispnexttag {} {
4593 global selectedline currentid showneartags tagphase ctext
4595 if {![info exists selectedline] || !$showneartags} return
4596 switch -- $tagphase {
4598 set dtags [desctags $currentid]
4600 appendrefs precedes $dtags idtags
4604 set atags [anctags $currentid]
4606 appendrefs follows $atags idtags
4610 set dheads [descheads $currentid]
4611 if {$dheads ne {}} {
4612 if {[appendrefs branch $dheads idheads] > 1
4613 && [$ctext get "branch -3c"] eq "h"} {
4614 # turn "Branch" into "Branches"
4615 $ctext conf -state normal
4616 $ctext insert "branch -2c" "es"
4617 $ctext conf -state disabled
4622 if {[incr tagphase] <= 2} {
4623 after idle dispnexttag
4627 proc make_secsel {l} {
4628 global linehtag linentag linedtag canv canv2 canv3
4630 if {![info exists linehtag($l)]} return
4632 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4633 -tags secsel -fill [$canv cget -selectbackground]]
4635 $canv2 delete secsel
4636 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4637 -tags secsel -fill [$canv2 cget -selectbackground]]
4639 $canv3 delete secsel
4640 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4641 -tags secsel -fill [$canv3 cget -selectbackground]]
4645 proc selectline {l isnew} {
4646 global canv ctext commitinfo selectedline
4648 global canvy0 linespc parentlist children curview
4649 global currentid sha1entry
4650 global commentend idtags linknum
4651 global mergemax numcommits pending_select
4652 global cmitmode showneartags allcommits
4654 catch {unset pending_select}
4659 if {$l < 0 || $l >= $numcommits} return
4660 set y [expr {$canvy0 + $l * $linespc}]
4661 set ymax [lindex [$canv cget -scrollregion] 3]
4662 set ytop [expr {$y - $linespc - 1}]
4663 set ybot [expr {$y + $linespc + 1}]
4664 set wnow [$canv yview]
4665 set wtop [expr {[lindex $wnow 0] * $ymax}]
4666 set wbot [expr {[lindex $wnow 1] * $ymax}]
4667 set wh [expr {$wbot - $wtop}]
4669 if {$ytop < $wtop} {
4670 if {$ybot < $wtop} {
4671 set newtop [expr {$y - $wh / 2.0}]
4674 if {$newtop > $wtop - $linespc} {
4675 set newtop [expr {$wtop - $linespc}]
4678 } elseif {$ybot > $wbot} {
4679 if {$ytop > $wbot} {
4680 set newtop [expr {$y - $wh / 2.0}]
4682 set newtop [expr {$ybot - $wh}]
4683 if {$newtop < $wtop + $linespc} {
4684 set newtop [expr {$wtop + $linespc}]
4688 if {$newtop != $wtop} {
4692 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4699 addtohistory [list selectline $l 0]
4704 set id [lindex $displayorder $l]
4706 $sha1entry delete 0 end
4707 $sha1entry insert 0 $id
4708 $sha1entry selection from 0
4709 $sha1entry selection to end
4712 $ctext conf -state normal
4715 set info $commitinfo($id)
4716 set date [formatdate [lindex $info 2]]
4717 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
4718 set date [formatdate [lindex $info 4]]
4719 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
4720 if {[info exists idtags($id)]} {
4721 $ctext insert end [mc "Tags:"]
4722 foreach tag $idtags($id) {
4723 $ctext insert end " $tag"
4725 $ctext insert end "\n"
4729 set olds [lindex $parentlist $l]
4730 if {[llength $olds] > 1} {
4733 if {$np >= $mergemax} {
4738 $ctext insert end "[mc "Parent"]: " $tag
4739 appendwithlinks [commit_descriptor $p] {}
4744 append headers "[mc "Parent"]: [commit_descriptor $p]"
4748 foreach c $children($curview,$id) {
4749 append headers "[mc "Child"]: [commit_descriptor $c]"
4752 # make anything that looks like a SHA1 ID be a clickable link
4753 appendwithlinks $headers {}
4754 if {$showneartags} {
4755 if {![info exists allcommits]} {
4758 $ctext insert end "[mc "Branch"]: "
4759 $ctext mark set branch "end -1c"
4760 $ctext mark gravity branch left
4761 $ctext insert end "\n[mc "Follows"]: "
4762 $ctext mark set follows "end -1c"
4763 $ctext mark gravity follows left
4764 $ctext insert end "\n[mc "Precedes"]: "
4765 $ctext mark set precedes "end -1c"
4766 $ctext mark gravity precedes left
4767 $ctext insert end "\n"
4770 $ctext insert end "\n"
4771 set comment [lindex $info 5]
4772 if {[string first "\r" $comment] >= 0} {
4773 set comment [string map {"\r" "\n "} $comment]
4775 appendwithlinks $comment {comment}
4777 $ctext tag remove found 1.0 end
4778 $ctext conf -state disabled
4779 set commentend [$ctext index "end - 1c"]
4781 init_flist [mc "Comments"]
4782 if {$cmitmode eq "tree"} {
4784 } elseif {[llength $olds] <= 1} {
4791 proc selfirstline {} {
4796 proc sellastline {} {
4799 set l [expr {$numcommits - 1}]
4803 proc selnextline {dir} {
4806 if {![info exists selectedline]} return
4807 set l [expr {$selectedline + $dir}]
4812 proc selnextpage {dir} {
4813 global canv linespc selectedline numcommits
4815 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4819 allcanvs yview scroll [expr {$dir * $lpp}] units
4821 if {![info exists selectedline]} return
4822 set l [expr {$selectedline + $dir * $lpp}]
4825 } elseif {$l >= $numcommits} {
4826 set l [expr $numcommits - 1]
4832 proc unselectline {} {
4833 global selectedline currentid
4835 catch {unset selectedline}
4836 catch {unset currentid}
4837 allcanvs delete secsel
4841 proc reselectline {} {
4844 if {[info exists selectedline]} {
4845 selectline $selectedline 0
4849 proc addtohistory {cmd} {
4850 global history historyindex curview
4852 set elt [list $curview $cmd]
4853 if {$historyindex > 0
4854 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4858 if {$historyindex < [llength $history]} {
4859 set history [lreplace $history $historyindex end $elt]
4861 lappend history $elt
4864 if {$historyindex > 1} {
4865 .tf.bar.leftbut conf -state normal
4867 .tf.bar.leftbut conf -state disabled
4869 .tf.bar.rightbut conf -state disabled
4875 set view [lindex $elt 0]
4876 set cmd [lindex $elt 1]
4877 if {$curview != $view} {
4884 global history historyindex
4887 if {$historyindex > 1} {
4888 incr historyindex -1
4889 godo [lindex $history [expr {$historyindex - 1}]]
4890 .tf.bar.rightbut conf -state normal
4892 if {$historyindex <= 1} {
4893 .tf.bar.leftbut conf -state disabled
4898 global history historyindex
4901 if {$historyindex < [llength $history]} {
4902 set cmd [lindex $history $historyindex]
4905 .tf.bar.leftbut conf -state normal
4907 if {$historyindex >= [llength $history]} {
4908 .tf.bar.rightbut conf -state disabled
4913 global treefilelist treeidlist diffids diffmergeid treepending
4914 global nullid nullid2
4917 catch {unset diffmergeid}
4918 if {![info exists treefilelist($id)]} {
4919 if {![info exists treepending]} {
4920 if {$id eq $nullid} {
4921 set cmd [list | git ls-files]
4922 } elseif {$id eq $nullid2} {
4923 set cmd [list | git ls-files --stage -t]
4925 set cmd [list | git ls-tree -r $id]
4927 if {[catch {set gtf [open $cmd r]}]} {
4931 set treefilelist($id) {}
4932 set treeidlist($id) {}
4933 fconfigure $gtf -blocking 0
4934 filerun $gtf [list gettreeline $gtf $id]
4941 proc gettreeline {gtf id} {
4942 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4945 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4946 if {$diffids eq $nullid} {
4949 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4950 set i [string first "\t" $line]
4951 if {$i < 0} continue
4952 set sha1 [lindex $line 2]
4953 set fname [string range $line [expr {$i+1}] end]
4954 if {[string index $fname 0] eq "\""} {
4955 set fname [lindex $fname 0]
4957 lappend treeidlist($id) $sha1
4959 lappend treefilelist($id) $fname
4962 return [expr {$nl >= 1000? 2: 1}]
4966 if {$cmitmode ne "tree"} {
4967 if {![info exists diffmergeid]} {
4968 gettreediffs $diffids
4970 } elseif {$id ne $diffids} {
4979 global treefilelist treeidlist diffids nullid nullid2
4980 global ctext commentend
4982 set i [lsearch -exact $treefilelist($diffids) $f]
4984 puts "oops, $f not in list for id $diffids"
4987 if {$diffids eq $nullid} {
4988 if {[catch {set bf [open $f r]} err]} {
4989 puts "oops, can't read $f: $err"
4993 set blob [lindex $treeidlist($diffids) $i]
4994 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4995 puts "oops, error reading blob $blob: $err"
4999 fconfigure $bf -blocking 0
5000 filerun $bf [list getblobline $bf $diffids]
5001 $ctext config -state normal
5002 clear_ctext $commentend
5003 $ctext insert end "\n"
5004 $ctext insert end "$f\n" filesep
5005 $ctext config -state disabled
5006 $ctext yview $commentend
5010 proc getblobline {bf id} {
5011 global diffids cmitmode ctext
5013 if {$id ne $diffids || $cmitmode ne "tree"} {
5017 $ctext config -state normal
5019 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5020 $ctext insert end "$line\n"
5023 # delete last newline
5024 $ctext delete "end - 2c" "end - 1c"
5028 $ctext config -state disabled
5029 return [expr {$nl >= 1000? 2: 1}]
5032 proc mergediff {id l} {
5033 global diffmergeid mdifffd
5037 global limitdiffs viewfiles curview
5041 # this doesn't seem to actually affect anything...
5042 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5043 if {$limitdiffs && $viewfiles($curview) ne {}} {
5044 set cmd [concat $cmd -- $viewfiles($curview)]
5046 if {[catch {set mdf [open $cmd r]} err]} {
5047 error_popup "[mc "Error getting merge diffs:"] $err"
5050 fconfigure $mdf -blocking 0
5051 set mdifffd($id) $mdf
5052 set np [llength [lindex $parentlist $l]]
5054 filerun $mdf [list getmergediffline $mdf $id $np]
5057 proc getmergediffline {mdf id np} {
5058 global diffmergeid ctext cflist mergemax
5059 global difffilestart mdifffd
5061 $ctext conf -state normal
5063 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5064 if {![info exists diffmergeid] || $id != $diffmergeid
5065 || $mdf != $mdifffd($id)} {
5069 if {[regexp {^diff --cc (.*)} $line match fname]} {
5070 # start of a new file
5071 $ctext insert end "\n"
5072 set here [$ctext index "end - 1c"]
5073 lappend difffilestart $here
5074 add_flist [list $fname]
5075 set l [expr {(78 - [string length $fname]) / 2}]
5076 set pad [string range "----------------------------------------" 1 $l]
5077 $ctext insert end "$pad $fname $pad\n" filesep
5078 } elseif {[regexp {^@@} $line]} {
5079 $ctext insert end "$line\n" hunksep
5080 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5083 # parse the prefix - one ' ', '-' or '+' for each parent
5088 for {set j 0} {$j < $np} {incr j} {
5089 set c [string range $line $j $j]
5092 } elseif {$c == "-"} {
5094 } elseif {$c == "+"} {
5103 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5104 # line doesn't appear in result, parents in $minuses have the line
5105 set num [lindex $minuses 0]
5106 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5107 # line appears in result, parents in $pluses don't have the line
5108 lappend tags mresult
5109 set num [lindex $spaces 0]
5112 if {$num >= $mergemax} {
5117 $ctext insert end "$line\n" $tags
5120 $ctext conf -state disabled
5125 return [expr {$nr >= 1000? 2: 1}]
5128 proc startdiff {ids} {
5129 global treediffs diffids treepending diffmergeid nullid nullid2
5133 catch {unset diffmergeid}
5134 if {![info exists treediffs($ids)] ||
5135 [lsearch -exact $ids $nullid] >= 0 ||
5136 [lsearch -exact $ids $nullid2] >= 0} {
5137 if {![info exists treepending]} {
5145 proc path_filter {filter name} {
5147 set l [string length $p]
5148 if {[string index $p end] eq "/"} {
5149 if {[string compare -length $l $p $name] == 0} {
5153 if {[string compare -length $l $p $name] == 0 &&
5154 ([string length $name] == $l ||
5155 [string index $name $l] eq "/")} {
5163 proc addtocflist {ids} {
5166 add_flist $treediffs($ids)
5170 proc diffcmd {ids flags} {
5171 global nullid nullid2
5173 set i [lsearch -exact $ids $nullid]
5174 set j [lsearch -exact $ids $nullid2]
5176 if {[llength $ids] > 1 && $j < 0} {
5177 # comparing working directory with some specific revision
5178 set cmd [concat | git diff-index $flags]
5180 lappend cmd -R [lindex $ids 1]
5182 lappend cmd [lindex $ids 0]
5185 # comparing working directory with index
5186 set cmd [concat | git diff-files $flags]
5191 } elseif {$j >= 0} {
5192 set cmd [concat | git diff-index --cached $flags]
5193 if {[llength $ids] > 1} {
5194 # comparing index with specific revision
5196 lappend cmd -R [lindex $ids 1]
5198 lappend cmd [lindex $ids 0]
5201 # comparing index with HEAD
5205 set cmd [concat | git diff-tree -r $flags $ids]
5210 proc gettreediffs {ids} {
5211 global treediff treepending
5213 set treepending $ids
5215 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5216 fconfigure $gdtf -blocking 0
5217 filerun $gdtf [list gettreediffline $gdtf $ids]
5220 proc gettreediffline {gdtf ids} {
5221 global treediff treediffs treepending diffids diffmergeid
5222 global cmitmode viewfiles curview limitdiffs
5225 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5226 set i [string first "\t" $line]
5228 set file [string range $line [expr {$i+1}] end]
5229 if {[string index $file 0] eq "\""} {
5230 set file [lindex $file 0]
5232 lappend treediff $file
5236 return [expr {$nr >= 1000? 2: 1}]
5239 if {$limitdiffs && $viewfiles($curview) ne {}} {
5241 foreach f $treediff {
5242 if {[path_filter $viewfiles($curview) $f]} {
5246 set treediffs($ids) $flist
5248 set treediffs($ids) $treediff
5251 if {$cmitmode eq "tree"} {
5253 } elseif {$ids != $diffids} {
5254 if {![info exists diffmergeid]} {
5255 gettreediffs $diffids
5263 # empty string or positive integer
5264 proc diffcontextvalidate {v} {
5265 return [regexp {^(|[1-9][0-9]*)$} $v]
5268 proc diffcontextchange {n1 n2 op} {
5269 global diffcontextstring diffcontext
5271 if {[string is integer -strict $diffcontextstring]} {
5272 if {$diffcontextstring > 0} {
5273 set diffcontext $diffcontextstring
5279 proc changeignorespace {} {
5283 proc getblobdiffs {ids} {
5284 global blobdifffd diffids env
5285 global diffinhdr treediffs
5288 global limitdiffs viewfiles curview
5290 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5294 if {$limitdiffs && $viewfiles($curview) ne {}} {
5295 set cmd [concat $cmd -- $viewfiles($curview)]
5297 if {[catch {set bdf [open $cmd r]} err]} {
5298 puts "error getting diffs: $err"
5302 fconfigure $bdf -blocking 0
5303 set blobdifffd($ids) $bdf
5304 filerun $bdf [list getblobdiffline $bdf $diffids]
5307 proc setinlist {var i val} {
5310 while {[llength [set $var]] < $i} {
5313 if {[llength [set $var]] == $i} {
5320 proc makediffhdr {fname ids} {
5321 global ctext curdiffstart treediffs
5323 set i [lsearch -exact $treediffs($ids) $fname]
5325 setinlist difffilestart $i $curdiffstart
5327 set l [expr {(78 - [string length $fname]) / 2}]
5328 set pad [string range "----------------------------------------" 1 $l]
5329 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5332 proc getblobdiffline {bdf ids} {
5333 global diffids blobdifffd ctext curdiffstart
5334 global diffnexthead diffnextnote difffilestart
5335 global diffinhdr treediffs
5338 $ctext conf -state normal
5339 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5340 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5344 if {![string compare -length 11 "diff --git " $line]} {
5345 # trim off "diff --git "
5346 set line [string range $line 11 end]
5348 # start of a new file
5349 $ctext insert end "\n"
5350 set curdiffstart [$ctext index "end - 1c"]
5351 $ctext insert end "\n" filesep
5352 # If the name hasn't changed the length will be odd,
5353 # the middle char will be a space, and the two bits either
5354 # side will be a/name and b/name, or "a/name" and "b/name".
5355 # If the name has changed we'll get "rename from" and
5356 # "rename to" or "copy from" and "copy to" lines following this,
5357 # and we'll use them to get the filenames.
5358 # This complexity is necessary because spaces in the filename(s)
5359 # don't get escaped.
5360 set l [string length $line]
5361 set i [expr {$l / 2}]
5362 if {!(($l & 1) && [string index $line $i] eq " " &&
5363 [string range $line 2 [expr {$i - 1}]] eq \
5364 [string range $line [expr {$i + 3}] end])} {
5367 # unescape if quoted and chop off the a/ from the front
5368 if {[string index $line 0] eq "\""} {
5369 set fname [string range [lindex $line 0] 2 end]
5371 set fname [string range $line 2 [expr {$i - 1}]]
5373 makediffhdr $fname $ids
5375 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5376 $line match f1l f1c f2l f2c rest]} {
5377 $ctext insert end "$line\n" hunksep
5380 } elseif {$diffinhdr} {
5381 if {![string compare -length 12 "rename from " $line]} {
5382 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5383 if {[string index $fname 0] eq "\""} {
5384 set fname [lindex $fname 0]
5386 set i [lsearch -exact $treediffs($ids) $fname]
5388 setinlist difffilestart $i $curdiffstart
5390 } elseif {![string compare -length 10 $line "rename to "] ||
5391 ![string compare -length 8 $line "copy to "]} {
5392 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5393 if {[string index $fname 0] eq "\""} {
5394 set fname [lindex $fname 0]
5396 makediffhdr $fname $ids
5397 } elseif {[string compare -length 3 $line "---"] == 0} {
5400 } elseif {[string compare -length 3 $line "+++"] == 0} {
5404 $ctext insert end "$line\n" filesep
5407 set x [string range $line 0 0]
5408 if {$x == "-" || $x == "+"} {
5409 set tag [expr {$x == "+"}]
5410 $ctext insert end "$line\n" d$tag
5411 } elseif {$x == " "} {
5412 $ctext insert end "$line\n"
5414 # "\ No newline at end of file",
5415 # or something else we don't recognize
5416 $ctext insert end "$line\n" hunksep
5420 $ctext conf -state disabled
5425 return [expr {$nr >= 1000? 2: 1}]
5428 proc changediffdisp {} {
5429 global ctext diffelide
5431 $ctext tag conf d0 -elide [lindex $diffelide 0]
5432 $ctext tag conf d1 -elide [lindex $diffelide 1]
5436 global difffilestart ctext
5437 set prev [lindex $difffilestart 0]
5438 set here [$ctext index @0,0]
5439 foreach loc $difffilestart {
5440 if {[$ctext compare $loc >= $here]} {
5450 global difffilestart ctext
5451 set here [$ctext index @0,0]
5452 foreach loc $difffilestart {
5453 if {[$ctext compare $loc > $here]} {
5460 proc clear_ctext {{first 1.0}} {
5461 global ctext smarktop smarkbot
5464 set l [lindex [split $first .] 0]
5465 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5468 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5471 $ctext delete $first end
5472 if {$first eq "1.0"} {
5473 catch {unset pendinglinks}
5477 proc settabs {{firstab {}}} {
5478 global firsttabstop tabstop ctext have_tk85
5480 if {$firstab ne {} && $have_tk85} {
5481 set firsttabstop $firstab
5483 set w [font measure textfont "0"]
5484 if {$firsttabstop != 0} {
5485 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5486 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5487 } elseif {$have_tk85 || $tabstop != 8} {
5488 $ctext conf -tabs [expr {$tabstop * $w}]
5490 $ctext conf -tabs {}
5494 proc incrsearch {name ix op} {
5495 global ctext searchstring searchdirn
5497 $ctext tag remove found 1.0 end
5498 if {[catch {$ctext index anchor}]} {
5499 # no anchor set, use start of selection, or of visible area
5500 set sel [$ctext tag ranges sel]
5502 $ctext mark set anchor [lindex $sel 0]
5503 } elseif {$searchdirn eq "-forwards"} {
5504 $ctext mark set anchor @0,0
5506 $ctext mark set anchor @0,[winfo height $ctext]
5509 if {$searchstring ne {}} {
5510 set here [$ctext search $searchdirn -- $searchstring anchor]
5519 global sstring ctext searchstring searchdirn
5522 $sstring icursor end
5523 set searchdirn -forwards
5524 if {$searchstring ne {}} {
5525 set sel [$ctext tag ranges sel]
5527 set start "[lindex $sel 0] + 1c"
5528 } elseif {[catch {set start [$ctext index anchor]}]} {
5531 set match [$ctext search -count mlen -- $searchstring $start]
5532 $ctext tag remove sel 1.0 end
5538 set mend "$match + $mlen c"
5539 $ctext tag add sel $match $mend
5540 $ctext mark unset anchor
5544 proc dosearchback {} {
5545 global sstring ctext searchstring searchdirn
5548 $sstring icursor end
5549 set searchdirn -backwards
5550 if {$searchstring ne {}} {
5551 set sel [$ctext tag ranges sel]
5553 set start [lindex $sel 0]
5554 } elseif {[catch {set start [$ctext index anchor]}]} {
5555 set start @0,[winfo height $ctext]
5557 set match [$ctext search -backwards -count ml -- $searchstring $start]
5558 $ctext tag remove sel 1.0 end
5564 set mend "$match + $ml c"
5565 $ctext tag add sel $match $mend
5566 $ctext mark unset anchor
5570 proc searchmark {first last} {
5571 global ctext searchstring
5575 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5576 if {$match eq {}} break
5577 set mend "$match + $mlen c"
5578 $ctext tag add found $match $mend
5582 proc searchmarkvisible {doall} {
5583 global ctext smarktop smarkbot
5585 set topline [lindex [split [$ctext index @0,0] .] 0]
5586 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5587 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5588 # no overlap with previous
5589 searchmark $topline $botline
5590 set smarktop $topline
5591 set smarkbot $botline
5593 if {$topline < $smarktop} {
5594 searchmark $topline [expr {$smarktop-1}]
5595 set smarktop $topline
5597 if {$botline > $smarkbot} {
5598 searchmark [expr {$smarkbot+1}] $botline
5599 set smarkbot $botline
5604 proc scrolltext {f0 f1} {
5607 .bleft.sb set $f0 $f1
5608 if {$searchstring ne {}} {
5614 global linespc charspc canvx0 canvy0
5615 global xspc1 xspc2 lthickness
5617 set linespc [font metrics mainfont -linespace]
5618 set charspc [font measure mainfont "m"]
5619 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5620 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5621 set lthickness [expr {int($linespc / 9) + 1}]
5622 set xspc1(0) $linespc
5630 set ymax [lindex [$canv cget -scrollregion] 3]
5631 if {$ymax eq {} || $ymax == 0} return
5632 set span [$canv yview]
5635 allcanvs yview moveto [lindex $span 0]
5637 if {[info exists selectedline]} {
5638 selectline $selectedline 0
5639 allcanvs yview moveto [lindex $span 0]
5643 proc parsefont {f n} {
5646 set fontattr($f,family) [lindex $n 0]
5648 if {$s eq {} || $s == 0} {
5651 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5653 set fontattr($f,size) $s
5654 set fontattr($f,weight) normal
5655 set fontattr($f,slant) roman
5656 foreach style [lrange $n 2 end] {
5659 "bold" {set fontattr($f,weight) $style}
5661 "italic" {set fontattr($f,slant) $style}
5666 proc fontflags {f {isbold 0}} {
5669 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5670 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5671 -slant $fontattr($f,slant)]
5677 set n [list $fontattr($f,family) $fontattr($f,size)]
5678 if {$fontattr($f,weight) eq "bold"} {
5681 if {$fontattr($f,slant) eq "italic"} {
5687 proc incrfont {inc} {
5688 global mainfont textfont ctext canv phase cflist showrefstop
5689 global stopped entries fontattr
5692 set s $fontattr(mainfont,size)
5697 set fontattr(mainfont,size) $s
5698 font config mainfont -size $s
5699 font config mainfontbold -size $s
5700 set mainfont [fontname mainfont]
5701 set s $fontattr(textfont,size)
5706 set fontattr(textfont,size) $s
5707 font config textfont -size $s
5708 font config textfontbold -size $s
5709 set textfont [fontname textfont]
5716 global sha1entry sha1string
5717 if {[string length $sha1string] == 40} {
5718 $sha1entry delete 0 end
5722 proc sha1change {n1 n2 op} {
5723 global sha1string currentid sha1but
5724 if {$sha1string == {}
5725 || ([info exists currentid] && $sha1string == $currentid)} {
5730 if {[$sha1but cget -state] == $state} return
5731 if {$state == "normal"} {
5732 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5734 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5738 proc gotocommit {} {
5739 global sha1string currentid commitrow tagids headids
5740 global displayorder numcommits curview
5742 if {$sha1string == {}
5743 || ([info exists currentid] && $sha1string == $currentid)} return
5744 if {[info exists tagids($sha1string)]} {
5745 set id $tagids($sha1string)
5746 } elseif {[info exists headids($sha1string)]} {
5747 set id $headids($sha1string)
5749 set id [string tolower $sha1string]
5750 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5752 foreach i $displayorder {
5753 if {[string match $id* $i]} {
5757 if {$matches ne {}} {
5758 if {[llength $matches] > 1} {
5759 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5762 set id [lindex $matches 0]
5766 if {[info exists commitrow($curview,$id)]} {
5767 selectline $commitrow($curview,$id) 1
5770 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5771 set msg [mc "SHA1 id %s is not known" $sha1string]
5773 set msg [mc "Tag/Head %s is not known" $sha1string]
5778 proc lineenter {x y id} {
5779 global hoverx hovery hoverid hovertimer
5780 global commitinfo canv
5782 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5786 if {[info exists hovertimer]} {
5787 after cancel $hovertimer
5789 set hovertimer [after 500 linehover]
5793 proc linemotion {x y id} {
5794 global hoverx hovery hoverid hovertimer
5796 if {[info exists hoverid] && $id == $hoverid} {
5799 if {[info exists hovertimer]} {
5800 after cancel $hovertimer
5802 set hovertimer [after 500 linehover]
5806 proc lineleave {id} {
5807 global hoverid hovertimer canv
5809 if {[info exists hoverid] && $id == $hoverid} {
5811 if {[info exists hovertimer]} {
5812 after cancel $hovertimer
5820 global hoverx hovery hoverid hovertimer
5821 global canv linespc lthickness
5824 set text [lindex $commitinfo($hoverid) 0]
5825 set ymax [lindex [$canv cget -scrollregion] 3]
5826 if {$ymax == {}} return
5827 set yfrac [lindex [$canv yview] 0]
5828 set x [expr {$hoverx + 2 * $linespc}]
5829 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5830 set x0 [expr {$x - 2 * $lthickness}]
5831 set y0 [expr {$y - 2 * $lthickness}]
5832 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5833 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5834 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5835 -fill \#ffff80 -outline black -width 1 -tags hover]
5837 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5842 proc clickisonarrow {id y} {
5845 set ranges [rowranges $id]
5846 set thresh [expr {2 * $lthickness + 6}]
5847 set n [expr {[llength $ranges] - 1}]
5848 for {set i 1} {$i < $n} {incr i} {
5849 set row [lindex $ranges $i]
5850 if {abs([yc $row] - $y) < $thresh} {
5857 proc arrowjump {id n y} {
5860 # 1 <-> 2, 3 <-> 4, etc...
5861 set n [expr {(($n - 1) ^ 1) + 1}]
5862 set row [lindex [rowranges $id] $n]
5864 set ymax [lindex [$canv cget -scrollregion] 3]
5865 if {$ymax eq {} || $ymax <= 0} return
5866 set view [$canv yview]
5867 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5868 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5872 allcanvs yview moveto $yfrac
5875 proc lineclick {x y id isnew} {
5876 global ctext commitinfo children canv thickerline curview commitrow
5878 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5883 # draw this line thicker than normal
5887 set ymax [lindex [$canv cget -scrollregion] 3]
5888 if {$ymax eq {}} return
5889 set yfrac [lindex [$canv yview] 0]
5890 set y [expr {$y + $yfrac * $ymax}]
5892 set dirn [clickisonarrow $id $y]
5894 arrowjump $id $dirn $y
5899 addtohistory [list lineclick $x $y $id 0]
5901 # fill the details pane with info about this line
5902 $ctext conf -state normal
5905 $ctext insert end "[mc "Parent"]:\t"
5906 $ctext insert end $id link0
5908 set info $commitinfo($id)
5909 $ctext insert end "\n\t[lindex $info 0]\n"
5910 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5911 set date [formatdate [lindex $info 2]]
5912 $ctext insert end "\t[mc "Date"]:\t$date\n"
5913 set kids $children($curview,$id)
5915 $ctext insert end "\n[mc "Children"]:"
5917 foreach child $kids {
5919 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5920 set info $commitinfo($child)
5921 $ctext insert end "\n\t"
5922 $ctext insert end $child link$i
5923 setlink $child link$i
5924 $ctext insert end "\n\t[lindex $info 0]"
5925 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5926 set date [formatdate [lindex $info 2]]
5927 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5930 $ctext conf -state disabled
5934 proc normalline {} {
5936 if {[info exists thickerline]} {
5944 global commitrow curview
5945 if {[info exists commitrow($curview,$id)]} {
5946 selectline $commitrow($curview,$id) 1
5952 if {![info exists startmstime]} {
5953 set startmstime [clock clicks -milliseconds]
5955 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5958 proc rowmenu {x y id} {
5959 global rowctxmenu commitrow selectedline rowmenuid curview
5960 global nullid nullid2 fakerowmenu mainhead
5964 if {![info exists selectedline]
5965 || $commitrow($curview,$id) eq $selectedline} {
5970 if {$id ne $nullid && $id ne $nullid2} {
5971 set menu $rowctxmenu
5972 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
5974 set menu $fakerowmenu
5976 $menu entryconfigure [mc "Diff this -> selected"] -state $state
5977 $menu entryconfigure [mc "Diff selected -> this"] -state $state
5978 $menu entryconfigure [mc "Make patch"] -state $state
5979 tk_popup $menu $x $y
5982 proc diffvssel {dirn} {
5983 global rowmenuid selectedline displayorder
5985 if {![info exists selectedline]} return
5987 set oldid [lindex $displayorder $selectedline]
5988 set newid $rowmenuid
5990 set oldid $rowmenuid
5991 set newid [lindex $displayorder $selectedline]
5993 addtohistory [list doseldiff $oldid $newid]
5994 doseldiff $oldid $newid
5997 proc doseldiff {oldid newid} {
6001 $ctext conf -state normal
6003 init_flist [mc "Top"]
6004 $ctext insert end "[mc "From"] "
6005 $ctext insert end $oldid link0
6006 setlink $oldid link0
6007 $ctext insert end "\n "
6008 $ctext insert end [lindex $commitinfo($oldid) 0]
6009 $ctext insert end "\n\n[mc "To"] "
6010 $ctext insert end $newid link1
6011 setlink $newid link1
6012 $ctext insert end "\n "
6013 $ctext insert end [lindex $commitinfo($newid) 0]
6014 $ctext insert end "\n"
6015 $ctext conf -state disabled
6016 $ctext tag remove found 1.0 end
6017 startdiff [list $oldid $newid]
6021 global rowmenuid currentid commitinfo patchtop patchnum
6023 if {![info exists currentid]} return
6024 set oldid $currentid
6025 set oldhead [lindex $commitinfo($oldid) 0]
6026 set newid $rowmenuid
6027 set newhead [lindex $commitinfo($newid) 0]
6030 catch {destroy $top}
6032 label $top.title -text [mc "Generate patch"]
6033 grid $top.title - -pady 10
6034 label $top.from -text [mc "From:"]
6035 entry $top.fromsha1 -width 40 -relief flat
6036 $top.fromsha1 insert 0 $oldid
6037 $top.fromsha1 conf -state readonly
6038 grid $top.from $top.fromsha1 -sticky w
6039 entry $top.fromhead -width 60 -relief flat
6040 $top.fromhead insert 0 $oldhead
6041 $top.fromhead conf -state readonly
6042 grid x $top.fromhead -sticky w
6043 label $top.to -text [mc "To:"]
6044 entry $top.tosha1 -width 40 -relief flat
6045 $top.tosha1 insert 0 $newid
6046 $top.tosha1 conf -state readonly
6047 grid $top.to $top.tosha1 -sticky w
6048 entry $top.tohead -width 60 -relief flat
6049 $top.tohead insert 0 $newhead
6050 $top.tohead conf -state readonly
6051 grid x $top.tohead -sticky w
6052 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6053 grid $top.rev x -pady 10
6054 label $top.flab -text [mc "Output file:"]
6055 entry $top.fname -width 60
6056 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6058 grid $top.flab $top.fname -sticky w
6060 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6061 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6062 grid $top.buts.gen $top.buts.can
6063 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6064 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6065 grid $top.buts - -pady 10 -sticky ew
6069 proc mkpatchrev {} {
6072 set oldid [$patchtop.fromsha1 get]
6073 set oldhead [$patchtop.fromhead get]
6074 set newid [$patchtop.tosha1 get]
6075 set newhead [$patchtop.tohead get]
6076 foreach e [list fromsha1 fromhead tosha1 tohead] \
6077 v [list $newid $newhead $oldid $oldhead] {
6078 $patchtop.$e conf -state normal
6079 $patchtop.$e delete 0 end
6080 $patchtop.$e insert 0 $v
6081 $patchtop.$e conf -state readonly
6086 global patchtop nullid nullid2
6088 set oldid [$patchtop.fromsha1 get]
6089 set newid [$patchtop.tosha1 get]
6090 set fname [$patchtop.fname get]
6091 set cmd [diffcmd [list $oldid $newid] -p]
6092 # trim off the initial "|"
6093 set cmd [lrange $cmd 1 end]
6094 lappend cmd >$fname &
6095 if {[catch {eval exec $cmd} err]} {
6096 error_popup "[mc "Error creating patch:"] $err"
6098 catch {destroy $patchtop}
6102 proc mkpatchcan {} {
6105 catch {destroy $patchtop}
6110 global rowmenuid mktagtop commitinfo
6114 catch {destroy $top}
6116 label $top.title -text [mc "Create tag"]
6117 grid $top.title - -pady 10
6118 label $top.id -text [mc "ID:"]
6119 entry $top.sha1 -width 40 -relief flat
6120 $top.sha1 insert 0 $rowmenuid
6121 $top.sha1 conf -state readonly
6122 grid $top.id $top.sha1 -sticky w
6123 entry $top.head -width 60 -relief flat
6124 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6125 $top.head conf -state readonly
6126 grid x $top.head -sticky w
6127 label $top.tlab -text [mc "Tag name:"]
6128 entry $top.tag -width 60
6129 grid $top.tlab $top.tag -sticky w
6131 button $top.buts.gen -text [mc "Create"] -command mktaggo
6132 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6133 grid $top.buts.gen $top.buts.can
6134 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6135 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6136 grid $top.buts - -pady 10 -sticky ew
6141 global mktagtop env tagids idtags
6143 set id [$mktagtop.sha1 get]
6144 set tag [$mktagtop.tag get]
6146 error_popup [mc "No tag name specified"]
6149 if {[info exists tagids($tag)]} {
6150 error_popup [mc "Tag \"%s\" already exists" $tag]
6154 exec git tag $tag $id
6156 error_popup "[mc "Error creating tag:"] $err"
6160 set tagids($tag) $id
6161 lappend idtags($id) $tag
6168 proc redrawtags {id} {
6169 global canv linehtag commitrow idpos selectedline curview
6170 global canvxmax iddrawn
6172 if {![info exists commitrow($curview,$id)]} return
6173 if {![info exists iddrawn($id)]} return
6174 drawcommits $commitrow($curview,$id)
6175 $canv delete tag.$id
6176 set xt [eval drawtags $id $idpos($id)]
6177 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6178 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6179 set xr [expr {$xt + [font measure mainfont $text]}]
6180 if {$xr > $canvxmax} {
6184 if {[info exists selectedline]
6185 && $selectedline == $commitrow($curview,$id)} {
6186 selectline $selectedline 0
6193 catch {destroy $mktagtop}
6202 proc writecommit {} {
6203 global rowmenuid wrcomtop commitinfo wrcomcmd
6205 set top .writecommit
6207 catch {destroy $top}
6209 label $top.title -text [mc "Write commit to file"]
6210 grid $top.title - -pady 10
6211 label $top.id -text [mc "ID:"]
6212 entry $top.sha1 -width 40 -relief flat
6213 $top.sha1 insert 0 $rowmenuid
6214 $top.sha1 conf -state readonly
6215 grid $top.id $top.sha1 -sticky w
6216 entry $top.head -width 60 -relief flat
6217 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6218 $top.head conf -state readonly
6219 grid x $top.head -sticky w
6220 label $top.clab -text [mc "Command:"]
6221 entry $top.cmd -width 60 -textvariable wrcomcmd
6222 grid $top.clab $top.cmd -sticky w -pady 10
6223 label $top.flab -text [mc "Output file:"]
6224 entry $top.fname -width 60
6225 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6226 grid $top.flab $top.fname -sticky w
6228 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6229 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6230 grid $top.buts.gen $top.buts.can
6231 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6232 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6233 grid $top.buts - -pady 10 -sticky ew
6240 set id [$wrcomtop.sha1 get]
6241 set cmd "echo $id | [$wrcomtop.cmd get]"
6242 set fname [$wrcomtop.fname get]
6243 if {[catch {exec sh -c $cmd >$fname &} err]} {
6244 error_popup "[mc "Error writing commit:"] $err"
6246 catch {destroy $wrcomtop}
6253 catch {destroy $wrcomtop}
6258 global rowmenuid mkbrtop
6261 catch {destroy $top}
6263 label $top.title -text [mc "Create new branch"]
6264 grid $top.title - -pady 10
6265 label $top.id -text [mc "ID:"]
6266 entry $top.sha1 -width 40 -relief flat
6267 $top.sha1 insert 0 $rowmenuid
6268 $top.sha1 conf -state readonly
6269 grid $top.id $top.sha1 -sticky w
6270 label $top.nlab -text [mc "Name:"]
6271 entry $top.name -width 40
6272 grid $top.nlab $top.name -sticky w
6274 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6275 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6276 grid $top.buts.go $top.buts.can
6277 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6278 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6279 grid $top.buts - -pady 10 -sticky ew
6284 global headids idheads
6286 set name [$top.name get]
6287 set id [$top.sha1 get]
6289 error_popup [mc "Please specify a name for the new branch"]
6292 catch {destroy $top}
6296 exec git branch $name $id
6301 set headids($name) $id
6302 lappend idheads($id) $name
6311 proc cherrypick {} {
6312 global rowmenuid curview commitrow
6315 set oldhead [exec git rev-parse HEAD]
6316 set dheads [descheads $rowmenuid]
6317 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6318 set ok [confirm_popup [mc "Commit %s is already\
6319 included in branch %s -- really re-apply it?" \
6320 [string range $rowmenuid 0 7] $mainhead]]
6323 nowbusy cherrypick [mc "Cherry-picking"]
6325 # Unfortunately git-cherry-pick writes stuff to stderr even when
6326 # no error occurs, and exec takes that as an indication of error...
6327 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6332 set newhead [exec git rev-parse HEAD]
6333 if {$newhead eq $oldhead} {
6335 error_popup [mc "No changes committed"]
6338 addnewchild $newhead $oldhead
6339 if {[info exists commitrow($curview,$oldhead)]} {
6340 insertrow $commitrow($curview,$oldhead) $newhead
6341 if {$mainhead ne {}} {
6342 movehead $newhead $mainhead
6343 movedhead $newhead $mainhead
6352 global mainheadid mainhead rowmenuid confirm_ok resettype
6355 set w ".confirmreset"
6358 wm title $w [mc "Confirm reset"]
6359 message $w.m -text \
6360 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6361 -justify center -aspect 1000
6362 pack $w.m -side top -fill x -padx 20 -pady 20
6363 frame $w.f -relief sunken -border 2
6364 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6365 grid $w.f.rt -sticky w
6367 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6368 -text [mc "Soft: Leave working tree and index untouched"]
6369 grid $w.f.soft -sticky w
6370 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6371 -text [mc "Mixed: Leave working tree untouched, reset index"]
6372 grid $w.f.mixed -sticky w
6373 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6374 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6375 grid $w.f.hard -sticky w
6376 pack $w.f -side top -fill x
6377 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6378 pack $w.ok -side left -fill x -padx 20 -pady 20
6379 button $w.cancel -text [mc Cancel] -command "destroy $w"
6380 pack $w.cancel -side right -fill x -padx 20 -pady 20
6381 bind $w <Visibility> "grab $w; focus $w"
6383 if {!$confirm_ok} return
6384 if {[catch {set fd [open \
6385 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6389 filerun $fd [list readresetstat $fd]
6390 nowbusy reset [mc "Resetting"]
6394 proc readresetstat {fd} {
6395 global mainhead mainheadid showlocalchanges rprogcoord
6397 if {[gets $fd line] >= 0} {
6398 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6399 set rprogcoord [expr {1.0 * $m / $n}]
6407 if {[catch {close $fd} err]} {
6410 set oldhead $mainheadid
6411 set newhead [exec git rev-parse HEAD]
6412 if {$newhead ne $oldhead} {
6413 movehead $newhead $mainhead
6414 movedhead $newhead $mainhead
6415 set mainheadid $newhead
6419 if {$showlocalchanges} {
6425 # context menu for a head
6426 proc headmenu {x y id head} {
6427 global headmenuid headmenuhead headctxmenu mainhead
6431 set headmenuhead $head
6433 if {$head eq $mainhead} {
6436 $headctxmenu entryconfigure 0 -state $state
6437 $headctxmenu entryconfigure 1 -state $state
6438 tk_popup $headctxmenu $x $y
6442 global headmenuid headmenuhead mainhead headids
6443 global showlocalchanges mainheadid
6445 # check the tree is clean first??
6446 set oldmainhead $mainhead
6447 nowbusy checkout [mc "Checking out"]
6451 exec git checkout -q $headmenuhead
6457 set mainhead $headmenuhead
6458 set mainheadid $headmenuid
6459 if {[info exists headids($oldmainhead)]} {
6460 redrawtags $headids($oldmainhead)
6462 redrawtags $headmenuid
6464 if {$showlocalchanges} {
6470 global headmenuid headmenuhead mainhead
6473 set head $headmenuhead
6475 # this check shouldn't be needed any more...
6476 if {$head eq $mainhead} {
6477 error_popup [mc "Cannot delete the currently checked-out branch"]
6480 set dheads [descheads $id]
6481 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6482 # the stuff on this branch isn't on any other branch
6483 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6484 branch.\nReally delete branch %s?" $head $head]]} return
6488 if {[catch {exec git branch -D $head} err]} {
6493 removehead $id $head
6494 removedhead $id $head
6501 # Display a list of tags and heads
6503 global showrefstop bgcolor fgcolor selectbgcolor
6504 global bglist fglist reflistfilter reflist maincursor
6507 set showrefstop $top
6508 if {[winfo exists $top]} {
6514 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6515 text $top.list -background $bgcolor -foreground $fgcolor \
6516 -selectbackground $selectbgcolor -font mainfont \
6517 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6518 -width 30 -height 20 -cursor $maincursor \
6519 -spacing1 1 -spacing3 1 -state disabled
6520 $top.list tag configure highlight -background $selectbgcolor
6521 lappend bglist $top.list
6522 lappend fglist $top.list
6523 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6524 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6525 grid $top.list $top.ysb -sticky nsew
6526 grid $top.xsb x -sticky ew
6528 label $top.f.l -text "[mc "Filter"]: "
6529 entry $top.f.e -width 20 -textvariable reflistfilter
6530 set reflistfilter "*"
6531 trace add variable reflistfilter write reflistfilter_change
6532 pack $top.f.e -side right -fill x -expand 1
6533 pack $top.f.l -side left
6534 grid $top.f - -sticky ew -pady 2
6535 button $top.close -command [list destroy $top] -text [mc "Close"]
6537 grid columnconfigure $top 0 -weight 1
6538 grid rowconfigure $top 0 -weight 1
6539 bind $top.list <1> {break}
6540 bind $top.list <B1-Motion> {break}
6541 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6546 proc sel_reflist {w x y} {
6547 global showrefstop reflist headids tagids otherrefids
6549 if {![winfo exists $showrefstop]} return
6550 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6551 set ref [lindex $reflist [expr {$l-1}]]
6552 set n [lindex $ref 0]
6553 switch -- [lindex $ref 1] {
6554 "H" {selbyid $headids($n)}
6555 "T" {selbyid $tagids($n)}
6556 "o" {selbyid $otherrefids($n)}
6558 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6561 proc unsel_reflist {} {
6564 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6565 $showrefstop.list tag remove highlight 0.0 end
6568 proc reflistfilter_change {n1 n2 op} {
6569 global reflistfilter
6571 after cancel refill_reflist
6572 after 200 refill_reflist
6575 proc refill_reflist {} {
6576 global reflist reflistfilter showrefstop headids tagids otherrefids
6577 global commitrow curview commitinterest
6579 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6581 foreach n [array names headids] {
6582 if {[string match $reflistfilter $n]} {
6583 if {[info exists commitrow($curview,$headids($n))]} {
6584 lappend refs [list $n H]
6586 set commitinterest($headids($n)) {run refill_reflist}
6590 foreach n [array names tagids] {
6591 if {[string match $reflistfilter $n]} {
6592 if {[info exists commitrow($curview,$tagids($n))]} {
6593 lappend refs [list $n T]
6595 set commitinterest($tagids($n)) {run refill_reflist}
6599 foreach n [array names otherrefids] {
6600 if {[string match $reflistfilter $n]} {
6601 if {[info exists commitrow($curview,$otherrefids($n))]} {
6602 lappend refs [list $n o]
6604 set commitinterest($otherrefids($n)) {run refill_reflist}
6608 set refs [lsort -index 0 $refs]
6609 if {$refs eq $reflist} return
6611 # Update the contents of $showrefstop.list according to the
6612 # differences between $reflist (old) and $refs (new)
6613 $showrefstop.list conf -state normal
6614 $showrefstop.list insert end "\n"
6617 while {$i < [llength $reflist] || $j < [llength $refs]} {
6618 if {$i < [llength $reflist]} {
6619 if {$j < [llength $refs]} {
6620 set cmp [string compare [lindex $reflist $i 0] \
6621 [lindex $refs $j 0]]
6623 set cmp [string compare [lindex $reflist $i 1] \
6624 [lindex $refs $j 1]]
6634 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6642 set l [expr {$j + 1}]
6643 $showrefstop.list image create $l.0 -align baseline \
6644 -image reficon-[lindex $refs $j 1] -padx 2
6645 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6651 # delete last newline
6652 $showrefstop.list delete end-2c end-1c
6653 $showrefstop.list conf -state disabled
6656 # Stuff for finding nearby tags
6657 proc getallcommits {} {
6658 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6659 global idheads idtags idotherrefs allparents tagobjid
6661 if {![info exists allcommits]} {
6667 set allccache [file join [gitdir] "gitk.cache"]
6669 set f [open $allccache r]
6678 set cmd [list | git rev-list --parents]
6679 set allcupdate [expr {$seeds ne {}}]
6683 set refs [concat [array names idheads] [array names idtags] \
6684 [array names idotherrefs]]
6687 foreach name [array names tagobjid] {
6688 lappend tagobjs $tagobjid($name)
6690 foreach id [lsort -unique $refs] {
6691 if {![info exists allparents($id)] &&
6692 [lsearch -exact $tagobjs $id] < 0} {
6703 set fd [open [concat $cmd $ids] r]
6704 fconfigure $fd -blocking 0
6707 filerun $fd [list getallclines $fd]
6713 # Since most commits have 1 parent and 1 child, we group strings of
6714 # such commits into "arcs" joining branch/merge points (BMPs), which
6715 # are commits that either don't have 1 parent or don't have 1 child.
6717 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6718 # arcout(id) - outgoing arcs for BMP
6719 # arcids(a) - list of IDs on arc including end but not start
6720 # arcstart(a) - BMP ID at start of arc
6721 # arcend(a) - BMP ID at end of arc
6722 # growing(a) - arc a is still growing
6723 # arctags(a) - IDs out of arcids (excluding end) that have tags
6724 # archeads(a) - IDs out of arcids (excluding end) that have heads
6725 # The start of an arc is at the descendent end, so "incoming" means
6726 # coming from descendents, and "outgoing" means going towards ancestors.
6728 proc getallclines {fd} {
6729 global allparents allchildren idtags idheads nextarc
6730 global arcnos arcids arctags arcout arcend arcstart archeads growing
6731 global seeds allcommits cachedarcs allcupdate
6734 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6735 set id [lindex $line 0]
6736 if {[info exists allparents($id)]} {
6741 set olds [lrange $line 1 end]
6742 set allparents($id) $olds
6743 if {![info exists allchildren($id)]} {
6744 set allchildren($id) {}
6749 if {[llength $olds] == 1 && [llength $a] == 1} {
6750 lappend arcids($a) $id
6751 if {[info exists idtags($id)]} {
6752 lappend arctags($a) $id
6754 if {[info exists idheads($id)]} {
6755 lappend archeads($a) $id
6757 if {[info exists allparents($olds)]} {
6758 # seen parent already
6759 if {![info exists arcout($olds)]} {
6762 lappend arcids($a) $olds
6763 set arcend($a) $olds
6766 lappend allchildren($olds) $id
6767 lappend arcnos($olds) $a
6771 foreach a $arcnos($id) {
6772 lappend arcids($a) $id
6779 lappend allchildren($p) $id
6780 set a [incr nextarc]
6781 set arcstart($a) $id
6788 if {[info exists allparents($p)]} {
6789 # seen it already, may need to make a new branch
6790 if {![info exists arcout($p)]} {
6793 lappend arcids($a) $p
6797 lappend arcnos($p) $a
6802 global cached_dheads cached_dtags cached_atags
6803 catch {unset cached_dheads}
6804 catch {unset cached_dtags}
6805 catch {unset cached_atags}
6808 return [expr {$nid >= 1000? 2: 1}]
6812 fconfigure $fd -blocking 1
6815 # got an error reading the list of commits
6816 # if we were updating, try rereading the whole thing again
6822 error_popup "[mc "Error reading commit topology information;\
6823 branch and preceding/following tag information\
6824 will be incomplete."]\n($err)"
6827 if {[incr allcommits -1] == 0} {
6837 proc recalcarc {a} {
6838 global arctags archeads arcids idtags idheads
6842 foreach id [lrange $arcids($a) 0 end-1] {
6843 if {[info exists idtags($id)]} {
6846 if {[info exists idheads($id)]} {
6851 set archeads($a) $ah
6855 global arcnos arcids nextarc arctags archeads idtags idheads
6856 global arcstart arcend arcout allparents growing
6859 if {[llength $a] != 1} {
6860 puts "oops splitarc called but [llength $a] arcs already"
6864 set i [lsearch -exact $arcids($a) $p]
6866 puts "oops splitarc $p not in arc $a"
6869 set na [incr nextarc]
6870 if {[info exists arcend($a)]} {
6871 set arcend($na) $arcend($a)
6873 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6874 set j [lsearch -exact $arcnos($l) $a]
6875 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6877 set tail [lrange $arcids($a) [expr {$i+1}] end]
6878 set arcids($a) [lrange $arcids($a) 0 $i]
6880 set arcstart($na) $p
6882 set arcids($na) $tail
6883 if {[info exists growing($a)]} {
6889 if {[llength $arcnos($id)] == 1} {
6892 set j [lsearch -exact $arcnos($id) $a]
6893 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6897 # reconstruct tags and heads lists
6898 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6903 set archeads($na) {}
6907 # Update things for a new commit added that is a child of one
6908 # existing commit. Used when cherry-picking.
6909 proc addnewchild {id p} {
6910 global allparents allchildren idtags nextarc
6911 global arcnos arcids arctags arcout arcend arcstart archeads growing
6912 global seeds allcommits
6914 if {![info exists allcommits] || ![info exists arcnos($p)]} return
6915 set allparents($id) [list $p]
6916 set allchildren($id) {}
6919 lappend allchildren($p) $id
6920 set a [incr nextarc]
6921 set arcstart($a) $id
6924 set arcids($a) [list $p]
6926 if {![info exists arcout($p)]} {
6929 lappend arcnos($p) $a
6930 set arcout($id) [list $a]
6933 # This implements a cache for the topology information.
6934 # The cache saves, for each arc, the start and end of the arc,
6935 # the ids on the arc, and the outgoing arcs from the end.
6936 proc readcache {f} {
6937 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6938 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6943 if {$lim - $a > 500} {
6944 set lim [expr {$a + 500}]
6948 # finish reading the cache and setting up arctags, etc.
6950 if {$line ne "1"} {error "bad final version"}
6952 foreach id [array names idtags] {
6953 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6954 [llength $allparents($id)] == 1} {
6955 set a [lindex $arcnos($id) 0]
6956 if {$arctags($a) eq {}} {
6961 foreach id [array names idheads] {
6962 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6963 [llength $allparents($id)] == 1} {
6964 set a [lindex $arcnos($id) 0]
6965 if {$archeads($a) eq {}} {
6970 foreach id [lsort -unique $possible_seeds] {
6971 if {$arcnos($id) eq {}} {
6977 while {[incr a] <= $lim} {
6979 if {[llength $line] != 3} {error "bad line"}
6980 set s [lindex $line 0]
6982 lappend arcout($s) $a
6983 if {![info exists arcnos($s)]} {
6984 lappend possible_seeds $s
6987 set e [lindex $line 1]
6992 if {![info exists arcout($e)]} {
6996 set arcids($a) [lindex $line 2]
6997 foreach id $arcids($a) {
6998 lappend allparents($s) $id
7000 lappend arcnos($id) $a
7002 if {![info exists allparents($s)]} {
7003 set allparents($s) {}
7008 set nextarc [expr {$a - 1}]
7021 global nextarc cachedarcs possible_seeds
7025 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7026 # make sure it's an integer
7027 set cachedarcs [expr {int([lindex $line 1])}]
7028 if {$cachedarcs < 0} {error "bad number of arcs"}
7030 set possible_seeds {}
7038 proc dropcache {err} {
7039 global allcwait nextarc cachedarcs seeds
7041 #puts "dropping cache ($err)"
7042 foreach v {arcnos arcout arcids arcstart arcend growing \
7043 arctags archeads allparents allchildren} {
7054 proc writecache {f} {
7055 global cachearc cachedarcs allccache
7056 global arcstart arcend arcnos arcids arcout
7060 if {$lim - $a > 1000} {
7061 set lim [expr {$a + 1000}]
7064 while {[incr a] <= $lim} {
7065 if {[info exists arcend($a)]} {
7066 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7068 puts $f [list $arcstart($a) {} $arcids($a)]
7073 catch {file delete $allccache}
7074 #puts "writing cache failed ($err)"
7077 set cachearc [expr {$a - 1}]
7078 if {$a > $cachedarcs} {
7087 global nextarc cachedarcs cachearc allccache
7089 if {$nextarc == $cachedarcs} return
7091 set cachedarcs $nextarc
7093 set f [open $allccache w]
7094 puts $f [list 1 $cachedarcs]
7099 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7100 # or 0 if neither is true.
7101 proc anc_or_desc {a b} {
7102 global arcout arcstart arcend arcnos cached_isanc
7104 if {$arcnos($a) eq $arcnos($b)} {
7105 # Both are on the same arc(s); either both are the same BMP,
7106 # or if one is not a BMP, the other is also not a BMP or is
7107 # the BMP at end of the arc (and it only has 1 incoming arc).
7108 # Or both can be BMPs with no incoming arcs.
7109 if {$a eq $b || $arcnos($a) eq {}} {
7112 # assert {[llength $arcnos($a)] == 1}
7113 set arc [lindex $arcnos($a) 0]
7114 set i [lsearch -exact $arcids($arc) $a]
7115 set j [lsearch -exact $arcids($arc) $b]
7116 if {$i < 0 || $i > $j} {
7123 if {![info exists arcout($a)]} {
7124 set arc [lindex $arcnos($a) 0]
7125 if {[info exists arcend($arc)]} {
7126 set aend $arcend($arc)
7130 set a $arcstart($arc)
7134 if {![info exists arcout($b)]} {
7135 set arc [lindex $arcnos($b) 0]
7136 if {[info exists arcend($arc)]} {
7137 set bend $arcend($arc)
7141 set b $arcstart($arc)
7151 if {[info exists cached_isanc($a,$bend)]} {
7152 if {$cached_isanc($a,$bend)} {
7156 if {[info exists cached_isanc($b,$aend)]} {
7157 if {$cached_isanc($b,$aend)} {
7160 if {[info exists cached_isanc($a,$bend)]} {
7165 set todo [list $a $b]
7168 for {set i 0} {$i < [llength $todo]} {incr i} {
7169 set x [lindex $todo $i]
7170 if {$anc($x) eq {}} {
7173 foreach arc $arcnos($x) {
7174 set xd $arcstart($arc)
7176 set cached_isanc($a,$bend) 1
7177 set cached_isanc($b,$aend) 0
7179 } elseif {$xd eq $aend} {
7180 set cached_isanc($b,$aend) 1
7181 set cached_isanc($a,$bend) 0
7184 if {![info exists anc($xd)]} {
7185 set anc($xd) $anc($x)
7187 } elseif {$anc($xd) ne $anc($x)} {
7192 set cached_isanc($a,$bend) 0
7193 set cached_isanc($b,$aend) 0
7197 # This identifies whether $desc has an ancestor that is
7198 # a growing tip of the graph and which is not an ancestor of $anc
7199 # and returns 0 if so and 1 if not.
7200 # If we subsequently discover a tag on such a growing tip, and that
7201 # turns out to be a descendent of $anc (which it could, since we
7202 # don't necessarily see children before parents), then $desc
7203 # isn't a good choice to display as a descendent tag of
7204 # $anc (since it is the descendent of another tag which is
7205 # a descendent of $anc). Similarly, $anc isn't a good choice to
7206 # display as a ancestor tag of $desc.
7208 proc is_certain {desc anc} {
7209 global arcnos arcout arcstart arcend growing problems
7212 if {[llength $arcnos($anc)] == 1} {
7213 # tags on the same arc are certain
7214 if {$arcnos($desc) eq $arcnos($anc)} {
7217 if {![info exists arcout($anc)]} {
7218 # if $anc is partway along an arc, use the start of the arc instead
7219 set a [lindex $arcnos($anc) 0]
7220 set anc $arcstart($a)
7223 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7226 set a [lindex $arcnos($desc) 0]
7232 set anclist [list $x]
7236 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7237 set x [lindex $anclist $i]
7242 foreach a $arcout($x) {
7243 if {[info exists growing($a)]} {
7244 if {![info exists growanc($x)] && $dl($x)} {
7250 if {[info exists dl($y)]} {
7254 if {![info exists done($y)]} {
7257 if {[info exists growanc($x)]} {
7261 for {set k 0} {$k < [llength $xl]} {incr k} {
7262 set z [lindex $xl $k]
7263 foreach c $arcout($z) {
7264 if {[info exists arcend($c)]} {
7266 if {[info exists dl($v)] && $dl($v)} {
7268 if {![info exists done($v)]} {
7271 if {[info exists growanc($v)]} {
7281 } elseif {$y eq $anc || !$dl($x)} {
7292 foreach x [array names growanc] {
7301 proc validate_arctags {a} {
7302 global arctags idtags
7306 foreach id $arctags($a) {
7308 if {![info exists idtags($id)]} {
7309 set na [lreplace $na $i $i]
7316 proc validate_archeads {a} {
7317 global archeads idheads
7320 set na $archeads($a)
7321 foreach id $archeads($a) {
7323 if {![info exists idheads($id)]} {
7324 set na [lreplace $na $i $i]
7328 set archeads($a) $na
7331 # Return the list of IDs that have tags that are descendents of id,
7332 # ignoring IDs that are descendents of IDs already reported.
7333 proc desctags {id} {
7334 global arcnos arcstart arcids arctags idtags allparents
7335 global growing cached_dtags
7337 if {![info exists allparents($id)]} {
7340 set t1 [clock clicks -milliseconds]
7342 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7343 # part-way along an arc; check that arc first
7344 set a [lindex $arcnos($id) 0]
7345 if {$arctags($a) ne {}} {
7347 set i [lsearch -exact $arcids($a) $id]
7349 foreach t $arctags($a) {
7350 set j [lsearch -exact $arcids($a) $t]
7358 set id $arcstart($a)
7359 if {[info exists idtags($id)]} {
7363 if {[info exists cached_dtags($id)]} {
7364 return $cached_dtags($id)
7371 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7372 set id [lindex $todo $i]
7374 set ta [info exists hastaggedancestor($id)]
7378 # ignore tags on starting node
7379 if {!$ta && $i > 0} {
7380 if {[info exists idtags($id)]} {
7383 } elseif {[info exists cached_dtags($id)]} {
7384 set tagloc($id) $cached_dtags($id)
7388 foreach a $arcnos($id) {
7390 if {!$ta && $arctags($a) ne {}} {
7392 if {$arctags($a) ne {}} {
7393 lappend tagloc($id) [lindex $arctags($a) end]
7396 if {$ta || $arctags($a) ne {}} {
7397 set tomark [list $d]
7398 for {set j 0} {$j < [llength $tomark]} {incr j} {
7399 set dd [lindex $tomark $j]
7400 if {![info exists hastaggedancestor($dd)]} {
7401 if {[info exists done($dd)]} {
7402 foreach b $arcnos($dd) {
7403 lappend tomark $arcstart($b)
7405 if {[info exists tagloc($dd)]} {
7408 } elseif {[info exists queued($dd)]} {
7411 set hastaggedancestor($dd) 1
7415 if {![info exists queued($d)]} {
7418 if {![info exists hastaggedancestor($d)]} {
7425 foreach id [array names tagloc] {
7426 if {![info exists hastaggedancestor($id)]} {
7427 foreach t $tagloc($id) {
7428 if {[lsearch -exact $tags $t] < 0} {
7434 set t2 [clock clicks -milliseconds]
7437 # remove tags that are descendents of other tags
7438 for {set i 0} {$i < [llength $tags]} {incr i} {
7439 set a [lindex $tags $i]
7440 for {set j 0} {$j < $i} {incr j} {
7441 set b [lindex $tags $j]
7442 set r [anc_or_desc $a $b]
7444 set tags [lreplace $tags $j $j]
7447 } elseif {$r == -1} {
7448 set tags [lreplace $tags $i $i]
7455 if {[array names growing] ne {}} {
7456 # graph isn't finished, need to check if any tag could get
7457 # eclipsed by another tag coming later. Simply ignore any
7458 # tags that could later get eclipsed.
7461 if {[is_certain $t $origid]} {
7465 if {$tags eq $ctags} {
7466 set cached_dtags($origid) $tags
7471 set cached_dtags($origid) $tags
7473 set t3 [clock clicks -milliseconds]
7474 if {0 && $t3 - $t1 >= 100} {
7475 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7476 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7482 global arcnos arcids arcout arcend arctags idtags allparents
7483 global growing cached_atags
7485 if {![info exists allparents($id)]} {
7488 set t1 [clock clicks -milliseconds]
7490 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7491 # part-way along an arc; check that arc first
7492 set a [lindex $arcnos($id) 0]
7493 if {$arctags($a) ne {}} {
7495 set i [lsearch -exact $arcids($a) $id]
7496 foreach t $arctags($a) {
7497 set j [lsearch -exact $arcids($a) $t]
7503 if {![info exists arcend($a)]} {
7507 if {[info exists idtags($id)]} {
7511 if {[info exists cached_atags($id)]} {
7512 return $cached_atags($id)
7520 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7521 set id [lindex $todo $i]
7523 set td [info exists hastaggeddescendent($id)]
7527 # ignore tags on starting node
7528 if {!$td && $i > 0} {
7529 if {[info exists idtags($id)]} {
7532 } elseif {[info exists cached_atags($id)]} {
7533 set tagloc($id) $cached_atags($id)
7537 foreach a $arcout($id) {
7538 if {!$td && $arctags($a) ne {}} {
7540 if {$arctags($a) ne {}} {
7541 lappend tagloc($id) [lindex $arctags($a) 0]
7544 if {![info exists arcend($a)]} continue
7546 if {$td || $arctags($a) ne {}} {
7547 set tomark [list $d]
7548 for {set j 0} {$j < [llength $tomark]} {incr j} {
7549 set dd [lindex $tomark $j]
7550 if {![info exists hastaggeddescendent($dd)]} {
7551 if {[info exists done($dd)]} {
7552 foreach b $arcout($dd) {
7553 if {[info exists arcend($b)]} {
7554 lappend tomark $arcend($b)
7557 if {[info exists tagloc($dd)]} {
7560 } elseif {[info exists queued($dd)]} {
7563 set hastaggeddescendent($dd) 1
7567 if {![info exists queued($d)]} {
7570 if {![info exists hastaggeddescendent($d)]} {
7576 set t2 [clock clicks -milliseconds]
7579 foreach id [array names tagloc] {
7580 if {![info exists hastaggeddescendent($id)]} {
7581 foreach t $tagloc($id) {
7582 if {[lsearch -exact $tags $t] < 0} {
7589 # remove tags that are ancestors of other tags
7590 for {set i 0} {$i < [llength $tags]} {incr i} {
7591 set a [lindex $tags $i]
7592 for {set j 0} {$j < $i} {incr j} {
7593 set b [lindex $tags $j]
7594 set r [anc_or_desc $a $b]
7596 set tags [lreplace $tags $j $j]
7599 } elseif {$r == 1} {
7600 set tags [lreplace $tags $i $i]
7607 if {[array names growing] ne {}} {
7608 # graph isn't finished, need to check if any tag could get
7609 # eclipsed by another tag coming later. Simply ignore any
7610 # tags that could later get eclipsed.
7613 if {[is_certain $origid $t]} {
7617 if {$tags eq $ctags} {
7618 set cached_atags($origid) $tags
7623 set cached_atags($origid) $tags
7625 set t3 [clock clicks -milliseconds]
7626 if {0 && $t3 - $t1 >= 100} {
7627 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7628 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7633 # Return the list of IDs that have heads that are descendents of id,
7634 # including id itself if it has a head.
7635 proc descheads {id} {
7636 global arcnos arcstart arcids archeads idheads cached_dheads
7639 if {![info exists allparents($id)]} {
7643 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7644 # part-way along an arc; check it first
7645 set a [lindex $arcnos($id) 0]
7646 if {$archeads($a) ne {}} {
7647 validate_archeads $a
7648 set i [lsearch -exact $arcids($a) $id]
7649 foreach t $archeads($a) {
7650 set j [lsearch -exact $arcids($a) $t]
7655 set id $arcstart($a)
7661 for {set i 0} {$i < [llength $todo]} {incr i} {
7662 set id [lindex $todo $i]
7663 if {[info exists cached_dheads($id)]} {
7664 set ret [concat $ret $cached_dheads($id)]
7666 if {[info exists idheads($id)]} {
7669 foreach a $arcnos($id) {
7670 if {$archeads($a) ne {}} {
7671 validate_archeads $a
7672 if {$archeads($a) ne {}} {
7673 set ret [concat $ret $archeads($a)]
7677 if {![info exists seen($d)]} {
7684 set ret [lsort -unique $ret]
7685 set cached_dheads($origid) $ret
7686 return [concat $ret $aret]
7689 proc addedtag {id} {
7690 global arcnos arcout cached_dtags cached_atags
7692 if {![info exists arcnos($id)]} return
7693 if {![info exists arcout($id)]} {
7694 recalcarc [lindex $arcnos($id) 0]
7696 catch {unset cached_dtags}
7697 catch {unset cached_atags}
7700 proc addedhead {hid head} {
7701 global arcnos arcout cached_dheads
7703 if {![info exists arcnos($hid)]} return
7704 if {![info exists arcout($hid)]} {
7705 recalcarc [lindex $arcnos($hid) 0]
7707 catch {unset cached_dheads}
7710 proc removedhead {hid head} {
7711 global cached_dheads
7713 catch {unset cached_dheads}
7716 proc movedhead {hid head} {
7717 global arcnos arcout cached_dheads
7719 if {![info exists arcnos($hid)]} return
7720 if {![info exists arcout($hid)]} {
7721 recalcarc [lindex $arcnos($hid) 0]
7723 catch {unset cached_dheads}
7726 proc changedrefs {} {
7727 global cached_dheads cached_dtags cached_atags
7728 global arctags archeads arcnos arcout idheads idtags
7730 foreach id [concat [array names idheads] [array names idtags]] {
7731 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7732 set a [lindex $arcnos($id) 0]
7733 if {![info exists donearc($a)]} {
7739 catch {unset cached_dtags}
7740 catch {unset cached_atags}
7741 catch {unset cached_dheads}
7744 proc rereadrefs {} {
7745 global idtags idheads idotherrefs mainhead
7747 set refids [concat [array names idtags] \
7748 [array names idheads] [array names idotherrefs]]
7749 foreach id $refids {
7750 if {![info exists ref($id)]} {
7751 set ref($id) [listrefs $id]
7754 set oldmainhead $mainhead
7757 set refids [lsort -unique [concat $refids [array names idtags] \
7758 [array names idheads] [array names idotherrefs]]]
7759 foreach id $refids {
7760 set v [listrefs $id]
7761 if {![info exists ref($id)] || $ref($id) != $v ||
7762 ($id eq $oldmainhead && $id ne $mainhead) ||
7763 ($id eq $mainhead && $id ne $oldmainhead)} {
7770 proc listrefs {id} {
7771 global idtags idheads idotherrefs
7774 if {[info exists idtags($id)]} {
7778 if {[info exists idheads($id)]} {
7782 if {[info exists idotherrefs($id)]} {
7783 set z $idotherrefs($id)
7785 return [list $x $y $z]
7788 proc showtag {tag isnew} {
7789 global ctext tagcontents tagids linknum tagobjid
7792 addtohistory [list showtag $tag 0]
7794 $ctext conf -state normal
7798 if {![info exists tagcontents($tag)]} {
7800 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7803 if {[info exists tagcontents($tag)]} {
7804 set text $tagcontents($tag)
7806 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
7808 appendwithlinks $text {}
7809 $ctext conf -state disabled
7820 proc mkfontdisp {font top which} {
7821 global fontattr fontpref $font
7823 set fontpref($font) [set $font]
7824 button $top.${font}but -text $which -font optionfont \
7825 -command [list choosefont $font $which]
7826 label $top.$font -relief flat -font $font \
7827 -text $fontattr($font,family) -justify left
7828 grid x $top.${font}but $top.$font -sticky w
7831 proc choosefont {font which} {
7832 global fontparam fontlist fonttop fontattr
7834 set fontparam(which) $which
7835 set fontparam(font) $font
7836 set fontparam(family) [font actual $font -family]
7837 set fontparam(size) $fontattr($font,size)
7838 set fontparam(weight) $fontattr($font,weight)
7839 set fontparam(slant) $fontattr($font,slant)
7842 if {![winfo exists $top]} {
7844 eval font config sample [font actual $font]
7846 wm title $top [mc "Gitk font chooser"]
7847 label $top.l -textvariable fontparam(which)
7848 pack $top.l -side top
7849 set fontlist [lsort [font families]]
7851 listbox $top.f.fam -listvariable fontlist \
7852 -yscrollcommand [list $top.f.sb set]
7853 bind $top.f.fam <<ListboxSelect>> selfontfam
7854 scrollbar $top.f.sb -command [list $top.f.fam yview]
7855 pack $top.f.sb -side right -fill y
7856 pack $top.f.fam -side left -fill both -expand 1
7857 pack $top.f -side top -fill both -expand 1
7859 spinbox $top.g.size -from 4 -to 40 -width 4 \
7860 -textvariable fontparam(size) \
7861 -validatecommand {string is integer -strict %s}
7862 checkbutton $top.g.bold -padx 5 \
7863 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7864 -variable fontparam(weight) -onvalue bold -offvalue normal
7865 checkbutton $top.g.ital -padx 5 \
7866 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7867 -variable fontparam(slant) -onvalue italic -offvalue roman
7868 pack $top.g.size $top.g.bold $top.g.ital -side left
7869 pack $top.g -side top
7870 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7872 $top.c create text 100 25 -anchor center -text $which -font sample \
7873 -fill black -tags text
7874 bind $top.c <Configure> [list centertext $top.c]
7875 pack $top.c -side top -fill x
7877 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7878 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7879 grid $top.buts.ok $top.buts.can
7880 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7881 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7882 pack $top.buts -side bottom -fill x
7883 trace add variable fontparam write chg_fontparam
7886 $top.c itemconf text -text $which
7888 set i [lsearch -exact $fontlist $fontparam(family)]
7890 $top.f.fam selection set $i
7895 proc centertext {w} {
7896 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7900 global fontparam fontpref prefstop
7902 set f $fontparam(font)
7903 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7904 if {$fontparam(weight) eq "bold"} {
7905 lappend fontpref($f) "bold"
7907 if {$fontparam(slant) eq "italic"} {
7908 lappend fontpref($f) "italic"
7911 $w conf -text $fontparam(family) -font $fontpref($f)
7917 global fonttop fontparam
7919 if {[info exists fonttop]} {
7920 catch {destroy $fonttop}
7921 catch {font delete sample}
7927 proc selfontfam {} {
7928 global fonttop fontparam
7930 set i [$fonttop.f.fam curselection]
7932 set fontparam(family) [$fonttop.f.fam get $i]
7936 proc chg_fontparam {v sub op} {
7939 font config sample -$sub $fontparam($sub)
7943 global maxwidth maxgraphpct
7944 global oldprefs prefstop showneartags showlocalchanges
7945 global bgcolor fgcolor ctext diffcolors selectbgcolor
7946 global tabstop limitdiffs
7950 if {[winfo exists $top]} {
7954 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7955 limitdiffs tabstop} {
7956 set oldprefs($v) [set $v]
7959 wm title $top [mc "Gitk preferences"]
7960 label $top.ldisp -text [mc "Commit list display options"]
7961 grid $top.ldisp - -sticky w -pady 10
7962 label $top.spacer -text " "
7963 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7965 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7966 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7967 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7969 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7970 grid x $top.maxpctl $top.maxpct -sticky w
7971 frame $top.showlocal
7972 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7973 checkbutton $top.showlocal.b -variable showlocalchanges
7974 pack $top.showlocal.b $top.showlocal.l -side left
7975 grid x $top.showlocal -sticky w
7977 label $top.ddisp -text [mc "Diff display options"]
7978 grid $top.ddisp - -sticky w -pady 10
7979 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7980 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7981 grid x $top.tabstopl $top.tabstop -sticky w
7983 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7984 checkbutton $top.ntag.b -variable showneartags
7985 pack $top.ntag.b $top.ntag.l -side left
7986 grid x $top.ntag -sticky w
7988 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7989 checkbutton $top.ldiff.b -variable limitdiffs
7990 pack $top.ldiff.b $top.ldiff.l -side left
7991 grid x $top.ldiff -sticky w
7993 label $top.cdisp -text [mc "Colors: press to choose"]
7994 grid $top.cdisp - -sticky w -pady 10
7995 label $top.bg -padx 40 -relief sunk -background $bgcolor
7996 button $top.bgbut -text [mc "Background"] -font optionfont \
7997 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7998 grid x $top.bgbut $top.bg -sticky w
7999 label $top.fg -padx 40 -relief sunk -background $fgcolor
8000 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8001 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8002 grid x $top.fgbut $top.fg -sticky w
8003 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8004 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8005 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8006 [list $ctext tag conf d0 -foreground]]
8007 grid x $top.diffoldbut $top.diffold -sticky w
8008 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8009 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8010 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8011 [list $ctext tag conf d1 -foreground]]
8012 grid x $top.diffnewbut $top.diffnew -sticky w
8013 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8014 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8015 -command [list choosecolor diffcolors 2 $top.hunksep \
8016 "diff hunk header" \
8017 [list $ctext tag conf hunksep -foreground]]
8018 grid x $top.hunksepbut $top.hunksep -sticky w
8019 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8020 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8021 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8022 grid x $top.selbgbut $top.selbgsep -sticky w
8024 label $top.cfont -text [mc "Fonts: press to choose"]
8025 grid $top.cfont - -sticky w -pady 10
8026 mkfontdisp mainfont $top [mc "Main font"]
8027 mkfontdisp textfont $top [mc "Diff display font"]
8028 mkfontdisp uifont $top [mc "User interface font"]
8031 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8032 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8033 grid $top.buts.ok $top.buts.can
8034 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8035 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8036 grid $top.buts - - -pady 10 -sticky ew
8037 bind $top <Visibility> "focus $top.buts.ok"
8040 proc choosecolor {v vi w x cmd} {
8043 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8044 -title [mc "Gitk: choose color for %s" $x]]
8045 if {$c eq {}} return
8046 $w conf -background $c
8052 global bglist cflist
8054 $w configure -selectbackground $c
8056 $cflist tag configure highlight \
8057 -background [$cflist cget -selectbackground]
8058 allcanvs itemconf secsel -fill $c
8065 $w conf -background $c
8073 $w conf -foreground $c
8075 allcanvs itemconf text -fill $c
8076 $canv itemconf circle -outline $c
8080 global oldprefs prefstop
8082 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8083 limitdiffs tabstop} {
8085 set $v $oldprefs($v)
8087 catch {destroy $prefstop}
8093 global maxwidth maxgraphpct
8094 global oldprefs prefstop showneartags showlocalchanges
8095 global fontpref mainfont textfont uifont
8096 global limitdiffs treediffs
8098 catch {destroy $prefstop}
8102 if {$mainfont ne $fontpref(mainfont)} {
8103 set mainfont $fontpref(mainfont)
8104 parsefont mainfont $mainfont
8105 eval font configure mainfont [fontflags mainfont]
8106 eval font configure mainfontbold [fontflags mainfont 1]
8110 if {$textfont ne $fontpref(textfont)} {
8111 set textfont $fontpref(textfont)
8112 parsefont textfont $textfont
8113 eval font configure textfont [fontflags textfont]
8114 eval font configure textfontbold [fontflags textfont 1]
8116 if {$uifont ne $fontpref(uifont)} {
8117 set uifont $fontpref(uifont)
8118 parsefont uifont $uifont
8119 eval font configure uifont [fontflags uifont]
8122 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8123 if {$showlocalchanges} {
8129 if {$limitdiffs != $oldprefs(limitdiffs)} {
8130 # treediffs elements are limited by path
8131 catch {unset treediffs}
8133 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8134 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8136 } elseif {$showneartags != $oldprefs(showneartags) ||
8137 $limitdiffs != $oldprefs(limitdiffs)} {
8142 proc formatdate {d} {
8143 global datetimeformat
8145 set d [clock format $d -format $datetimeformat]
8150 # This list of encoding names and aliases is distilled from
8151 # http://www.iana.org/assignments/character-sets.
8152 # Not all of them are supported by Tcl.
8153 set encoding_aliases {
8154 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8155 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8156 { ISO-10646-UTF-1 csISO10646UTF1 }
8157 { ISO_646.basic:1983 ref csISO646basic1983 }
8158 { INVARIANT csINVARIANT }
8159 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8160 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8161 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8162 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8163 { NATS-DANO iso-ir-9-1 csNATSDANO }
8164 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8165 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8166 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8167 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8168 { ISO-2022-KR csISO2022KR }
8170 { ISO-2022-JP csISO2022JP }
8171 { ISO-2022-JP-2 csISO2022JP2 }
8172 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8174 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8175 { IT iso-ir-15 ISO646-IT csISO15Italian }
8176 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8177 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8178 { greek7-old iso-ir-18 csISO18Greek7Old }
8179 { latin-greek iso-ir-19 csISO19LatinGreek }
8180 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8181 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8182 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8183 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8184 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8185 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8186 { INIS iso-ir-49 csISO49INIS }
8187 { INIS-8 iso-ir-50 csISO50INIS8 }
8188 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8189 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8190 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8191 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8192 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8193 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8195 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8196 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8197 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8198 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8199 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8200 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8201 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8202 { greek7 iso-ir-88 csISO88Greek7 }
8203 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8204 { iso-ir-90 csISO90 }
8205 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8206 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8207 csISO92JISC62991984b }
8208 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8209 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8210 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8211 csISO95JIS62291984handadd }
8212 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8213 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8214 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8215 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8217 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8218 { T.61-7bit iso-ir-102 csISO102T617bit }
8219 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8220 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8221 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8222 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8223 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8224 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8225 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8226 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8227 arabic csISOLatinArabic }
8228 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8229 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8230 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8231 greek greek8 csISOLatinGreek }
8232 { T.101-G2 iso-ir-128 csISO128T101G2 }
8233 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8235 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8236 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8237 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8238 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8239 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8240 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8241 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8242 csISOLatinCyrillic }
8243 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8244 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8245 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8246 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8247 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8248 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8249 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8250 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8251 { ISO_10367-box iso-ir-155 csISO10367Box }
8252 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8253 { latin-lap lap iso-ir-158 csISO158Lap }
8254 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8255 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8258 { JIS_X0201 X0201 csHalfWidthKatakana }
8259 { KSC5636 ISO646-KR csKSC5636 }
8260 { ISO-10646-UCS-2 csUnicode }
8261 { ISO-10646-UCS-4 csUCS4 }
8262 { DEC-MCS dec csDECMCS }
8263 { hp-roman8 roman8 r8 csHPRoman8 }
8264 { macintosh mac csMacintosh }
8265 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8267 { IBM038 EBCDIC-INT cp038 csIBM038 }
8268 { IBM273 CP273 csIBM273 }
8269 { IBM274 EBCDIC-BE CP274 csIBM274 }
8270 { IBM275 EBCDIC-BR cp275 csIBM275 }
8271 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8272 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8273 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8274 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8275 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8276 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8277 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8278 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8279 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8280 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8281 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8282 { IBM437 cp437 437 csPC8CodePage437 }
8283 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8284 { IBM775 cp775 csPC775Baltic }
8285 { IBM850 cp850 850 csPC850Multilingual }
8286 { IBM851 cp851 851 csIBM851 }
8287 { IBM852 cp852 852 csPCp852 }
8288 { IBM855 cp855 855 csIBM855 }
8289 { IBM857 cp857 857 csIBM857 }
8290 { IBM860 cp860 860 csIBM860 }
8291 { IBM861 cp861 861 cp-is csIBM861 }
8292 { IBM862 cp862 862 csPC862LatinHebrew }
8293 { IBM863 cp863 863 csIBM863 }
8294 { IBM864 cp864 csIBM864 }
8295 { IBM865 cp865 865 csIBM865 }
8296 { IBM866 cp866 866 csIBM866 }
8297 { IBM868 CP868 cp-ar csIBM868 }
8298 { IBM869 cp869 869 cp-gr csIBM869 }
8299 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8300 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8301 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8302 { IBM891 cp891 csIBM891 }
8303 { IBM903 cp903 csIBM903 }
8304 { IBM904 cp904 904 csIBBM904 }
8305 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8306 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8307 { IBM1026 CP1026 csIBM1026 }
8308 { EBCDIC-AT-DE csIBMEBCDICATDE }
8309 { EBCDIC-AT-DE-A csEBCDICATDEA }
8310 { EBCDIC-CA-FR csEBCDICCAFR }
8311 { EBCDIC-DK-NO csEBCDICDKNO }
8312 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8313 { EBCDIC-FI-SE csEBCDICFISE }
8314 { EBCDIC-FI-SE-A csEBCDICFISEA }
8315 { EBCDIC-FR csEBCDICFR }
8316 { EBCDIC-IT csEBCDICIT }
8317 { EBCDIC-PT csEBCDICPT }
8318 { EBCDIC-ES csEBCDICES }
8319 { EBCDIC-ES-A csEBCDICESA }
8320 { EBCDIC-ES-S csEBCDICESS }
8321 { EBCDIC-UK csEBCDICUK }
8322 { EBCDIC-US csEBCDICUS }
8323 { UNKNOWN-8BIT csUnknown8BiT }
8324 { MNEMONIC csMnemonic }
8329 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8330 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8331 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8332 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8333 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8334 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8335 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8336 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8337 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8338 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8339 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8340 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8341 { IBM1047 IBM-1047 }
8342 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8343 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8344 { UNICODE-1-1 csUnicode11 }
8347 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8348 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8350 { ISO-8859-15 ISO_8859-15 Latin-9 }
8351 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8352 { GBK CP936 MS936 windows-936 }
8353 { JIS_Encoding csJISEncoding }
8354 { Shift_JIS MS_Kanji csShiftJIS }
8355 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8357 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8358 { ISO-10646-UCS-Basic csUnicodeASCII }
8359 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8360 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8361 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8362 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8363 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8364 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8365 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8366 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8367 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8368 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8369 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8370 { Ventura-US csVenturaUS }
8371 { Ventura-International csVenturaInternational }
8372 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8373 { PC8-Turkish csPC8Turkish }
8374 { IBM-Symbols csIBMSymbols }
8375 { IBM-Thai csIBMThai }
8376 { HP-Legal csHPLegal }
8377 { HP-Pi-font csHPPiFont }
8378 { HP-Math8 csHPMath8 }
8379 { Adobe-Symbol-Encoding csHPPSMath }
8380 { HP-DeskTop csHPDesktop }
8381 { Ventura-Math csVenturaMath }
8382 { Microsoft-Publishing csMicrosoftPublishing }
8383 { Windows-31J csWindows31J }
8388 proc tcl_encoding {enc} {
8389 global encoding_aliases
8390 set names [encoding names]
8391 set lcnames [string tolower $names]
8392 set enc [string tolower $enc]
8393 set i [lsearch -exact $lcnames $enc]
8395 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8396 if {[regsub {^iso[-_]} $enc iso encx]} {
8397 set i [lsearch -exact $lcnames $encx]
8401 foreach l $encoding_aliases {
8402 set ll [string tolower $l]
8403 if {[lsearch -exact $ll $enc] < 0} continue
8404 # look through the aliases for one that tcl knows about
8406 set i [lsearch -exact $lcnames $e]
8408 if {[regsub {^iso[-_]} $e iso ex]} {
8409 set i [lsearch -exact $lcnames $ex]
8418 return [lindex $names $i]
8423 # First check that Tcl/Tk is recent enough
8424 if {[catch {package require Tk 8.4} err]} {
8425 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8426 Gitk requires at least Tcl/Tk 8.4."]
8432 set wrcomcmd "git diff-tree --stdin -p --pretty"
8436 set gitencoding [exec git config --get i18n.commitencoding]
8438 if {$gitencoding == ""} {
8439 set gitencoding "utf-8"
8441 set tclencoding [tcl_encoding $gitencoding]
8442 if {$tclencoding == {}} {
8443 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8446 set mainfont {Helvetica 9}
8447 set textfont {Courier 9}
8448 set uifont {Helvetica 9 bold}
8450 set findmergefiles 0
8458 set cmitmode "patch"
8459 set wrapcomment "none"
8463 set showlocalchanges 1
8465 set datetimeformat "%Y-%m-%d %H:%M:%S"
8467 set colors {green red blue magenta darkgrey brown orange}
8470 set diffcolors {red "#00a000" blue}
8473 set selectbgcolor gray85
8475 ## For msgcat loading, first locate the installation location.
8476 if { [info exists ::env(GITK_MSGSDIR)] } {
8477 ## Msgsdir was manually set in the environment.
8478 set gitk_msgsdir $::env(GITK_MSGSDIR)
8480 ## Let's guess the prefix from argv0.
8481 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8482 set gitk_libdir [file join $gitk_prefix share gitk lib]
8483 set gitk_msgsdir [file join $gitk_libdir msgs]
8487 ## Internationalization (i18n) through msgcat and gettext. See
8488 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8489 package require msgcat
8490 namespace import ::msgcat::mc
8491 ## And eventually load the actual message catalog
8492 ::msgcat::mcload $gitk_msgsdir
8494 catch {source ~/.gitk}
8496 font create optionfont -family sans-serif -size -12
8498 parsefont mainfont $mainfont
8499 eval font create mainfont [fontflags mainfont]
8500 eval font create mainfontbold [fontflags mainfont 1]
8502 parsefont textfont $textfont
8503 eval font create textfont [fontflags textfont]
8504 eval font create textfontbold [fontflags textfont 1]
8506 parsefont uifont $uifont
8507 eval font create uifont [fontflags uifont]
8511 # check that we can find a .git directory somewhere...
8512 if {[catch {set gitdir [gitdir]}]} {
8513 show_error {} . [mc "Cannot find a git repository here."]
8516 if {![file isdirectory $gitdir]} {
8517 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8523 set cmdline_files {}
8528 "-d" { set datemode 1 }
8531 lappend revtreeargs $arg
8534 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8538 lappend revtreeargs $arg
8544 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8545 # no -- on command line, but some arguments (other than -d)
8547 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8548 set cmdline_files [split $f "\n"]
8549 set n [llength $cmdline_files]
8550 set revtreeargs [lrange $revtreeargs 0 end-$n]
8551 # Unfortunately git rev-parse doesn't produce an error when
8552 # something is both a revision and a filename. To be consistent
8553 # with git log and git rev-list, check revtreeargs for filenames.
8554 foreach arg $revtreeargs {
8555 if {[file exists $arg]} {
8556 show_error {} . [mc "Ambiguous argument '%s': both revision\
8562 # unfortunately we get both stdout and stderr in $err,
8563 # so look for "fatal:".
8564 set i [string first "fatal:" $err]
8566 set err [string range $err [expr {$i + 6}] end]
8568 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8574 # find the list of unmerged files
8578 set fd [open "| git ls-files -u" r]
8580 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8583 while {[gets $fd line] >= 0} {
8584 set i [string first "\t" $line]
8585 if {$i < 0} continue
8586 set fname [string range $line [expr {$i+1}] end]
8587 if {[lsearch -exact $mlist $fname] >= 0} continue
8589 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8590 lappend mlist $fname
8595 if {$nr_unmerged == 0} {
8596 show_error {} . [mc "No files selected: --merge specified but\
8597 no files are unmerged."]
8599 show_error {} . [mc "No files selected: --merge specified but\
8600 no unmerged files are within file limit."]
8604 set cmdline_files $mlist
8607 set nullid "0000000000000000000000000000000000000000"
8608 set nullid2 "0000000000000000000000000000000000000001"
8610 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8617 set highlight_paths {}
8619 set searchdirn -forwards
8623 set markingmatches 0
8624 set linkentercount 0
8625 set need_redisplay 0
8632 set selectedhlview [mc "None"]
8633 set highlight_related [mc "None"]
8634 set highlight_files {}
8648 # wait for the window to become visible
8650 wm title . "[file tail $argv0]: [file tail [pwd]]"
8653 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8654 # create a view for the files/dirs specified on the command line
8658 set viewname(1) [mc "Command line"]
8659 set viewfiles(1) $cmdline_files
8660 set viewargs(1) $revtreeargs
8663 .bar.view entryconf [mc "Edit view..."] -state normal
8664 .bar.view entryconf [mc "Delete view"] -state normal
8667 if {[info exists permviews]} {
8668 foreach v $permviews {
8671 set viewname($n) [lindex $v 0]
8672 set viewfiles($n) [lindex $v 1]
8673 set viewargs($n) [lindex $v 2]