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 -z --pretty=raw $order --parents \
99 --boundary $viewargs($view) "--" $viewfiles($view)] r]
101 error_popup "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]
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 mainfont curview
140 start_rev_list $curview
141 show_status "Reading commits..."
144 # This makes a string representation of a positive integer which
145 # sorts as a string in numerical order
148 return [format "%x" $n]
149 } elseif {$n < 256} {
150 return [format "x%.2x" $n]
151 } elseif {$n < 65536} {
152 return [format "y%.4x" $n]
154 return [format "z%.8x" $n]
157 proc getcommitlines {fd view} {
158 global commitlisted commitinterest
159 global leftover commfd
160 global displayorder commitidx viewcomplete commitrow commitdata
161 global parentlist children curview hlview
162 global vparentlist vdisporder vcmitlisted
163 global ordertok vnextroot idpending
165 set stuff [read $fd 500000]
166 # git log doesn't terminate the last commit with a null...
167 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
174 # Check if we have seen any ids listed as parents that haven't
175 # appeared in the list
176 foreach vid [array names idpending "$view,*"] {
177 # should only get here if git log is buggy
178 set id [lindex [split $vid ","] 1]
179 set commitrow($vid) $commitidx($view)
180 incr commitidx($view)
181 if {$view == $curview} {
182 lappend parentlist {}
183 lappend displayorder $id
184 lappend commitlisted 0
186 lappend vparentlist($view) {}
187 lappend vdisporder($view) $id
188 lappend vcmitlisted($view) 0
191 set viewcomplete($view) 1
192 global viewname progresscoords
195 set progresscoords {0 0}
197 # set it blocking so we wait for the process to terminate
198 fconfigure $fd -blocking 1
199 if {[catch {close $fd} err]} {
201 if {$view != $curview} {
202 set fv " for the \"$viewname($view)\" view"
204 if {[string range $err 0 4] == "usage"} {
205 set err "Gitk: error reading commits$fv:\
206 bad arguments to git rev-list."
207 if {$viewname($view) eq "Command line"} {
209 " (Note: arguments to gitk are passed to git rev-list\
210 to allow selection of commits to be displayed.)"
213 set err "Error reading commits$fv: $err"
217 if {$view == $curview} {
218 run chewcommits $view
225 set i [string first "\0" $stuff $start]
227 append leftover($view) [string range $stuff $start end]
231 set cmit $leftover($view)
232 append cmit [string range $stuff 0 [expr {$i - 1}]]
233 set leftover($view) {}
235 set cmit [string range $stuff $start [expr {$i - 1}]]
237 set start [expr {$i + 1}]
238 set j [string first "\n" $cmit]
241 if {$j >= 0 && [string match "commit *" $cmit]} {
242 set ids [string range $cmit 7 [expr {$j - 1}]]
243 if {[string match {[-<>]*} $ids]} {
244 switch -- [string index $ids 0] {
249 set ids [string range $ids 1 end]
253 if {[string length $id] != 40} {
261 if {[string length $shortcmit] > 80} {
262 set shortcmit "[string range $shortcmit 0 80]..."
264 error_popup "Can't parse git log output: {$shortcmit}"
267 set id [lindex $ids 0]
268 if {![info exists ordertok($view,$id)]} {
269 set otok "o[strrep $vnextroot($view)]"
270 incr vnextroot($view)
271 set ordertok($view,$id) $otok
273 set otok $ordertok($view,$id)
274 unset idpending($view,$id)
277 set olds [lrange $ids 1 end]
278 if {[llength $olds] == 1} {
279 set p [lindex $olds 0]
280 lappend children($view,$p) $id
281 if {![info exists ordertok($view,$p)]} {
282 set ordertok($view,$p) $ordertok($view,$id)
283 set idpending($view,$p) 1
288 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
289 lappend children($view,$p) $id
291 if {![info exists ordertok($view,$p)]} {
292 set ordertok($view,$p) "$otok[strrep $i]]"
293 set idpending($view,$p) 1
301 if {![info exists children($view,$id)]} {
302 set children($view,$id) {}
304 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
305 set commitrow($view,$id) $commitidx($view)
306 incr commitidx($view)
307 if {$view == $curview} {
308 lappend parentlist $olds
309 lappend displayorder $id
310 lappend commitlisted $listed
312 lappend vparentlist($view) $olds
313 lappend vdisporder($view) $id
314 lappend vcmitlisted($view) $listed
316 if {[info exists commitinterest($id)]} {
317 foreach script $commitinterest($id) {
318 eval [string map [list "%I" $id] $script]
320 unset commitinterest($id)
325 run chewcommits $view
326 if {$view == $curview} {
327 # update progress bar
328 global progressdirn progresscoords proglastnc
329 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
330 set proglastnc $commitidx($view)
331 set l [lindex $progresscoords 0]
332 set r [lindex $progresscoords 1]
334 set r [expr {$r + $inc}]
340 set l [expr {$r - 0.2}]
343 set l [expr {$l - $inc}]
348 set r [expr {$l + 0.2}]
350 set progresscoords [list $l $r]
357 proc chewcommits {view} {
358 global curview hlview viewcomplete
359 global selectedline pending_select
361 if {$view == $curview} {
363 if {$viewcomplete($view)} {
364 global displayorder commitidx phase
365 global numcommits startmsecs
367 if {[info exists pending_select]} {
368 set row [first_real_row]
371 if {$commitidx($curview) > 0} {
372 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
373 #puts "overall $ms ms for $numcommits commits"
375 show_status "No commits selected"
381 if {[info exists hlview] && $view == $hlview} {
387 proc readcommit {id} {
388 if {[catch {set contents [exec git cat-file commit $id]}]} return
389 parsecommit $id $contents 0
392 proc updatecommits {} {
393 global viewdata curview phase displayorder ordertok idpending
394 global children commitrow selectedline thickerline showneartags
401 foreach id $displayorder {
402 catch {unset children($n,$id)}
403 catch {unset commitrow($n,$id)}
404 catch {unset ordertok($n,$id)}
406 foreach vid [array names idpending "$n,*"] {
407 unset idpending($vid)
410 catch {unset selectedline}
411 catch {unset thickerline}
412 catch {unset viewdata($n)}
421 proc parsecommit {id contents listed} {
422 global commitinfo cdate
431 set hdrend [string first "\n\n" $contents]
433 # should never happen...
434 set hdrend [string length $contents]
436 set header [string range $contents 0 [expr {$hdrend - 1}]]
437 set comment [string range $contents [expr {$hdrend + 2}] end]
438 foreach line [split $header "\n"] {
439 set tag [lindex $line 0]
440 if {$tag == "author"} {
441 set audate [lindex $line end-1]
442 set auname [lrange $line 1 end-2]
443 } elseif {$tag == "committer"} {
444 set comdate [lindex $line end-1]
445 set comname [lrange $line 1 end-2]
449 # take the first non-blank line of the comment as the headline
450 set headline [string trimleft $comment]
451 set i [string first "\n" $headline]
453 set headline [string range $headline 0 $i]
455 set headline [string trimright $headline]
456 set i [string first "\r" $headline]
458 set headline [string trimright [string range $headline 0 $i]]
461 # git rev-list indents the comment by 4 spaces;
462 # if we got this via git cat-file, add the indentation
464 foreach line [split $comment "\n"] {
465 append newcomment " "
466 append newcomment $line
467 append newcomment "\n"
469 set comment $newcomment
471 if {$comdate != {}} {
472 set cdate($id) $comdate
474 set commitinfo($id) [list $headline $auname $audate \
475 $comname $comdate $comment]
478 proc getcommit {id} {
479 global commitdata commitinfo
481 if {[info exists commitdata($id)]} {
482 parsecommit $id $commitdata($id) 1
485 if {![info exists commitinfo($id)]} {
486 set commitinfo($id) {"No commit information available"}
493 global tagids idtags headids idheads tagobjid
494 global otherrefids idotherrefs mainhead mainheadid
496 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
499 set refd [open [list | git show-ref -d] r]
500 while {[gets $refd line] >= 0} {
501 if {[string index $line 40] ne " "} continue
502 set id [string range $line 0 39]
503 set ref [string range $line 41 end]
504 if {![string match "refs/*" $ref]} continue
505 set name [string range $ref 5 end]
506 if {[string match "remotes/*" $name]} {
507 if {![string match "*/HEAD" $name]} {
508 set headids($name) $id
509 lappend idheads($id) $name
511 } elseif {[string match "heads/*" $name]} {
512 set name [string range $name 6 end]
513 set headids($name) $id
514 lappend idheads($id) $name
515 } elseif {[string match "tags/*" $name]} {
516 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
517 # which is what we want since the former is the commit ID
518 set name [string range $name 5 end]
519 if {[string match "*^{}" $name]} {
520 set name [string range $name 0 end-3]
522 set tagobjid($name) $id
524 set tagids($name) $id
525 lappend idtags($id) $name
527 set otherrefids($name) $id
528 lappend idotherrefs($id) $name
535 set thehead [exec git symbolic-ref HEAD]
536 if {[string match "refs/heads/*" $thehead]} {
537 set mainhead [string range $thehead 11 end]
538 if {[info exists headids($mainhead)]} {
539 set mainheadid $headids($mainhead)
545 # skip over fake commits
546 proc first_real_row {} {
547 global nullid nullid2 displayorder numcommits
549 for {set row 0} {$row < $numcommits} {incr row} {
550 set id [lindex $displayorder $row]
551 if {$id ne $nullid && $id ne $nullid2} {
558 # update things for a head moved to a child of its previous location
559 proc movehead {id name} {
560 global headids idheads
562 removehead $headids($name) $name
563 set headids($name) $id
564 lappend idheads($id) $name
567 # update things when a head has been removed
568 proc removehead {id name} {
569 global headids idheads
571 if {$idheads($id) eq $name} {
574 set i [lsearch -exact $idheads($id) $name]
576 set idheads($id) [lreplace $idheads($id) $i $i]
582 proc show_error {w top msg} {
583 message $w.m -text $msg -justify center -aspect 400
584 pack $w.m -side top -fill x -padx 20 -pady 20
585 button $w.ok -text OK -command "destroy $top"
586 pack $w.ok -side bottom -fill x
587 bind $top <Visibility> "grab $top; focus $top"
588 bind $top <Key-Return> "destroy $top"
592 proc error_popup msg {
596 show_error $w $w $msg
599 proc confirm_popup msg {
605 message $w.m -text $msg -justify center -aspect 400
606 pack $w.m -side top -fill x -padx 20 -pady 20
607 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text Cancel -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
617 global canv canv2 canv3 linespc charspc ctext cflist
618 global textfont mainfont uifont tabstop
619 global findtype findtypemenu findloc findstring fstring geometry
620 global entries sha1entry sha1string sha1but
621 global diffcontextstring diffcontext
622 global maincursor textcursor curtextcursor
623 global rowctxmenu fakerowmenu mergemax wrapcomment
624 global highlight_files gdttype
625 global searchstring sstring
626 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
627 global headctxmenu progresscanv progressitem progresscoords statusw
628 global fprogitem fprogcoord lastprogupdate progupdatepending
631 .bar add cascade -label "File" -menu .bar.file
632 .bar configure -font $uifont
634 .bar.file add command -label "Update" -command updatecommits
635 .bar.file add command -label "Reread references" -command rereadrefs
636 .bar.file add command -label "List references" -command showrefs
637 .bar.file add command -label "Quit" -command doquit
638 .bar.file configure -font $uifont
640 .bar add cascade -label "Edit" -menu .bar.edit
641 .bar.edit add command -label "Preferences" -command doprefs
642 .bar.edit configure -font $uifont
644 menu .bar.view -font $uifont
645 .bar add cascade -label "View" -menu .bar.view
646 .bar.view add command -label "New view..." -command {newview 0}
647 .bar.view add command -label "Edit view..." -command editview \
649 .bar.view add command -label "Delete view" -command delview -state disabled
650 .bar.view add separator
651 .bar.view add radiobutton -label "All files" -command {showview 0} \
652 -variable selectedview -value 0
655 .bar add cascade -label "Help" -menu .bar.help
656 .bar.help add command -label "About gitk" -command about
657 .bar.help add command -label "Key bindings" -command keys
658 .bar.help configure -font $uifont
659 . configure -menu .bar
661 # the gui has upper and lower half, parts of a paned window.
662 panedwindow .ctop -orient vertical
664 # possibly use assumed geometry
665 if {![info exists geometry(pwsash0)]} {
666 set geometry(topheight) [expr {15 * $linespc}]
667 set geometry(topwidth) [expr {80 * $charspc}]
668 set geometry(botheight) [expr {15 * $linespc}]
669 set geometry(botwidth) [expr {50 * $charspc}]
670 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
671 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
674 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
675 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
677 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
679 # create three canvases
680 set cscroll .tf.histframe.csb
681 set canv .tf.histframe.pwclist.canv
683 -selectbackground $selectbgcolor \
684 -background $bgcolor -bd 0 \
685 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
686 .tf.histframe.pwclist add $canv
687 set canv2 .tf.histframe.pwclist.canv2
689 -selectbackground $selectbgcolor \
690 -background $bgcolor -bd 0 -yscrollincr $linespc
691 .tf.histframe.pwclist add $canv2
692 set canv3 .tf.histframe.pwclist.canv3
694 -selectbackground $selectbgcolor \
695 -background $bgcolor -bd 0 -yscrollincr $linespc
696 .tf.histframe.pwclist add $canv3
697 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
698 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
700 # a scroll bar to rule them
701 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
702 pack $cscroll -side right -fill y
703 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
704 lappend bglist $canv $canv2 $canv3
705 pack .tf.histframe.pwclist -fill both -expand 1 -side left
707 # we have two button bars at bottom of top frame. Bar 1
709 frame .tf.lbar -height 15
711 set sha1entry .tf.bar.sha1
712 set entries $sha1entry
713 set sha1but .tf.bar.sha1label
714 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
715 -command gotocommit -width 8 -font $uifont
716 $sha1but conf -disabledforeground [$sha1but cget -foreground]
717 pack .tf.bar.sha1label -side left
718 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
719 trace add variable sha1string write sha1change
720 pack $sha1entry -side left -pady 2
722 image create bitmap bm-left -data {
723 #define left_width 16
724 #define left_height 16
725 static unsigned char left_bits[] = {
726 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
727 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
728 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
730 image create bitmap bm-right -data {
731 #define right_width 16
732 #define right_height 16
733 static unsigned char right_bits[] = {
734 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
735 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
736 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
738 button .tf.bar.leftbut -image bm-left -command goback \
739 -state disabled -width 26
740 pack .tf.bar.leftbut -side left -fill y
741 button .tf.bar.rightbut -image bm-right -command goforw \
742 -state disabled -width 26
743 pack .tf.bar.rightbut -side left -fill y
745 # Status label and progress bar
746 set statusw .tf.bar.status
747 label $statusw -width 15 -relief sunken -font $uifont
748 pack $statusw -side left -padx 5
749 set h [expr {[font metrics $uifont -linespace] + 2}]
750 set progresscanv .tf.bar.progress
751 canvas $progresscanv -relief sunken -height $h -borderwidth 2
752 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
753 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
754 pack $progresscanv -side right -expand 1 -fill x
755 set progresscoords {0 0}
757 bind $progresscanv <Configure> adjustprogress
758 set lastprogupdate [clock clicks -milliseconds]
759 set progupdatepending 0
761 # build up the bottom bar of upper window
762 label .tf.lbar.flabel -text "Find " -font $uifont
763 button .tf.lbar.fnext -text "next" -command dofind -font $uifont
764 button .tf.lbar.fprev -text "prev" -command {dofind 1} -font $uifont
765 label .tf.lbar.flab2 -text " commit " -font $uifont
766 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
768 set gdttype "containing:"
769 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
772 "adding/removing string:"]
773 trace add variable gdttype write gdttype_change
774 $gm conf -font $uifont
775 .tf.lbar.gdttype conf -font $uifont
776 pack .tf.lbar.gdttype -side left -fill y
779 set fstring .tf.lbar.findstring
780 lappend entries $fstring
781 entry $fstring -width 30 -font $textfont -textvariable findstring
782 trace add variable findstring write find_change
784 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
785 findtype Exact IgnCase Regexp]
786 trace add variable findtype write findcom_change
787 .tf.lbar.findtype configure -font $uifont
788 .tf.lbar.findtype.menu configure -font $uifont
789 set findloc "All fields"
790 tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
791 Comments Author Committer
792 trace add variable findloc write find_change
793 .tf.lbar.findloc configure -font $uifont
794 .tf.lbar.findloc.menu configure -font $uifont
795 pack .tf.lbar.findloc -side right
796 pack .tf.lbar.findtype -side right
797 pack $fstring -side left -expand 1 -fill x
799 # Finish putting the upper half of the viewer together
800 pack .tf.lbar -in .tf -side bottom -fill x
801 pack .tf.bar -in .tf -side bottom -fill x
802 pack .tf.histframe -fill both -side top -expand 1
804 .ctop paneconfigure .tf -height $geometry(topheight)
805 .ctop paneconfigure .tf -width $geometry(topwidth)
807 # now build up the bottom
808 panedwindow .pwbottom -orient horizontal
810 # lower left, a text box over search bar, scroll bar to the right
811 # if we know window height, then that will set the lower text height, otherwise
812 # we set lower text height which will drive window height
813 if {[info exists geometry(main)]} {
814 frame .bleft -width $geometry(botwidth)
816 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
821 button .bleft.top.search -text "Search" -command dosearch \
823 pack .bleft.top.search -side left -padx 5
824 set sstring .bleft.top.sstring
825 entry $sstring -width 20 -font $textfont -textvariable searchstring
826 lappend entries $sstring
827 trace add variable searchstring write incrsearch
828 pack $sstring -side left -expand 1 -fill x
829 radiobutton .bleft.mid.diff -text "Diff" \
830 -command changediffdisp -variable diffelide -value {0 0}
831 radiobutton .bleft.mid.old -text "Old version" \
832 -command changediffdisp -variable diffelide -value {0 1}
833 radiobutton .bleft.mid.new -text "New version" \
834 -command changediffdisp -variable diffelide -value {1 0}
835 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
837 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
838 spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
839 -from 1 -increment 1 -to 10000000 \
840 -validate all -validatecommand "diffcontextvalidate %P" \
841 -textvariable diffcontextstring
842 .bleft.mid.diffcontext set $diffcontext
843 trace add variable diffcontextstring write diffcontextchange
844 lappend entries .bleft.mid.diffcontext
845 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
846 set ctext .bleft.ctext
847 text $ctext -background $bgcolor -foreground $fgcolor \
848 -tabs "[expr {$tabstop * $charspc}]" \
849 -state disabled -font $textfont \
850 -yscrollcommand scrolltext -wrap none
851 scrollbar .bleft.sb -command "$ctext yview"
852 pack .bleft.top -side top -fill x
853 pack .bleft.mid -side top -fill x
854 pack .bleft.sb -side right -fill y
855 pack $ctext -side left -fill both -expand 1
856 lappend bglist $ctext
857 lappend fglist $ctext
859 $ctext tag conf comment -wrap $wrapcomment
860 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
861 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
862 $ctext tag conf d0 -fore [lindex $diffcolors 0]
863 $ctext tag conf d1 -fore [lindex $diffcolors 1]
864 $ctext tag conf m0 -fore red
865 $ctext tag conf m1 -fore blue
866 $ctext tag conf m2 -fore green
867 $ctext tag conf m3 -fore purple
868 $ctext tag conf m4 -fore brown
869 $ctext tag conf m5 -fore "#009090"
870 $ctext tag conf m6 -fore magenta
871 $ctext tag conf m7 -fore "#808000"
872 $ctext tag conf m8 -fore "#009000"
873 $ctext tag conf m9 -fore "#ff0080"
874 $ctext tag conf m10 -fore cyan
875 $ctext tag conf m11 -fore "#b07070"
876 $ctext tag conf m12 -fore "#70b0f0"
877 $ctext tag conf m13 -fore "#70f0b0"
878 $ctext tag conf m14 -fore "#f0b070"
879 $ctext tag conf m15 -fore "#ff70b0"
880 $ctext tag conf mmax -fore darkgrey
882 $ctext tag conf mresult -font [concat $textfont bold]
883 $ctext tag conf msep -font [concat $textfont bold]
884 $ctext tag conf found -back yellow
887 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
892 radiobutton .bright.mode.patch -text "Patch" \
893 -command reselectline -variable cmitmode -value "patch"
894 .bright.mode.patch configure -font $uifont
895 radiobutton .bright.mode.tree -text "Tree" \
896 -command reselectline -variable cmitmode -value "tree"
897 .bright.mode.tree configure -font $uifont
898 grid .bright.mode.patch .bright.mode.tree -sticky ew
899 pack .bright.mode -side top -fill x
900 set cflist .bright.cfiles
901 set indent [font measure $mainfont "nn"]
903 -selectbackground $selectbgcolor \
904 -background $bgcolor -foreground $fgcolor \
906 -tabs [list $indent [expr {2 * $indent}]] \
907 -yscrollcommand ".bright.sb set" \
908 -cursor [. cget -cursor] \
909 -spacing1 1 -spacing3 1
910 lappend bglist $cflist
911 lappend fglist $cflist
912 scrollbar .bright.sb -command "$cflist yview"
913 pack .bright.sb -side right -fill y
914 pack $cflist -side left -fill both -expand 1
915 $cflist tag configure highlight \
916 -background [$cflist cget -selectbackground]
917 $cflist tag configure bold -font [concat $mainfont bold]
919 .pwbottom add .bright
922 # restore window position if known
923 if {[info exists geometry(main)]} {
924 wm geometry . "$geometry(main)"
927 if {[tk windowingsystem] eq {aqua}} {
933 bind .pwbottom <Configure> {resizecdetpanes %W %w}
934 pack .ctop -fill both -expand 1
935 bindall <1> {selcanvline %W %x %y}
936 #bindall <B1-Motion> {selcanvline %W %x %y}
937 if {[tk windowingsystem] == "win32"} {
938 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
939 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
941 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
942 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
944 bindall <2> "canvscan mark %W %x %y"
945 bindall <B2-Motion> "canvscan dragto %W %x %y"
946 bindkey <Home> selfirstline
947 bindkey <End> sellastline
948 bind . <Key-Up> "selnextline -1"
949 bind . <Key-Down> "selnextline 1"
950 bindkey <Key-Right> "goforw"
951 bindkey <Key-Left> "goback"
952 bind . <Key-Prior> "selnextpage -1"
953 bind . <Key-Next> "selnextpage 1"
954 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
955 bind . <$M1B-End> "allcanvs yview moveto 1.0"
956 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
957 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
958 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
959 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
960 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
961 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
962 bindkey <Key-space> "$ctext yview scroll 1 pages"
963 bindkey p "selnextline -1"
964 bindkey n "selnextline 1"
967 bindkey i "selnextline -1"
968 bindkey k "selnextline 1"
971 bindkey b "$ctext yview scroll -1 pages"
972 bindkey d "$ctext yview scroll 18 units"
973 bindkey u "$ctext yview scroll -18 units"
974 bindkey / {findnext 1}
975 bindkey <Key-Return> {findnext 0}
978 bindkey <F5> updatecommits
979 bind . <$M1B-q> doquit
980 bind . <$M1B-f> dofind
981 bind . <$M1B-g> {findnext 0}
982 bind . <$M1B-r> dosearchback
983 bind . <$M1B-s> dosearch
984 bind . <$M1B-equal> {incrfont 1}
985 bind . <$M1B-KP_Add> {incrfont 1}
986 bind . <$M1B-minus> {incrfont -1}
987 bind . <$M1B-KP_Subtract> {incrfont -1}
988 wm protocol . WM_DELETE_WINDOW doquit
989 bind . <Button-1> "click %W"
990 bind $fstring <Key-Return> dofind
991 bind $sha1entry <Key-Return> gotocommit
992 bind $sha1entry <<PasteSelection>> clearsha1
993 bind $cflist <1> {sel_flist %W %x %y; break}
994 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
995 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
996 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
998 set maincursor [. cget -cursor]
999 set textcursor [$ctext cget -cursor]
1000 set curtextcursor $textcursor
1002 set rowctxmenu .rowctxmenu
1003 menu $rowctxmenu -tearoff 0
1004 $rowctxmenu add command -label "Diff this -> selected" \
1005 -command {diffvssel 0}
1006 $rowctxmenu add command -label "Diff selected -> this" \
1007 -command {diffvssel 1}
1008 $rowctxmenu add command -label "Make patch" -command mkpatch
1009 $rowctxmenu add command -label "Create tag" -command mktag
1010 $rowctxmenu add command -label "Write commit to file" -command writecommit
1011 $rowctxmenu add command -label "Create new branch" -command mkbranch
1012 $rowctxmenu add command -label "Cherry-pick this commit" \
1014 $rowctxmenu add command -label "Reset HEAD branch to here" \
1017 set fakerowmenu .fakerowmenu
1018 menu $fakerowmenu -tearoff 0
1019 $fakerowmenu add command -label "Diff this -> selected" \
1020 -command {diffvssel 0}
1021 $fakerowmenu add command -label "Diff selected -> this" \
1022 -command {diffvssel 1}
1023 $fakerowmenu add command -label "Make patch" -command mkpatch
1024 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
1025 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
1026 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
1028 set headctxmenu .headctxmenu
1029 menu $headctxmenu -tearoff 0
1030 $headctxmenu add command -label "Check out this branch" \
1032 $headctxmenu add command -label "Remove this branch" \
1036 set flist_menu .flistctxmenu
1037 menu $flist_menu -tearoff 0
1038 $flist_menu add command -label "Highlight this too" \
1039 -command {flist_hl 0}
1040 $flist_menu add command -label "Highlight this only" \
1041 -command {flist_hl 1}
1044 # Windows sends all mouse wheel events to the current focused window, not
1045 # the one where the mouse hovers, so bind those events here and redirect
1046 # to the correct window
1047 proc windows_mousewheel_redirector {W X Y D} {
1048 global canv canv2 canv3
1049 set w [winfo containing -displayof $W $X $Y]
1051 set u [expr {$D < 0 ? 5 : -5}]
1052 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1053 allcanvs yview scroll $u units
1056 $w yview scroll $u units
1062 # mouse-2 makes all windows scan vertically, but only the one
1063 # the cursor is in scans horizontally
1064 proc canvscan {op w x y} {
1065 global canv canv2 canv3
1066 foreach c [list $canv $canv2 $canv3] {
1075 proc scrollcanv {cscroll f0 f1} {
1076 $cscroll set $f0 $f1
1081 # when we make a key binding for the toplevel, make sure
1082 # it doesn't get triggered when that key is pressed in the
1083 # find string entry widget.
1084 proc bindkey {ev script} {
1087 set escript [bind Entry $ev]
1088 if {$escript == {}} {
1089 set escript [bind Entry <Key>]
1091 foreach e $entries {
1092 bind $e $ev "$escript; break"
1096 # set the focus back to the toplevel for any click outside
1099 global ctext entries
1100 foreach e [concat $entries $ctext] {
1101 if {$w == $e} return
1106 # Adjust the progress bar for a change in requested extent or canvas size
1107 proc adjustprogress {} {
1108 global progresscanv progressitem progresscoords
1109 global fprogitem fprogcoord lastprogupdate progupdatepending
1111 set w [expr {[winfo width $progresscanv] - 4}]
1112 set x0 [expr {$w * [lindex $progresscoords 0]}]
1113 set x1 [expr {$w * [lindex $progresscoords 1]}]
1114 set h [winfo height $progresscanv]
1115 $progresscanv coords $progressitem $x0 0 $x1 $h
1116 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1117 set now [clock clicks -milliseconds]
1118 if {$now >= $lastprogupdate + 100} {
1119 set progupdatepending 0
1121 } elseif {!$progupdatepending} {
1122 set progupdatepending 1
1123 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1127 proc doprogupdate {} {
1128 global lastprogupdate progupdatepending
1130 if {$progupdatepending} {
1131 set progupdatepending 0
1132 set lastprogupdate [clock clicks -milliseconds]
1137 proc savestuff {w} {
1138 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1139 global stuffsaved findmergefiles maxgraphpct
1140 global maxwidth showneartags showlocalchanges
1141 global viewname viewfiles viewargs viewperm nextviewnum
1142 global cmitmode wrapcomment datetimeformat
1143 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1145 if {$stuffsaved} return
1146 if {![winfo viewable .]} return
1148 set f [open "~/.gitk-new" w]
1149 puts $f [list set mainfont $mainfont]
1150 puts $f [list set textfont $textfont]
1151 puts $f [list set uifont $uifont]
1152 puts $f [list set tabstop $tabstop]
1153 puts $f [list set findmergefiles $findmergefiles]
1154 puts $f [list set maxgraphpct $maxgraphpct]
1155 puts $f [list set maxwidth $maxwidth]
1156 puts $f [list set cmitmode $cmitmode]
1157 puts $f [list set wrapcomment $wrapcomment]
1158 puts $f [list set showneartags $showneartags]
1159 puts $f [list set showlocalchanges $showlocalchanges]
1160 puts $f [list set datetimeformat $datetimeformat]
1161 puts $f [list set bgcolor $bgcolor]
1162 puts $f [list set fgcolor $fgcolor]
1163 puts $f [list set colors $colors]
1164 puts $f [list set diffcolors $diffcolors]
1165 puts $f [list set diffcontext $diffcontext]
1166 puts $f [list set selectbgcolor $selectbgcolor]
1168 puts $f "set geometry(main) [wm geometry .]"
1169 puts $f "set geometry(topwidth) [winfo width .tf]"
1170 puts $f "set geometry(topheight) [winfo height .tf]"
1171 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1172 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1173 puts $f "set geometry(botwidth) [winfo width .bleft]"
1174 puts $f "set geometry(botheight) [winfo height .bleft]"
1176 puts -nonewline $f "set permviews {"
1177 for {set v 0} {$v < $nextviewnum} {incr v} {
1178 if {$viewperm($v)} {
1179 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1184 file rename -force "~/.gitk-new" "~/.gitk"
1189 proc resizeclistpanes {win w} {
1191 if {[info exists oldwidth($win)]} {
1192 set s0 [$win sash coord 0]
1193 set s1 [$win sash coord 1]
1195 set sash0 [expr {int($w/2 - 2)}]
1196 set sash1 [expr {int($w*5/6 - 2)}]
1198 set factor [expr {1.0 * $w / $oldwidth($win)}]
1199 set sash0 [expr {int($factor * [lindex $s0 0])}]
1200 set sash1 [expr {int($factor * [lindex $s1 0])}]
1204 if {$sash1 < $sash0 + 20} {
1205 set sash1 [expr {$sash0 + 20}]
1207 if {$sash1 > $w - 10} {
1208 set sash1 [expr {$w - 10}]
1209 if {$sash0 > $sash1 - 20} {
1210 set sash0 [expr {$sash1 - 20}]
1214 $win sash place 0 $sash0 [lindex $s0 1]
1215 $win sash place 1 $sash1 [lindex $s1 1]
1217 set oldwidth($win) $w
1220 proc resizecdetpanes {win w} {
1222 if {[info exists oldwidth($win)]} {
1223 set s0 [$win sash coord 0]
1225 set sash0 [expr {int($w*3/4 - 2)}]
1227 set factor [expr {1.0 * $w / $oldwidth($win)}]
1228 set sash0 [expr {int($factor * [lindex $s0 0])}]
1232 if {$sash0 > $w - 15} {
1233 set sash0 [expr {$w - 15}]
1236 $win sash place 0 $sash0 [lindex $s0 1]
1238 set oldwidth($win) $w
1241 proc allcanvs args {
1242 global canv canv2 canv3
1248 proc bindall {event action} {
1249 global canv canv2 canv3
1250 bind $canv $event $action
1251 bind $canv2 $event $action
1252 bind $canv3 $event $action
1258 if {[winfo exists $w]} {
1263 wm title $w "About gitk"
1264 message $w.m -text {
1265 Gitk - a commit viewer for git
1267 Copyright © 2005-2006 Paul Mackerras
1269 Use and redistribute under the terms of the GNU General Public License} \
1270 -justify center -aspect 400 -border 2 -bg white -relief groove
1271 pack $w.m -side top -fill x -padx 2 -pady 2
1272 $w.m configure -font $uifont
1273 button $w.ok -text Close -command "destroy $w" -default active
1274 pack $w.ok -side bottom
1275 $w.ok configure -font $uifont
1276 bind $w <Visibility> "focus $w.ok"
1277 bind $w <Key-Escape> "destroy $w"
1278 bind $w <Key-Return> "destroy $w"
1284 if {[winfo exists $w]} {
1288 if {[tk windowingsystem] eq {aqua}} {
1294 wm title $w "Gitk key bindings"
1295 message $w.m -text "
1299 <Home> Move to first commit
1300 <End> Move to last commit
1301 <Up>, p, i Move up one commit
1302 <Down>, n, k Move down one commit
1303 <Left>, z, j Go back in history list
1304 <Right>, x, l Go forward in history list
1305 <PageUp> Move up one page in commit list
1306 <PageDown> Move down one page in commit list
1307 <$M1T-Home> Scroll to top of commit list
1308 <$M1T-End> Scroll to bottom of commit list
1309 <$M1T-Up> Scroll commit list up one line
1310 <$M1T-Down> Scroll commit list down one line
1311 <$M1T-PageUp> Scroll commit list up one page
1312 <$M1T-PageDown> Scroll commit list down one page
1313 <Shift-Up> Move to previous highlighted line
1314 <Shift-Down> Move to next highlighted line
1315 <Delete>, b Scroll diff view up one page
1316 <Backspace> Scroll diff view up one page
1317 <Space> Scroll diff view down one page
1318 u Scroll diff view up 18 lines
1319 d Scroll diff view down 18 lines
1321 <$M1T-G> Move to next find hit
1322 <Return> Move to next find hit
1323 / Move to next find hit, or redo find
1324 ? Move to previous find hit
1325 f Scroll diff view to next file
1326 <$M1T-S> Search for next hit in diff view
1327 <$M1T-R> Search for previous hit in diff view
1328 <$M1T-KP+> Increase font size
1329 <$M1T-plus> Increase font size
1330 <$M1T-KP-> Decrease font size
1331 <$M1T-minus> Decrease font size
1334 -justify left -bg white -border 2 -relief groove
1335 pack $w.m -side top -fill both -padx 2 -pady 2
1336 $w.m configure -font $uifont
1337 button $w.ok -text Close -command "destroy $w" -default active
1338 pack $w.ok -side bottom
1339 $w.ok configure -font $uifont
1340 bind $w <Visibility> "focus $w.ok"
1341 bind $w <Key-Escape> "destroy $w"
1342 bind $w <Key-Return> "destroy $w"
1345 # Procedures for manipulating the file list window at the
1346 # bottom right of the overall window.
1348 proc treeview {w l openlevs} {
1349 global treecontents treediropen treeheight treeparent treeindex
1359 set treecontents() {}
1360 $w conf -state normal
1362 while {[string range $f 0 $prefixend] ne $prefix} {
1363 if {$lev <= $openlevs} {
1364 $w mark set e:$treeindex($prefix) "end -1c"
1365 $w mark gravity e:$treeindex($prefix) left
1367 set treeheight($prefix) $ht
1368 incr ht [lindex $htstack end]
1369 set htstack [lreplace $htstack end end]
1370 set prefixend [lindex $prefendstack end]
1371 set prefendstack [lreplace $prefendstack end end]
1372 set prefix [string range $prefix 0 $prefixend]
1375 set tail [string range $f [expr {$prefixend+1}] end]
1376 while {[set slash [string first "/" $tail]] >= 0} {
1379 lappend prefendstack $prefixend
1380 incr prefixend [expr {$slash + 1}]
1381 set d [string range $tail 0 $slash]
1382 lappend treecontents($prefix) $d
1383 set oldprefix $prefix
1385 set treecontents($prefix) {}
1386 set treeindex($prefix) [incr ix]
1387 set treeparent($prefix) $oldprefix
1388 set tail [string range $tail [expr {$slash+1}] end]
1389 if {$lev <= $openlevs} {
1391 set treediropen($prefix) [expr {$lev < $openlevs}]
1392 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1393 $w mark set d:$ix "end -1c"
1394 $w mark gravity d:$ix left
1396 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1398 $w image create end -align center -image $bm -padx 1 \
1400 $w insert end $d [highlight_tag $prefix]
1401 $w mark set s:$ix "end -1c"
1402 $w mark gravity s:$ix left
1407 if {$lev <= $openlevs} {
1410 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1412 $w insert end $tail [highlight_tag $f]
1414 lappend treecontents($prefix) $tail
1417 while {$htstack ne {}} {
1418 set treeheight($prefix) $ht
1419 incr ht [lindex $htstack end]
1420 set htstack [lreplace $htstack end end]
1421 set prefixend [lindex $prefendstack end]
1422 set prefendstack [lreplace $prefendstack end end]
1423 set prefix [string range $prefix 0 $prefixend]
1425 $w conf -state disabled
1428 proc linetoelt {l} {
1429 global treeheight treecontents
1434 foreach e $treecontents($prefix) {
1439 if {[string index $e end] eq "/"} {
1440 set n $treeheight($prefix$e)
1452 proc highlight_tree {y prefix} {
1453 global treeheight treecontents cflist
1455 foreach e $treecontents($prefix) {
1457 if {[highlight_tag $path] ne {}} {
1458 $cflist tag add bold $y.0 "$y.0 lineend"
1461 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1462 set y [highlight_tree $y $path]
1468 proc treeclosedir {w dir} {
1469 global treediropen treeheight treeparent treeindex
1471 set ix $treeindex($dir)
1472 $w conf -state normal
1473 $w delete s:$ix e:$ix
1474 set treediropen($dir) 0
1475 $w image configure a:$ix -image tri-rt
1476 $w conf -state disabled
1477 set n [expr {1 - $treeheight($dir)}]
1478 while {$dir ne {}} {
1479 incr treeheight($dir) $n
1480 set dir $treeparent($dir)
1484 proc treeopendir {w dir} {
1485 global treediropen treeheight treeparent treecontents treeindex
1487 set ix $treeindex($dir)
1488 $w conf -state normal
1489 $w image configure a:$ix -image tri-dn
1490 $w mark set e:$ix s:$ix
1491 $w mark gravity e:$ix right
1494 set n [llength $treecontents($dir)]
1495 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1498 incr treeheight($x) $n
1500 foreach e $treecontents($dir) {
1502 if {[string index $e end] eq "/"} {
1503 set iy $treeindex($de)
1504 $w mark set d:$iy e:$ix
1505 $w mark gravity d:$iy left
1506 $w insert e:$ix $str
1507 set treediropen($de) 0
1508 $w image create e:$ix -align center -image tri-rt -padx 1 \
1510 $w insert e:$ix $e [highlight_tag $de]
1511 $w mark set s:$iy e:$ix
1512 $w mark gravity s:$iy left
1513 set treeheight($de) 1
1515 $w insert e:$ix $str
1516 $w insert e:$ix $e [highlight_tag $de]
1519 $w mark gravity e:$ix left
1520 $w conf -state disabled
1521 set treediropen($dir) 1
1522 set top [lindex [split [$w index @0,0] .] 0]
1523 set ht [$w cget -height]
1524 set l [lindex [split [$w index s:$ix] .] 0]
1527 } elseif {$l + $n + 1 > $top + $ht} {
1528 set top [expr {$l + $n + 2 - $ht}]
1536 proc treeclick {w x y} {
1537 global treediropen cmitmode ctext cflist cflist_top
1539 if {$cmitmode ne "tree"} return
1540 if {![info exists cflist_top]} return
1541 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1542 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1543 $cflist tag add highlight $l.0 "$l.0 lineend"
1549 set e [linetoelt $l]
1550 if {[string index $e end] ne "/"} {
1552 } elseif {$treediropen($e)} {
1559 proc setfilelist {id} {
1560 global treefilelist cflist
1562 treeview $cflist $treefilelist($id) 0
1565 image create bitmap tri-rt -background black -foreground blue -data {
1566 #define tri-rt_width 13
1567 #define tri-rt_height 13
1568 static unsigned char tri-rt_bits[] = {
1569 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1570 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1573 #define tri-rt-mask_width 13
1574 #define tri-rt-mask_height 13
1575 static unsigned char tri-rt-mask_bits[] = {
1576 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1577 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1580 image create bitmap tri-dn -background black -foreground blue -data {
1581 #define tri-dn_width 13
1582 #define tri-dn_height 13
1583 static unsigned char tri-dn_bits[] = {
1584 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1585 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1588 #define tri-dn-mask_width 13
1589 #define tri-dn-mask_height 13
1590 static unsigned char tri-dn-mask_bits[] = {
1591 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1592 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1596 image create bitmap reficon-T -background black -foreground yellow -data {
1597 #define tagicon_width 13
1598 #define tagicon_height 9
1599 static unsigned char tagicon_bits[] = {
1600 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1601 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1603 #define tagicon-mask_width 13
1604 #define tagicon-mask_height 9
1605 static unsigned char tagicon-mask_bits[] = {
1606 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1607 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1610 #define headicon_width 13
1611 #define headicon_height 9
1612 static unsigned char headicon_bits[] = {
1613 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1614 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1617 #define headicon-mask_width 13
1618 #define headicon-mask_height 9
1619 static unsigned char headicon-mask_bits[] = {
1620 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1621 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1623 image create bitmap reficon-H -background black -foreground green \
1624 -data $rectdata -maskdata $rectmask
1625 image create bitmap reficon-o -background black -foreground "#ddddff" \
1626 -data $rectdata -maskdata $rectmask
1628 proc init_flist {first} {
1629 global cflist cflist_top selectedline difffilestart
1631 $cflist conf -state normal
1632 $cflist delete 0.0 end
1634 $cflist insert end $first
1636 $cflist tag add highlight 1.0 "1.0 lineend"
1638 catch {unset cflist_top}
1640 $cflist conf -state disabled
1641 set difffilestart {}
1644 proc highlight_tag {f} {
1645 global highlight_paths
1647 foreach p $highlight_paths {
1648 if {[string match $p $f]} {
1655 proc highlight_filelist {} {
1656 global cmitmode cflist
1658 $cflist conf -state normal
1659 if {$cmitmode ne "tree"} {
1660 set end [lindex [split [$cflist index end] .] 0]
1661 for {set l 2} {$l < $end} {incr l} {
1662 set line [$cflist get $l.0 "$l.0 lineend"]
1663 if {[highlight_tag $line] ne {}} {
1664 $cflist tag add bold $l.0 "$l.0 lineend"
1670 $cflist conf -state disabled
1673 proc unhighlight_filelist {} {
1676 $cflist conf -state normal
1677 $cflist tag remove bold 1.0 end
1678 $cflist conf -state disabled
1681 proc add_flist {fl} {
1684 $cflist conf -state normal
1686 $cflist insert end "\n"
1687 $cflist insert end $f [highlight_tag $f]
1689 $cflist conf -state disabled
1692 proc sel_flist {w x y} {
1693 global ctext difffilestart cflist cflist_top cmitmode
1695 if {$cmitmode eq "tree"} return
1696 if {![info exists cflist_top]} return
1697 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1698 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1699 $cflist tag add highlight $l.0 "$l.0 lineend"
1704 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1708 proc pop_flist_menu {w X Y x y} {
1709 global ctext cflist cmitmode flist_menu flist_menu_file
1710 global treediffs diffids
1713 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1715 if {$cmitmode eq "tree"} {
1716 set e [linetoelt $l]
1717 if {[string index $e end] eq "/"} return
1719 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1721 set flist_menu_file $e
1722 tk_popup $flist_menu $X $Y
1725 proc flist_hl {only} {
1726 global flist_menu_file findstring gdttype
1728 set x [shellquote $flist_menu_file]
1729 if {$only || $findstring eq {} || $gdttype ne "touching paths:"} {
1732 append findstring " " $x
1734 set gdttype "touching paths:"
1737 # Functions for adding and removing shell-type quoting
1739 proc shellquote {str} {
1740 if {![string match "*\['\"\\ \t]*" $str]} {
1743 if {![string match "*\['\"\\]*" $str]} {
1746 if {![string match "*'*" $str]} {
1749 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1752 proc shellarglist {l} {
1758 append str [shellquote $a]
1763 proc shelldequote {str} {
1768 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1769 append ret [string range $str $used end]
1770 set used [string length $str]
1773 set first [lindex $first 0]
1774 set ch [string index $str $first]
1775 if {$first > $used} {
1776 append ret [string range $str $used [expr {$first - 1}]]
1779 if {$ch eq " " || $ch eq "\t"} break
1782 set first [string first "'" $str $used]
1784 error "unmatched single-quote"
1786 append ret [string range $str $used [expr {$first - 1}]]
1791 if {$used >= [string length $str]} {
1792 error "trailing backslash"
1794 append ret [string index $str $used]
1799 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1800 error "unmatched double-quote"
1802 set first [lindex $first 0]
1803 set ch [string index $str $first]
1804 if {$first > $used} {
1805 append ret [string range $str $used [expr {$first - 1}]]
1808 if {$ch eq "\""} break
1810 append ret [string index $str $used]
1814 return [list $used $ret]
1817 proc shellsplit {str} {
1820 set str [string trimleft $str]
1821 if {$str eq {}} break
1822 set dq [shelldequote $str]
1823 set n [lindex $dq 0]
1824 set word [lindex $dq 1]
1825 set str [string range $str $n end]
1831 # Code to implement multiple views
1833 proc newview {ishighlight} {
1834 global nextviewnum newviewname newviewperm uifont newishighlight
1835 global newviewargs revtreeargs
1837 set newishighlight $ishighlight
1839 if {[winfo exists $top]} {
1843 set newviewname($nextviewnum) "View $nextviewnum"
1844 set newviewperm($nextviewnum) 0
1845 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1846 vieweditor $top $nextviewnum "Gitk view definition"
1851 global viewname viewperm newviewname newviewperm
1852 global viewargs newviewargs
1854 set top .gitkvedit-$curview
1855 if {[winfo exists $top]} {
1859 set newviewname($curview) $viewname($curview)
1860 set newviewperm($curview) $viewperm($curview)
1861 set newviewargs($curview) [shellarglist $viewargs($curview)]
1862 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1865 proc vieweditor {top n title} {
1866 global newviewname newviewperm viewfiles
1870 wm title $top $title
1871 label $top.nl -text "Name" -font $uifont
1872 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1873 grid $top.nl $top.name -sticky w -pady 5
1874 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1876 grid $top.perm - -pady 5 -sticky w
1877 message $top.al -aspect 1000 -font $uifont \
1878 -text "Commits to include (arguments to git rev-list):"
1879 grid $top.al - -sticky w -pady 5
1880 entry $top.args -width 50 -textvariable newviewargs($n) \
1881 -background white -font $uifont
1882 grid $top.args - -sticky ew -padx 5
1883 message $top.l -aspect 1000 -font $uifont \
1884 -text "Enter files and directories to include, one per line:"
1885 grid $top.l - -sticky w
1886 text $top.t -width 40 -height 10 -background white -font $uifont
1887 if {[info exists viewfiles($n)]} {
1888 foreach f $viewfiles($n) {
1889 $top.t insert end $f
1890 $top.t insert end "\n"
1892 $top.t delete {end - 1c} end
1893 $top.t mark set insert 0.0
1895 grid $top.t - -sticky ew -padx 5
1897 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1899 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1901 grid $top.buts.ok $top.buts.can
1902 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1903 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1904 grid $top.buts - -pady 10 -sticky ew
1908 proc doviewmenu {m first cmd op argv} {
1909 set nmenu [$m index end]
1910 for {set i $first} {$i <= $nmenu} {incr i} {
1911 if {[$m entrycget $i -command] eq $cmd} {
1912 eval $m $op $i $argv
1918 proc allviewmenus {n op args} {
1921 doviewmenu .bar.view 5 [list showview $n] $op $args
1922 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1925 proc newviewok {top n} {
1926 global nextviewnum newviewperm newviewname newishighlight
1927 global viewname viewfiles viewperm selectedview curview
1928 global viewargs newviewargs viewhlmenu
1931 set newargs [shellsplit $newviewargs($n)]
1933 error_popup "Error in commit selection arguments: $err"
1939 foreach f [split [$top.t get 0.0 end] "\n"] {
1940 set ft [string trim $f]
1945 if {![info exists viewfiles($n)]} {
1946 # creating a new view
1948 set viewname($n) $newviewname($n)
1949 set viewperm($n) $newviewperm($n)
1950 set viewfiles($n) $files
1951 set viewargs($n) $newargs
1953 if {!$newishighlight} {
1956 run addvhighlight $n
1959 # editing an existing view
1960 set viewperm($n) $newviewperm($n)
1961 if {$newviewname($n) ne $viewname($n)} {
1962 set viewname($n) $newviewname($n)
1963 doviewmenu .bar.view 5 [list showview $n] \
1964 entryconf [list -label $viewname($n)]
1965 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1966 # entryconf [list -label $viewname($n) -value $viewname($n)]
1968 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1969 set viewfiles($n) $files
1970 set viewargs($n) $newargs
1971 if {$curview == $n} {
1976 catch {destroy $top}
1980 global curview viewdata viewperm hlview selectedhlview
1982 if {$curview == 0} return
1983 if {[info exists hlview] && $hlview == $curview} {
1984 set selectedhlview None
1987 allviewmenus $curview delete
1988 set viewdata($curview) {}
1989 set viewperm($curview) 0
1993 proc addviewmenu {n} {
1994 global viewname viewhlmenu
1996 .bar.view add radiobutton -label $viewname($n) \
1997 -command [list showview $n] -variable selectedview -value $n
1998 #$viewhlmenu add radiobutton -label $viewname($n) \
1999 # -command [list addvhighlight $n] -variable selectedhlview
2002 proc flatten {var} {
2006 foreach i [array names $var] {
2007 lappend ret $i [set $var\($i\)]
2012 proc unflatten {var l} {
2022 global curview viewdata viewfiles
2023 global displayorder parentlist rowidlist rowisopt rowfinal
2024 global colormap rowtextx commitrow nextcolor canvxmax
2025 global numcommits commitlisted
2026 global selectedline currentid canv canvy0
2028 global pending_select phase
2031 global selectedview selectfirst
2032 global vparentlist vdisporder vcmitlisted
2033 global hlview selectedhlview commitinterest
2035 if {$n == $curview} return
2037 if {[info exists selectedline]} {
2038 set selid $currentid
2039 set y [yc $selectedline]
2040 set ymax [lindex [$canv cget -scrollregion] 3]
2041 set span [$canv yview]
2042 set ytop [expr {[lindex $span 0] * $ymax}]
2043 set ybot [expr {[lindex $span 1] * $ymax}]
2044 if {$ytop < $y && $y < $ybot} {
2045 set yscreen [expr {$y - $ytop}]
2047 set yscreen [expr {($ybot - $ytop) / 2}]
2049 } elseif {[info exists pending_select]} {
2050 set selid $pending_select
2051 unset pending_select
2055 if {$curview >= 0} {
2056 set vparentlist($curview) $parentlist
2057 set vdisporder($curview) $displayorder
2058 set vcmitlisted($curview) $commitlisted
2060 ![info exists viewdata($curview)] ||
2061 [lindex $viewdata($curview) 0] ne {}} {
2062 set viewdata($curview) \
2063 [list $phase $rowidlist $rowisopt $rowfinal]
2066 catch {unset treediffs}
2068 if {[info exists hlview] && $hlview == $n} {
2070 set selectedhlview None
2072 catch {unset commitinterest}
2076 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2077 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2080 if {![info exists viewdata($n)]} {
2082 set pending_select $selid
2089 set phase [lindex $v 0]
2090 set displayorder $vdisporder($n)
2091 set parentlist $vparentlist($n)
2092 set commitlisted $vcmitlisted($n)
2093 set rowidlist [lindex $v 1]
2094 set rowisopt [lindex $v 2]
2095 set rowfinal [lindex $v 3]
2096 set numcommits $commitidx($n)
2098 catch {unset colormap}
2099 catch {unset rowtextx}
2101 set canvxmax [$canv cget -width]
2108 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2109 set row $commitrow($n,$selid)
2110 # try to get the selected row in the same position on the screen
2111 set ymax [lindex [$canv cget -scrollregion] 3]
2112 set ytop [expr {[yc $row] - $yscreen}]
2116 set yf [expr {$ytop * 1.0 / $ymax}]
2118 allcanvs yview moveto $yf
2122 } elseif {$selid ne {}} {
2123 set pending_select $selid
2125 set row [first_real_row]
2126 if {$row < $numcommits} {
2133 if {$phase eq "getcommits"} {
2134 show_status "Reading commits..."
2137 } elseif {$numcommits == 0} {
2138 show_status "No commits selected"
2142 # Stuff relating to the highlighting facility
2144 proc ishighlighted {row} {
2145 global vhighlights fhighlights nhighlights rhighlights
2147 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2148 return $nhighlights($row)
2150 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2151 return $vhighlights($row)
2153 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2154 return $fhighlights($row)
2156 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2157 return $rhighlights($row)
2162 proc bolden {row font} {
2163 global canv linehtag selectedline boldrows
2165 lappend boldrows $row
2166 $canv itemconf $linehtag($row) -font $font
2167 if {[info exists selectedline] && $row == $selectedline} {
2169 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2170 -outline {{}} -tags secsel \
2171 -fill [$canv cget -selectbackground]]
2176 proc bolden_name {row font} {
2177 global canv2 linentag selectedline boldnamerows
2179 lappend boldnamerows $row
2180 $canv2 itemconf $linentag($row) -font $font
2181 if {[info exists selectedline] && $row == $selectedline} {
2182 $canv2 delete secsel
2183 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2184 -outline {{}} -tags secsel \
2185 -fill [$canv2 cget -selectbackground]]
2191 global mainfont boldrows
2194 foreach row $boldrows {
2195 if {![ishighlighted $row]} {
2196 bolden $row $mainfont
2198 lappend stillbold $row
2201 set boldrows $stillbold
2204 proc addvhighlight {n} {
2205 global hlview curview viewdata vhl_done vhighlights commitidx
2207 if {[info exists hlview]} {
2211 if {$n != $curview && ![info exists viewdata($n)]} {
2212 set viewdata($n) [list getcommits {{}} 0 0 0]
2213 set vparentlist($n) {}
2214 set vdisporder($n) {}
2215 set vcmitlisted($n) {}
2218 set vhl_done $commitidx($hlview)
2219 if {$vhl_done > 0} {
2224 proc delvhighlight {} {
2225 global hlview vhighlights
2227 if {![info exists hlview]} return
2229 catch {unset vhighlights}
2233 proc vhighlightmore {} {
2234 global hlview vhl_done commitidx vhighlights
2235 global displayorder vdisporder curview mainfont
2237 set font [concat $mainfont bold]
2238 set max $commitidx($hlview)
2239 if {$hlview == $curview} {
2240 set disp $displayorder
2242 set disp $vdisporder($hlview)
2244 set vr [visiblerows]
2245 set r0 [lindex $vr 0]
2246 set r1 [lindex $vr 1]
2247 for {set i $vhl_done} {$i < $max} {incr i} {
2248 set id [lindex $disp $i]
2249 if {[info exists commitrow($curview,$id)]} {
2250 set row $commitrow($curview,$id)
2251 if {$r0 <= $row && $row <= $r1} {
2252 if {![highlighted $row]} {
2255 set vhighlights($row) 1
2262 proc askvhighlight {row id} {
2263 global hlview vhighlights commitrow iddrawn mainfont
2265 if {[info exists commitrow($hlview,$id)]} {
2266 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2267 bolden $row [concat $mainfont bold]
2269 set vhighlights($row) 1
2271 set vhighlights($row) 0
2275 proc hfiles_change {} {
2276 global highlight_files filehighlight fhighlights fh_serial
2277 global mainfont highlight_paths gdttype
2279 if {[info exists filehighlight]} {
2280 # delete previous highlights
2281 catch {close $filehighlight}
2283 catch {unset fhighlights}
2285 unhighlight_filelist
2287 set highlight_paths {}
2288 after cancel do_file_hl $fh_serial
2290 if {$highlight_files ne {}} {
2291 after 300 do_file_hl $fh_serial
2295 proc gdttype_change {name ix op} {
2296 global gdttype highlight_files findstring findpattern
2299 if {$findstring ne {}} {
2300 if {$gdttype eq "containing:"} {
2301 if {$highlight_files ne {}} {
2302 set highlight_files {}
2307 if {$findpattern ne {}} {
2311 set highlight_files $findstring
2316 # enable/disable findtype/findloc menus too
2319 proc find_change {name ix op} {
2320 global gdttype findstring highlight_files
2323 if {$gdttype eq "containing:"} {
2326 if {$highlight_files ne $findstring} {
2327 set highlight_files $findstring
2334 proc findcom_change {} {
2335 global nhighlights mainfont boldnamerows
2336 global findpattern findtype findstring gdttype
2339 # delete previous highlights, if any
2340 foreach row $boldnamerows {
2341 bolden_name $row $mainfont
2344 catch {unset nhighlights}
2347 if {$gdttype ne "containing:" || $findstring eq {}} {
2349 } elseif {$findtype eq "Regexp"} {
2350 set findpattern $findstring
2352 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2354 set findpattern "*$e*"
2358 proc makepatterns {l} {
2361 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2362 if {[string index $ee end] eq "/"} {
2372 proc do_file_hl {serial} {
2373 global highlight_files filehighlight highlight_paths gdttype fhl_list
2375 if {$gdttype eq "touching paths:"} {
2376 if {[catch {set paths [shellsplit $highlight_files]}]} return
2377 set highlight_paths [makepatterns $paths]
2379 set gdtargs [concat -- $paths]
2380 } elseif {$gdttype eq "adding/removing string:"} {
2381 set gdtargs [list "-S$highlight_files"]
2383 # must be "containing:", i.e. we're searching commit info
2386 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2387 set filehighlight [open $cmd r+]
2388 fconfigure $filehighlight -blocking 0
2389 filerun $filehighlight readfhighlight
2395 proc flushhighlights {} {
2396 global filehighlight fhl_list
2398 if {[info exists filehighlight]} {
2400 puts $filehighlight ""
2401 flush $filehighlight
2405 proc askfilehighlight {row id} {
2406 global filehighlight fhighlights fhl_list
2408 lappend fhl_list $id
2409 set fhighlights($row) -1
2410 puts $filehighlight $id
2413 proc readfhighlight {} {
2414 global filehighlight fhighlights commitrow curview mainfont iddrawn
2415 global fhl_list find_dirn
2417 if {![info exists filehighlight]} {
2421 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2422 set line [string trim $line]
2423 set i [lsearch -exact $fhl_list $line]
2424 if {$i < 0} continue
2425 for {set j 0} {$j < $i} {incr j} {
2426 set id [lindex $fhl_list $j]
2427 if {[info exists commitrow($curview,$id)]} {
2428 set fhighlights($commitrow($curview,$id)) 0
2431 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2432 if {$line eq {}} continue
2433 if {![info exists commitrow($curview,$line)]} continue
2434 set row $commitrow($curview,$line)
2435 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2436 bolden $row [concat $mainfont bold]
2438 set fhighlights($row) 1
2440 if {[eof $filehighlight]} {
2442 puts "oops, git diff-tree died"
2443 catch {close $filehighlight}
2447 if {[info exists find_dirn]} {
2448 if {$find_dirn > 0} {
2457 proc doesmatch {f} {
2458 global findtype findpattern
2460 if {$findtype eq "Regexp"} {
2461 return [regexp $findpattern $f]
2462 } elseif {$findtype eq "IgnCase"} {
2463 return [string match -nocase $findpattern $f]
2465 return [string match $findpattern $f]
2469 proc askfindhighlight {row id} {
2470 global nhighlights commitinfo iddrawn mainfont
2472 global markingmatches
2474 if {![info exists commitinfo($id)]} {
2477 set info $commitinfo($id)
2479 set fldtypes {Headline Author Date Committer CDate Comments}
2480 foreach f $info ty $fldtypes {
2481 if {($findloc eq "All fields" || $findloc eq $ty) &&
2483 if {$ty eq "Author"} {
2490 if {$isbold && [info exists iddrawn($id)]} {
2491 set f [concat $mainfont bold]
2492 if {![ishighlighted $row]} {
2498 if {$markingmatches} {
2499 markrowmatches $row $id
2502 set nhighlights($row) $isbold
2505 proc markrowmatches {row id} {
2506 global canv canv2 linehtag linentag commitinfo findloc
2508 set headline [lindex $commitinfo($id) 0]
2509 set author [lindex $commitinfo($id) 1]
2510 $canv delete match$row
2511 $canv2 delete match$row
2512 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2513 set m [findmatches $headline]
2515 markmatches $canv $row $headline $linehtag($row) $m \
2516 [$canv itemcget $linehtag($row) -font] $row
2519 if {$findloc eq "All fields" || $findloc eq "Author"} {
2520 set m [findmatches $author]
2522 markmatches $canv2 $row $author $linentag($row) $m \
2523 [$canv2 itemcget $linentag($row) -font] $row
2528 proc vrel_change {name ix op} {
2529 global highlight_related
2532 if {$highlight_related ne "None"} {
2537 # prepare for testing whether commits are descendents or ancestors of a
2538 proc rhighlight_sel {a} {
2539 global descendent desc_todo ancestor anc_todo
2540 global highlight_related rhighlights
2542 catch {unset descendent}
2543 set desc_todo [list $a]
2544 catch {unset ancestor}
2545 set anc_todo [list $a]
2546 if {$highlight_related ne "None"} {
2552 proc rhighlight_none {} {
2555 catch {unset rhighlights}
2559 proc is_descendent {a} {
2560 global curview children commitrow descendent desc_todo
2563 set la $commitrow($v,$a)
2567 for {set i 0} {$i < [llength $todo]} {incr i} {
2568 set do [lindex $todo $i]
2569 if {$commitrow($v,$do) < $la} {
2570 lappend leftover $do
2573 foreach nk $children($v,$do) {
2574 if {![info exists descendent($nk)]} {
2575 set descendent($nk) 1
2583 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2587 set descendent($a) 0
2588 set desc_todo $leftover
2591 proc is_ancestor {a} {
2592 global curview parentlist commitrow ancestor anc_todo
2595 set la $commitrow($v,$a)
2599 for {set i 0} {$i < [llength $todo]} {incr i} {
2600 set do [lindex $todo $i]
2601 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2602 lappend leftover $do
2605 foreach np [lindex $parentlist $commitrow($v,$do)] {
2606 if {![info exists ancestor($np)]} {
2615 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2620 set anc_todo $leftover
2623 proc askrelhighlight {row id} {
2624 global descendent highlight_related iddrawn mainfont rhighlights
2625 global selectedline ancestor
2627 if {![info exists selectedline]} return
2629 if {$highlight_related eq "Descendent" ||
2630 $highlight_related eq "Not descendent"} {
2631 if {![info exists descendent($id)]} {
2634 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2637 } elseif {$highlight_related eq "Ancestor" ||
2638 $highlight_related eq "Not ancestor"} {
2639 if {![info exists ancestor($id)]} {
2642 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2646 if {[info exists iddrawn($id)]} {
2647 if {$isbold && ![ishighlighted $row]} {
2648 bolden $row [concat $mainfont bold]
2651 set rhighlights($row) $isbold
2654 # Graph layout functions
2656 proc shortids {ids} {
2659 if {[llength $id] > 1} {
2660 lappend res [shortids $id]
2661 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2662 lappend res [string range $id 0 7]
2673 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2674 if {($n & $mask) != 0} {
2675 set ret [concat $ret $o]
2677 set o [concat $o $o]
2682 # Work out where id should go in idlist so that order-token
2683 # values increase from left to right
2684 proc idcol {idlist id {i 0}} {
2685 global ordertok curview
2687 set t $ordertok($curview,$id)
2688 if {$i >= [llength $idlist] ||
2689 $t < $ordertok($curview,[lindex $idlist $i])} {
2690 if {$i > [llength $idlist]} {
2691 set i [llength $idlist]
2693 while {[incr i -1] >= 0 &&
2694 $t < $ordertok($curview,[lindex $idlist $i])} {}
2697 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2698 while {[incr i] < [llength $idlist] &&
2699 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2705 proc initlayout {} {
2706 global rowidlist rowisopt rowfinal displayorder commitlisted
2707 global numcommits canvxmax canv
2710 global colormap rowtextx
2721 set canvxmax [$canv cget -width]
2722 catch {unset colormap}
2723 catch {unset rowtextx}
2727 proc setcanvscroll {} {
2728 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2730 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2731 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2732 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2733 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2736 proc visiblerows {} {
2737 global canv numcommits linespc
2739 set ymax [lindex [$canv cget -scrollregion] 3]
2740 if {$ymax eq {} || $ymax == 0} return
2742 set y0 [expr {int([lindex $f 0] * $ymax)}]
2743 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2747 set y1 [expr {int([lindex $f 1] * $ymax)}]
2748 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2749 if {$r1 >= $numcommits} {
2750 set r1 [expr {$numcommits - 1}]
2752 return [list $r0 $r1]
2755 proc layoutmore {} {
2756 global commitidx viewcomplete numcommits
2757 global uparrowlen downarrowlen mingaplen curview
2759 set show $commitidx($curview)
2760 if {$show > $numcommits} {
2761 showstuff $show $viewcomplete($curview)
2765 proc showstuff {canshow last} {
2766 global numcommits commitrow pending_select selectedline curview
2767 global mainheadid displayorder selectfirst
2768 global lastscrollset commitinterest
2770 if {$numcommits == 0} {
2772 set phase "incrdraw"
2776 set prev $numcommits
2777 set numcommits $canshow
2778 set t [clock clicks -milliseconds]
2779 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2780 set lastscrollset $t
2783 set rows [visiblerows]
2784 set r1 [lindex $rows 1]
2785 if {$r1 >= $canshow} {
2786 set r1 [expr {$canshow - 1}]
2791 if {[info exists pending_select] &&
2792 [info exists commitrow($curview,$pending_select)] &&
2793 $commitrow($curview,$pending_select) < $numcommits} {
2794 selectline $commitrow($curview,$pending_select) 1
2797 if {[info exists selectedline] || [info exists pending_select]} {
2800 set l [first_real_row]
2807 proc doshowlocalchanges {} {
2808 global curview mainheadid phase commitrow
2810 if {[info exists commitrow($curview,$mainheadid)] &&
2811 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2813 } elseif {$phase ne {}} {
2814 lappend commitinterest($mainheadid) {}
2818 proc dohidelocalchanges {} {
2819 global localfrow localirow lserial
2821 if {$localfrow >= 0} {
2822 removerow $localfrow
2824 if {$localirow > 0} {
2828 if {$localirow >= 0} {
2829 removerow $localirow
2835 # spawn off a process to do git diff-index --cached HEAD
2836 proc dodiffindex {} {
2837 global localirow localfrow lserial showlocalchanges
2839 if {!$showlocalchanges} return
2843 set fd [open "|git diff-index --cached HEAD" r]
2844 fconfigure $fd -blocking 0
2845 filerun $fd [list readdiffindex $fd $lserial]
2848 proc readdiffindex {fd serial} {
2849 global localirow commitrow mainheadid nullid2 curview
2850 global commitinfo commitdata lserial
2853 if {[gets $fd line] < 0} {
2859 # we only need to see one line and we don't really care what it says...
2862 # now see if there are any local changes not checked in to the index
2863 if {$serial == $lserial} {
2864 set fd [open "|git diff-files" r]
2865 fconfigure $fd -blocking 0
2866 filerun $fd [list readdifffiles $fd $serial]
2869 if {$isdiff && $serial == $lserial && $localirow == -1} {
2870 # add the line for the changes in the index to the graph
2871 set localirow $commitrow($curview,$mainheadid)
2872 set hl "Local changes checked in to index but not committed"
2873 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2874 set commitdata($nullid2) "\n $hl\n"
2875 insertrow $localirow $nullid2
2880 proc readdifffiles {fd serial} {
2881 global localirow localfrow commitrow mainheadid nullid curview
2882 global commitinfo commitdata lserial
2885 if {[gets $fd line] < 0} {
2891 # we only need to see one line and we don't really care what it says...
2894 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2895 # add the line for the local diff to the graph
2896 if {$localirow >= 0} {
2897 set localfrow $localirow
2900 set localfrow $commitrow($curview,$mainheadid)
2902 set hl "Local uncommitted changes, not checked in to index"
2903 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2904 set commitdata($nullid) "\n $hl\n"
2905 insertrow $localfrow $nullid
2910 proc nextuse {id row} {
2911 global commitrow curview children
2913 if {[info exists children($curview,$id)]} {
2914 foreach kid $children($curview,$id) {
2915 if {![info exists commitrow($curview,$kid)]} {
2918 if {$commitrow($curview,$kid) > $row} {
2919 return $commitrow($curview,$kid)
2923 if {[info exists commitrow($curview,$id)]} {
2924 return $commitrow($curview,$id)
2929 proc prevuse {id row} {
2930 global commitrow curview children
2933 if {[info exists children($curview,$id)]} {
2934 foreach kid $children($curview,$id) {
2935 if {![info exists commitrow($curview,$kid)]} break
2936 if {$commitrow($curview,$kid) < $row} {
2937 set ret $commitrow($curview,$kid)
2944 proc make_idlist {row} {
2945 global displayorder parentlist uparrowlen downarrowlen mingaplen
2946 global commitidx curview ordertok children commitrow
2948 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2952 set ra [expr {$row - $downarrowlen}]
2956 set rb [expr {$row + $uparrowlen}]
2957 if {$rb > $commitidx($curview)} {
2958 set rb $commitidx($curview)
2961 for {} {$r < $ra} {incr r} {
2962 set nextid [lindex $displayorder [expr {$r + 1}]]
2963 foreach p [lindex $parentlist $r] {
2964 if {$p eq $nextid} continue
2965 set rn [nextuse $p $r]
2967 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2968 lappend ids [list $ordertok($curview,$p) $p]
2972 for {} {$r < $row} {incr r} {
2973 set nextid [lindex $displayorder [expr {$r + 1}]]
2974 foreach p [lindex $parentlist $r] {
2975 if {$p eq $nextid} continue
2976 set rn [nextuse $p $r]
2977 if {$rn < 0 || $rn >= $row} {
2978 lappend ids [list $ordertok($curview,$p) $p]
2982 set id [lindex $displayorder $row]
2983 lappend ids [list $ordertok($curview,$id) $id]
2985 foreach p [lindex $parentlist $r] {
2986 set firstkid [lindex $children($curview,$p) 0]
2987 if {$commitrow($curview,$firstkid) < $row} {
2988 lappend ids [list $ordertok($curview,$p) $p]
2992 set id [lindex $displayorder $r]
2994 set firstkid [lindex $children($curview,$id) 0]
2995 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
2996 lappend ids [list $ordertok($curview,$id) $id]
3001 foreach idx [lsort -unique $ids] {
3002 lappend idlist [lindex $idx 1]
3007 proc rowsequal {a b} {
3008 while {[set i [lsearch -exact $a {}]] >= 0} {
3009 set a [lreplace $a $i $i]
3011 while {[set i [lsearch -exact $b {}]] >= 0} {
3012 set b [lreplace $b $i $i]
3014 return [expr {$a eq $b}]
3017 proc makeupline {id row rend col} {
3018 global rowidlist uparrowlen downarrowlen mingaplen
3020 for {set r $rend} {1} {set r $rstart} {
3021 set rstart [prevuse $id $r]
3022 if {$rstart < 0} return
3023 if {$rstart < $row} break
3025 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3026 set rstart [expr {$rend - $uparrowlen - 1}]
3028 for {set r $rstart} {[incr r] <= $row} {} {
3029 set idlist [lindex $rowidlist $r]
3030 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3031 set col [idcol $idlist $id $col]
3032 lset rowidlist $r [linsert $idlist $col $id]
3038 proc layoutrows {row endrow} {
3039 global rowidlist rowisopt rowfinal displayorder
3040 global uparrowlen downarrowlen maxwidth mingaplen
3041 global children parentlist
3042 global commitidx viewcomplete curview commitrow
3046 set rm1 [expr {$row - 1}]
3047 foreach id [lindex $rowidlist $rm1] {
3052 set final [lindex $rowfinal $rm1]
3054 for {} {$row < $endrow} {incr row} {
3055 set rm1 [expr {$row - 1}]
3056 if {$rm1 < 0 || $idlist eq {}} {
3057 set idlist [make_idlist $row]
3060 set id [lindex $displayorder $rm1]
3061 set col [lsearch -exact $idlist $id]
3062 set idlist [lreplace $idlist $col $col]
3063 foreach p [lindex $parentlist $rm1] {
3064 if {[lsearch -exact $idlist $p] < 0} {
3065 set col [idcol $idlist $p $col]
3066 set idlist [linsert $idlist $col $p]
3067 # if not the first child, we have to insert a line going up
3068 if {$id ne [lindex $children($curview,$p) 0]} {
3069 makeupline $p $rm1 $row $col
3073 set id [lindex $displayorder $row]
3074 if {$row > $downarrowlen} {
3075 set termrow [expr {$row - $downarrowlen - 1}]
3076 foreach p [lindex $parentlist $termrow] {
3077 set i [lsearch -exact $idlist $p]
3078 if {$i < 0} continue
3079 set nr [nextuse $p $termrow]
3080 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3081 set idlist [lreplace $idlist $i $i]
3085 set col [lsearch -exact $idlist $id]
3087 set col [idcol $idlist $id]
3088 set idlist [linsert $idlist $col $id]
3089 if {$children($curview,$id) ne {}} {
3090 makeupline $id $rm1 $row $col
3093 set r [expr {$row + $uparrowlen - 1}]
3094 if {$r < $commitidx($curview)} {
3096 foreach p [lindex $parentlist $r] {
3097 if {[lsearch -exact $idlist $p] >= 0} continue
3098 set fk [lindex $children($curview,$p) 0]
3099 if {$commitrow($curview,$fk) < $row} {
3100 set x [idcol $idlist $p $x]
3101 set idlist [linsert $idlist $x $p]
3104 if {[incr r] < $commitidx($curview)} {
3105 set p [lindex $displayorder $r]
3106 if {[lsearch -exact $idlist $p] < 0} {
3107 set fk [lindex $children($curview,$p) 0]
3108 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3109 set x [idcol $idlist $p $x]
3110 set idlist [linsert $idlist $x $p]
3116 if {$final && !$viewcomplete($curview) &&
3117 $row + $uparrowlen + $mingaplen + $downarrowlen
3118 >= $commitidx($curview)} {
3121 set l [llength $rowidlist]
3123 lappend rowidlist $idlist
3125 lappend rowfinal $final
3126 } elseif {$row < $l} {
3127 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3128 lset rowidlist $row $idlist
3131 lset rowfinal $row $final
3133 set pad [ntimes [expr {$row - $l}] {}]
3134 set rowidlist [concat $rowidlist $pad]
3135 lappend rowidlist $idlist
3136 set rowfinal [concat $rowfinal $pad]
3137 lappend rowfinal $final
3138 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3144 proc changedrow {row} {
3145 global displayorder iddrawn rowisopt need_redisplay
3147 set l [llength $rowisopt]
3149 lset rowisopt $row 0
3150 if {$row + 1 < $l} {
3151 lset rowisopt [expr {$row + 1}] 0
3152 if {$row + 2 < $l} {
3153 lset rowisopt [expr {$row + 2}] 0
3157 set id [lindex $displayorder $row]
3158 if {[info exists iddrawn($id)]} {
3159 set need_redisplay 1
3163 proc insert_pad {row col npad} {
3166 set pad [ntimes $npad {}]
3167 set idlist [lindex $rowidlist $row]
3168 set bef [lrange $idlist 0 [expr {$col - 1}]]
3169 set aft [lrange $idlist $col end]
3170 set i [lsearch -exact $aft {}]
3172 set aft [lreplace $aft $i $i]
3174 lset rowidlist $row [concat $bef $pad $aft]
3178 proc optimize_rows {row col endrow} {
3179 global rowidlist rowisopt displayorder curview children
3184 for {} {$row < $endrow} {incr row; set col 0} {
3185 if {[lindex $rowisopt $row]} continue
3187 set y0 [expr {$row - 1}]
3188 set ym [expr {$row - 2}]
3189 set idlist [lindex $rowidlist $row]
3190 set previdlist [lindex $rowidlist $y0]
3191 if {$idlist eq {} || $previdlist eq {}} continue
3193 set pprevidlist [lindex $rowidlist $ym]
3194 if {$pprevidlist eq {}} continue
3200 for {} {$col < [llength $idlist]} {incr col} {
3201 set id [lindex $idlist $col]
3202 if {[lindex $previdlist $col] eq $id} continue
3207 set x0 [lsearch -exact $previdlist $id]
3208 if {$x0 < 0} continue
3209 set z [expr {$x0 - $col}]
3213 set xm [lsearch -exact $pprevidlist $id]
3215 set z0 [expr {$xm - $x0}]
3219 # if row y0 is the first child of $id then it's not an arrow
3220 if {[lindex $children($curview,$id) 0] ne
3221 [lindex $displayorder $y0]} {
3225 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3226 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3229 # Looking at lines from this row to the previous row,
3230 # make them go straight up if they end in an arrow on
3231 # the previous row; otherwise make them go straight up
3233 if {$z < -1 || ($z < 0 && $isarrow)} {
3234 # Line currently goes left too much;
3235 # insert pads in the previous row, then optimize it
3236 set npad [expr {-1 - $z + $isarrow}]
3237 insert_pad $y0 $x0 $npad
3239 optimize_rows $y0 $x0 $row
3241 set previdlist [lindex $rowidlist $y0]
3242 set x0 [lsearch -exact $previdlist $id]
3243 set z [expr {$x0 - $col}]
3245 set pprevidlist [lindex $rowidlist $ym]
3246 set xm [lsearch -exact $pprevidlist $id]
3247 set z0 [expr {$xm - $x0}]
3249 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3250 # Line currently goes right too much;
3251 # insert pads in this line
3252 set npad [expr {$z - 1 + $isarrow}]
3253 insert_pad $row $col $npad
3254 set idlist [lindex $rowidlist $row]
3256 set z [expr {$x0 - $col}]
3259 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3260 # this line links to its first child on row $row-2
3261 set id [lindex $displayorder $ym]
3262 set xc [lsearch -exact $pprevidlist $id]
3264 set z0 [expr {$xc - $x0}]
3267 # avoid lines jigging left then immediately right
3268 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3269 insert_pad $y0 $x0 1
3271 optimize_rows $y0 $x0 $row
3272 set previdlist [lindex $rowidlist $y0]
3276 # Find the first column that doesn't have a line going right
3277 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3278 set id [lindex $idlist $col]
3279 if {$id eq {}} break
3280 set x0 [lsearch -exact $previdlist $id]
3282 # check if this is the link to the first child
3283 set kid [lindex $displayorder $y0]
3284 if {[lindex $children($curview,$id) 0] eq $kid} {
3285 # it is, work out offset to child
3286 set x0 [lsearch -exact $previdlist $kid]
3289 if {$x0 <= $col} break
3291 # Insert a pad at that column as long as it has a line and
3292 # isn't the last column
3293 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3294 set idlist [linsert $idlist $col {}]
3295 lset rowidlist $row $idlist
3303 global canvx0 linespc
3304 return [expr {$canvx0 + $col * $linespc}]
3308 global canvy0 linespc
3309 return [expr {$canvy0 + $row * $linespc}]
3312 proc linewidth {id} {
3313 global thickerline lthickness
3316 if {[info exists thickerline] && $id eq $thickerline} {
3317 set wid [expr {2 * $lthickness}]
3322 proc rowranges {id} {
3323 global commitrow curview children uparrowlen downarrowlen
3326 set kids $children($curview,$id)
3332 foreach child $kids {
3333 if {![info exists commitrow($curview,$child)]} break
3334 set row $commitrow($curview,$child)
3335 if {![info exists prev]} {
3336 lappend ret [expr {$row + 1}]
3338 if {$row <= $prevrow} {
3339 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3341 # see if the line extends the whole way from prevrow to row
3342 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3343 [lsearch -exact [lindex $rowidlist \
3344 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3345 # it doesn't, see where it ends
3346 set r [expr {$prevrow + $downarrowlen}]
3347 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3348 while {[incr r -1] > $prevrow &&
3349 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3351 while {[incr r] <= $row &&
3352 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3356 # see where it starts up again
3357 set r [expr {$row - $uparrowlen}]
3358 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3359 while {[incr r] < $row &&
3360 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3362 while {[incr r -1] >= $prevrow &&
3363 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3369 if {$child eq $id} {
3378 proc drawlineseg {id row endrow arrowlow} {
3379 global rowidlist displayorder iddrawn linesegs
3380 global canv colormap linespc curview maxlinelen parentlist
3382 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3383 set le [expr {$row + 1}]
3386 set c [lsearch -exact [lindex $rowidlist $le] $id]
3392 set x [lindex $displayorder $le]
3397 if {[info exists iddrawn($x)] || $le == $endrow} {
3398 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3414 if {[info exists linesegs($id)]} {
3415 set lines $linesegs($id)
3417 set r0 [lindex $li 0]
3419 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3429 set li [lindex $lines [expr {$i-1}]]
3430 set r1 [lindex $li 1]
3431 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3436 set x [lindex $cols [expr {$le - $row}]]
3437 set xp [lindex $cols [expr {$le - 1 - $row}]]
3438 set dir [expr {$xp - $x}]
3440 set ith [lindex $lines $i 2]
3441 set coords [$canv coords $ith]
3442 set ah [$canv itemcget $ith -arrow]
3443 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3444 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3445 if {$x2 ne {} && $x - $x2 == $dir} {
3446 set coords [lrange $coords 0 end-2]
3449 set coords [list [xc $le $x] [yc $le]]
3452 set itl [lindex $lines [expr {$i-1}] 2]
3453 set al [$canv itemcget $itl -arrow]
3454 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3455 } elseif {$arrowlow} {
3456 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3457 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3461 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3462 for {set y $le} {[incr y -1] > $row} {} {
3464 set xp [lindex $cols [expr {$y - 1 - $row}]]
3465 set ndir [expr {$xp - $x}]
3466 if {$dir != $ndir || $xp < 0} {
3467 lappend coords [xc $y $x] [yc $y]
3473 # join parent line to first child
3474 set ch [lindex $displayorder $row]
3475 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3477 puts "oops: drawlineseg: child $ch not on row $row"
3478 } elseif {$xc != $x} {
3479 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3480 set d [expr {int(0.5 * $linespc)}]
3483 set x2 [expr {$x1 - $d}]
3485 set x2 [expr {$x1 + $d}]
3488 set y1 [expr {$y2 + $d}]
3489 lappend coords $x1 $y1 $x2 $y2
3490 } elseif {$xc < $x - 1} {
3491 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3492 } elseif {$xc > $x + 1} {
3493 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3497 lappend coords [xc $row $x] [yc $row]
3499 set xn [xc $row $xp]
3501 lappend coords $xn $yn
3505 set t [$canv create line $coords -width [linewidth $id] \
3506 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3509 set lines [linsert $lines $i [list $row $le $t]]
3511 $canv coords $ith $coords
3512 if {$arrow ne $ah} {
3513 $canv itemconf $ith -arrow $arrow
3515 lset lines $i 0 $row
3518 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3519 set ndir [expr {$xo - $xp}]
3520 set clow [$canv coords $itl]
3521 if {$dir == $ndir} {
3522 set clow [lrange $clow 2 end]
3524 set coords [concat $coords $clow]
3526 lset lines [expr {$i-1}] 1 $le
3528 # coalesce two pieces
3530 set b [lindex $lines [expr {$i-1}] 0]
3531 set e [lindex $lines $i 1]
3532 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3534 $canv coords $itl $coords
3535 if {$arrow ne $al} {
3536 $canv itemconf $itl -arrow $arrow
3540 set linesegs($id) $lines
3544 proc drawparentlinks {id row} {
3545 global rowidlist canv colormap curview parentlist
3546 global idpos linespc
3548 set rowids [lindex $rowidlist $row]
3549 set col [lsearch -exact $rowids $id]
3550 if {$col < 0} return
3551 set olds [lindex $parentlist $row]
3552 set row2 [expr {$row + 1}]
3553 set x [xc $row $col]
3556 set d [expr {int(0.5 * $linespc)}]
3557 set ymid [expr {$y + $d}]
3558 set ids [lindex $rowidlist $row2]
3559 # rmx = right-most X coord used
3562 set i [lsearch -exact $ids $p]
3564 puts "oops, parent $p of $id not in list"
3567 set x2 [xc $row2 $i]
3571 set j [lsearch -exact $rowids $p]
3573 # drawlineseg will do this one for us
3577 # should handle duplicated parents here...
3578 set coords [list $x $y]
3580 # if attaching to a vertical segment, draw a smaller
3581 # slant for visual distinctness
3584 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3586 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3588 } elseif {$i < $col && $i < $j} {
3589 # segment slants towards us already
3590 lappend coords [xc $row $j] $y
3592 if {$i < $col - 1} {
3593 lappend coords [expr {$x2 + $linespc}] $y
3594 } elseif {$i > $col + 1} {
3595 lappend coords [expr {$x2 - $linespc}] $y
3597 lappend coords $x2 $y2
3600 lappend coords $x2 $y2
3602 set t [$canv create line $coords -width [linewidth $p] \
3603 -fill $colormap($p) -tags lines.$p]
3607 if {$rmx > [lindex $idpos($id) 1]} {
3608 lset idpos($id) 1 $rmx
3613 proc drawlines {id} {
3616 $canv itemconf lines.$id -width [linewidth $id]
3619 proc drawcmittext {id row col} {
3620 global linespc canv canv2 canv3 canvy0 fgcolor curview
3621 global commitlisted commitinfo rowidlist parentlist
3622 global rowtextx idpos idtags idheads idotherrefs
3623 global linehtag linentag linedtag selectedline
3624 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3626 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3627 set listed [lindex $commitlisted $row]
3628 if {$id eq $nullid} {
3630 } elseif {$id eq $nullid2} {
3633 set ofill [expr {$listed != 0? "blue": "white"}]
3635 set x [xc $row $col]
3637 set orad [expr {$linespc / 3}]
3639 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3640 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3641 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3642 } elseif {$listed == 2} {
3643 # triangle pointing left for left-side commits
3644 set t [$canv create polygon \
3645 [expr {$x - $orad}] $y \
3646 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3647 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3648 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3650 # triangle pointing right for right-side commits
3651 set t [$canv create polygon \
3652 [expr {$x + $orad - 1}] $y \
3653 [expr {$x - $orad}] [expr {$y - $orad}] \
3654 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3655 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3658 $canv bind $t <1> {selcanvline {} %x %y}
3659 set rmx [llength [lindex $rowidlist $row]]
3660 set olds [lindex $parentlist $row]
3662 set nextids [lindex $rowidlist [expr {$row + 1}]]
3664 set i [lsearch -exact $nextids $p]
3670 set xt [xc $row $rmx]
3671 set rowtextx($row) $xt
3672 set idpos($id) [list $x $xt $y]
3673 if {[info exists idtags($id)] || [info exists idheads($id)]
3674 || [info exists idotherrefs($id)]} {
3675 set xt [drawtags $id $x $xt $y]
3677 set headline [lindex $commitinfo($id) 0]
3678 set name [lindex $commitinfo($id) 1]
3679 set date [lindex $commitinfo($id) 2]
3680 set date [formatdate $date]
3683 set isbold [ishighlighted $row]
3685 lappend boldrows $row
3688 lappend boldnamerows $row
3692 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3693 -text $headline -font $font -tags text]
3694 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3695 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3696 -text $name -font $nfont -tags text]
3697 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3698 -text $date -font $mainfont -tags text]
3699 if {[info exists selectedline] && $selectedline == $row} {
3702 set xr [expr {$xt + [font measure $mainfont $headline]}]
3703 if {$xr > $canvxmax} {
3709 proc drawcmitrow {row} {
3710 global displayorder rowidlist nrows_drawn
3711 global iddrawn markingmatches
3712 global commitinfo parentlist numcommits
3713 global filehighlight fhighlights findpattern nhighlights
3714 global hlview vhighlights
3715 global highlight_related rhighlights
3717 if {$row >= $numcommits} return
3719 set id [lindex $displayorder $row]
3720 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3721 askvhighlight $row $id
3723 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3724 askfilehighlight $row $id
3726 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3727 askfindhighlight $row $id
3729 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3730 askrelhighlight $row $id
3732 if {![info exists iddrawn($id)]} {
3733 set col [lsearch -exact [lindex $rowidlist $row] $id]
3735 puts "oops, row $row id $id not in list"
3738 if {![info exists commitinfo($id)]} {
3742 drawcmittext $id $row $col
3746 if {$markingmatches} {
3747 markrowmatches $row $id
3751 proc drawcommits {row {endrow {}}} {
3752 global numcommits iddrawn displayorder curview need_redisplay
3753 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3758 if {$endrow eq {}} {
3761 if {$endrow >= $numcommits} {
3762 set endrow [expr {$numcommits - 1}]
3765 set rl1 [expr {$row - $downarrowlen - 3}]
3769 set ro1 [expr {$row - 3}]
3773 set r2 [expr {$endrow + $uparrowlen + 3}]
3774 if {$r2 > $numcommits} {
3777 for {set r $rl1} {$r < $r2} {incr r} {
3778 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3782 set rl1 [expr {$r + 1}]
3788 optimize_rows $ro1 0 $r2
3789 if {$need_redisplay || $nrows_drawn > 2000} {
3794 # make the lines join to already-drawn rows either side
3795 set r [expr {$row - 1}]
3796 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3799 set er [expr {$endrow + 1}]
3800 if {$er >= $numcommits ||
3801 ![info exists iddrawn([lindex $displayorder $er])]} {
3804 for {} {$r <= $er} {incr r} {
3805 set id [lindex $displayorder $r]
3806 set wasdrawn [info exists iddrawn($id)]
3808 if {$r == $er} break
3809 set nextid [lindex $displayorder [expr {$r + 1}]]
3810 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3811 catch {unset prevlines}
3814 drawparentlinks $id $r
3816 if {[info exists lineends($r)]} {
3817 foreach lid $lineends($r) {
3818 unset prevlines($lid)
3821 set rowids [lindex $rowidlist $r]
3822 foreach lid $rowids {
3823 if {$lid eq {}} continue
3825 # see if this is the first child of any of its parents
3826 foreach p [lindex $parentlist $r] {
3827 if {[lsearch -exact $rowids $p] < 0} {
3828 # make this line extend up to the child
3829 set le [drawlineseg $p $r $er 0]
3830 lappend lineends($le) $p
3834 } elseif {![info exists prevlines($lid)]} {
3835 set le [drawlineseg $lid $r $er 1]
3836 lappend lineends($le) $lid
3837 set prevlines($lid) 1
3843 proc drawfrac {f0 f1} {
3846 set ymax [lindex [$canv cget -scrollregion] 3]
3847 if {$ymax eq {} || $ymax == 0} return
3848 set y0 [expr {int($f0 * $ymax)}]
3849 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3850 set y1 [expr {int($f1 * $ymax)}]
3851 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3852 drawcommits $row $endrow
3855 proc drawvisible {} {
3857 eval drawfrac [$canv yview]
3860 proc clear_display {} {
3861 global iddrawn linesegs need_redisplay nrows_drawn
3862 global vhighlights fhighlights nhighlights rhighlights
3865 catch {unset iddrawn}
3866 catch {unset linesegs}
3867 catch {unset vhighlights}
3868 catch {unset fhighlights}
3869 catch {unset nhighlights}
3870 catch {unset rhighlights}
3871 set need_redisplay 0
3875 proc findcrossings {id} {
3876 global rowidlist parentlist numcommits displayorder
3880 foreach {s e} [rowranges $id] {
3881 if {$e >= $numcommits} {
3882 set e [expr {$numcommits - 1}]
3884 if {$e <= $s} continue
3885 for {set row $e} {[incr row -1] >= $s} {} {
3886 set x [lsearch -exact [lindex $rowidlist $row] $id]
3888 set olds [lindex $parentlist $row]
3889 set kid [lindex $displayorder $row]
3890 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3891 if {$kidx < 0} continue
3892 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3894 set px [lsearch -exact $nextrow $p]
3895 if {$px < 0} continue
3896 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3897 if {[lsearch -exact $ccross $p] >= 0} continue
3898 if {$x == $px + ($kidx < $px? -1: 1)} {
3900 } elseif {[lsearch -exact $cross $p] < 0} {
3907 return [concat $ccross {{}} $cross]
3910 proc assigncolor {id} {
3911 global colormap colors nextcolor
3912 global commitrow parentlist children children curview
3914 if {[info exists colormap($id)]} return
3915 set ncolors [llength $colors]
3916 if {[info exists children($curview,$id)]} {
3917 set kids $children($curview,$id)
3921 if {[llength $kids] == 1} {
3922 set child [lindex $kids 0]
3923 if {[info exists colormap($child)]
3924 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3925 set colormap($id) $colormap($child)
3931 foreach x [findcrossings $id] {
3933 # delimiter between corner crossings and other crossings
3934 if {[llength $badcolors] >= $ncolors - 1} break
3935 set origbad $badcolors
3937 if {[info exists colormap($x)]
3938 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3939 lappend badcolors $colormap($x)
3942 if {[llength $badcolors] >= $ncolors} {
3943 set badcolors $origbad
3945 set origbad $badcolors
3946 if {[llength $badcolors] < $ncolors - 1} {
3947 foreach child $kids {
3948 if {[info exists colormap($child)]
3949 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3950 lappend badcolors $colormap($child)
3952 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3953 if {[info exists colormap($p)]
3954 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3955 lappend badcolors $colormap($p)
3959 if {[llength $badcolors] >= $ncolors} {
3960 set badcolors $origbad
3963 for {set i 0} {$i <= $ncolors} {incr i} {
3964 set c [lindex $colors $nextcolor]
3965 if {[incr nextcolor] >= $ncolors} {
3968 if {[lsearch -exact $badcolors $c]} break
3970 set colormap($id) $c
3973 proc bindline {t id} {
3976 $canv bind $t <Enter> "lineenter %x %y $id"
3977 $canv bind $t <Motion> "linemotion %x %y $id"
3978 $canv bind $t <Leave> "lineleave $id"
3979 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3982 proc drawtags {id x xt y1} {
3983 global idtags idheads idotherrefs mainhead
3984 global linespc lthickness
3985 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3990 if {[info exists idtags($id)]} {
3991 set marks $idtags($id)
3992 set ntags [llength $marks]
3994 if {[info exists idheads($id)]} {
3995 set marks [concat $marks $idheads($id)]
3996 set nheads [llength $idheads($id)]
3998 if {[info exists idotherrefs($id)]} {
3999 set marks [concat $marks $idotherrefs($id)]
4005 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4006 set yt [expr {$y1 - 0.5 * $linespc}]
4007 set yb [expr {$yt + $linespc - 1}]
4011 foreach tag $marks {
4013 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4014 set wid [font measure [concat $mainfont bold] $tag]
4016 set wid [font measure $mainfont $tag]
4020 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4022 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4023 -width $lthickness -fill black -tags tag.$id]
4025 foreach tag $marks x $xvals wid $wvals {
4026 set xl [expr {$x + $delta}]
4027 set xr [expr {$x + $delta + $wid + $lthickness}]
4029 if {[incr ntags -1] >= 0} {
4031 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4032 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4033 -width 1 -outline black -fill yellow -tags tag.$id]
4034 $canv bind $t <1> [list showtag $tag 1]
4035 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4037 # draw a head or other ref
4038 if {[incr nheads -1] >= 0} {
4040 if {$tag eq $mainhead} {
4046 set xl [expr {$xl - $delta/2}]
4047 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4048 -width 1 -outline black -fill $col -tags tag.$id
4049 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4050 set rwid [font measure $mainfont $remoteprefix]
4051 set xi [expr {$x + 1}]
4052 set yti [expr {$yt + 1}]
4053 set xri [expr {$x + $rwid}]
4054 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4055 -width 0 -fill "#ffddaa" -tags tag.$id
4058 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4059 -font $font -tags [list tag.$id text]]
4061 $canv bind $t <1> [list showtag $tag 1]
4062 } elseif {$nheads >= 0} {
4063 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4069 proc xcoord {i level ln} {
4070 global canvx0 xspc1 xspc2
4072 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4073 if {$i > 0 && $i == $level} {
4074 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4075 } elseif {$i > $level} {
4076 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4081 proc show_status {msg} {
4082 global canv mainfont fgcolor
4085 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
4086 -tags text -fill $fgcolor
4089 # Insert a new commit as the child of the commit on row $row.
4090 # The new commit will be displayed on row $row and the commits
4091 # on that row and below will move down one row.
4092 proc insertrow {row newcmit} {
4093 global displayorder parentlist commitlisted children
4094 global commitrow curview rowidlist rowisopt rowfinal numcommits
4096 global selectedline commitidx ordertok
4098 if {$row >= $numcommits} {
4099 puts "oops, inserting new row $row but only have $numcommits rows"
4102 set p [lindex $displayorder $row]
4103 set displayorder [linsert $displayorder $row $newcmit]
4104 set parentlist [linsert $parentlist $row $p]
4105 set kids $children($curview,$p)
4106 lappend kids $newcmit
4107 set children($curview,$p) $kids
4108 set children($curview,$newcmit) {}
4109 set commitlisted [linsert $commitlisted $row 1]
4110 set l [llength $displayorder]
4111 for {set r $row} {$r < $l} {incr r} {
4112 set id [lindex $displayorder $r]
4113 set commitrow($curview,$id) $r
4115 incr commitidx($curview)
4116 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4118 if {$row < [llength $rowidlist]} {
4119 set idlist [lindex $rowidlist $row]
4120 if {$idlist ne {}} {
4121 if {[llength $kids] == 1} {
4122 set col [lsearch -exact $idlist $p]
4123 lset idlist $col $newcmit
4125 set col [llength $idlist]
4126 lappend idlist $newcmit
4129 set rowidlist [linsert $rowidlist $row $idlist]
4130 set rowisopt [linsert $rowisopt $row 0]
4131 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4136 if {[info exists selectedline] && $selectedline >= $row} {
4142 # Remove a commit that was inserted with insertrow on row $row.
4143 proc removerow {row} {
4144 global displayorder parentlist commitlisted children
4145 global commitrow curview rowidlist rowisopt rowfinal numcommits
4147 global linesegends selectedline commitidx
4149 if {$row >= $numcommits} {
4150 puts "oops, removing row $row but only have $numcommits rows"
4153 set rp1 [expr {$row + 1}]
4154 set id [lindex $displayorder $row]
4155 set p [lindex $parentlist $row]
4156 set displayorder [lreplace $displayorder $row $row]
4157 set parentlist [lreplace $parentlist $row $row]
4158 set commitlisted [lreplace $commitlisted $row $row]
4159 set kids $children($curview,$p)
4160 set i [lsearch -exact $kids $id]
4162 set kids [lreplace $kids $i $i]
4163 set children($curview,$p) $kids
4165 set l [llength $displayorder]
4166 for {set r $row} {$r < $l} {incr r} {
4167 set id [lindex $displayorder $r]
4168 set commitrow($curview,$id) $r
4170 incr commitidx($curview) -1
4172 if {$row < [llength $rowidlist]} {
4173 set rowidlist [lreplace $rowidlist $row $row]
4174 set rowisopt [lreplace $rowisopt $row $row]
4175 set rowfinal [lreplace $rowfinal $row $row]
4180 if {[info exists selectedline] && $selectedline > $row} {
4181 incr selectedline -1
4186 # Don't change the text pane cursor if it is currently the hand cursor,
4187 # showing that we are over a sha1 ID link.
4188 proc settextcursor {c} {
4189 global ctext curtextcursor
4191 if {[$ctext cget -cursor] == $curtextcursor} {
4192 $ctext config -cursor $c
4194 set curtextcursor $c
4197 proc nowbusy {what} {
4200 if {[array names isbusy] eq {}} {
4201 . config -cursor watch
4207 proc notbusy {what} {
4208 global isbusy maincursor textcursor
4210 catch {unset isbusy($what)}
4211 if {[array names isbusy] eq {}} {
4212 . config -cursor $maincursor
4213 settextcursor $textcursor
4217 proc findmatches {f} {
4218 global findtype findstring
4219 if {$findtype == "Regexp"} {
4220 set matches [regexp -indices -all -inline $findstring $f]
4223 if {$findtype == "IgnCase"} {
4224 set f [string tolower $f]
4225 set fs [string tolower $fs]
4229 set l [string length $fs]
4230 while {[set j [string first $fs $f $i]] >= 0} {
4231 lappend matches [list $j [expr {$j+$l-1}]]
4232 set i [expr {$j + $l}]
4238 proc dofind {{rev 0}} {
4239 global findstring findstartline findcurline selectedline numcommits
4240 global gdttype filehighlight fh_serial find_dirn
4244 if {$findstring eq {} || $numcommits == 0} return
4245 if {![info exists selectedline]} {
4246 set findstartline [lindex [visiblerows] $rev]
4248 set findstartline $selectedline
4250 set findcurline $findstartline
4252 if {$gdttype ne "containing:" && ![info exists filehighlight]} {
4253 after cancel do_file_hl $fh_serial
4254 do_file_hl $fh_serial
4265 proc stopfinding {} {
4266 global find_dirn findcurline fprogcoord
4268 if {[info exists find_dirn]} {
4277 proc findnext {restart} {
4278 global findcurline find_dirn
4280 if {[info exists find_dirn]} return
4282 if {![info exists findcurline]} {
4295 global findcurline find_dirn
4297 if {[info exists find_dirn]} return
4299 if {![info exists findcurline]} {
4308 global commitdata commitinfo numcommits findpattern findloc
4309 global findstartline findcurline displayorder
4310 global find_dirn gdttype fhighlights fprogcoord
4312 if {![info exists find_dirn]} {
4315 set fldtypes {Headline Author Date Committer CDate Comments}
4316 set l [expr {$findcurline + 1}]
4317 if {$l >= $numcommits} {
4320 if {$l <= $findstartline} {
4321 set lim [expr {$findstartline + 1}]
4325 if {$lim - $l > 500} {
4326 set lim [expr {$l + 500}]
4330 if {$gdttype eq "containing:"} {
4331 for {} {$l < $lim} {incr l} {
4332 set id [lindex $displayorder $l]
4333 # shouldn't happen unless git log doesn't give all the commits...
4334 if {![info exists commitdata($id)]} continue
4335 if {![doesmatch $commitdata($id)]} continue
4336 if {![info exists commitinfo($id)]} {
4339 set info $commitinfo($id)
4340 foreach f $info ty $fldtypes {
4341 if {($findloc eq "All fields" || $findloc eq $ty) &&
4350 for {} {$l < $lim} {incr l} {
4351 set id [lindex $displayorder $l]
4352 if {![info exists fhighlights($l)]} {
4353 askfilehighlight $l $id
4356 set findcurline [expr {$l - 1}]
4358 } elseif {$fhighlights($l)} {
4364 if {$found || ($domore && $l == $findstartline + 1)} {
4380 set findcurline [expr {$l - 1}]
4382 set n [expr {$findcurline - ($findstartline + 1)}]
4386 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4391 proc findmorerev {} {
4392 global commitdata commitinfo numcommits findpattern findloc
4393 global findstartline findcurline displayorder
4394 global find_dirn gdttype fhighlights fprogcoord
4396 if {![info exists find_dirn]} {
4399 set fldtypes {Headline Author Date Committer CDate Comments}
4405 if {$l >= $findstartline} {
4406 set lim [expr {$findstartline - 1}]
4410 if {$l - $lim > 500} {
4411 set lim [expr {$l - 500}]
4415 if {$gdttype eq "containing:"} {
4416 for {} {$l > $lim} {incr l -1} {
4417 set id [lindex $displayorder $l]
4418 if {![info exists commitdata($id)]} continue
4419 if {![doesmatch $commitdata($id)]} continue
4420 if {![info exists commitinfo($id)]} {
4423 set info $commitinfo($id)
4424 foreach f $info ty $fldtypes {
4425 if {($findloc eq "All fields" || $findloc eq $ty) &&
4434 for {} {$l > $lim} {incr l -1} {
4435 set id [lindex $displayorder $l]
4436 if {![info exists fhighlights($l)]} {
4437 askfilehighlight $l $id
4440 set findcurline [expr {$l + 1}]
4442 } elseif {$fhighlights($l)} {
4448 if {$found || ($domore && $l == $findstartline - 1)} {
4464 set findcurline [expr {$l + 1}]
4466 set n [expr {($findstartline - 1) - $findcurline}]
4470 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4475 proc findselectline {l} {
4476 global findloc commentend ctext findcurline markingmatches gdttype
4478 set markingmatches 1
4481 if {$findloc == "All fields" || $findloc == "Comments"} {
4482 # highlight the matches in the comments
4483 set f [$ctext get 1.0 $commentend]
4484 set matches [findmatches $f]
4485 foreach match $matches {
4486 set start [lindex $match 0]
4487 set end [expr {[lindex $match 1] + 1}]
4488 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4494 # mark the bits of a headline or author that match a find string
4495 proc markmatches {canv l str tag matches font row} {
4498 set bbox [$canv bbox $tag]
4499 set x0 [lindex $bbox 0]
4500 set y0 [lindex $bbox 1]
4501 set y1 [lindex $bbox 3]
4502 foreach match $matches {
4503 set start [lindex $match 0]
4504 set end [lindex $match 1]
4505 if {$start > $end} continue
4506 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4507 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4508 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4509 [expr {$x0+$xlen+2}] $y1 \
4510 -outline {} -tags [list match$l matches] -fill yellow]
4512 if {[info exists selectedline] && $row == $selectedline} {
4513 $canv raise $t secsel
4518 proc unmarkmatches {} {
4519 global markingmatches
4521 allcanvs delete matches
4522 set markingmatches 0
4526 proc selcanvline {w x y} {
4527 global canv canvy0 ctext linespc
4529 set ymax [lindex [$canv cget -scrollregion] 3]
4530 if {$ymax == {}} return
4531 set yfrac [lindex [$canv yview] 0]
4532 set y [expr {$y + $yfrac * $ymax}]
4533 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4538 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4544 proc commit_descriptor {p} {
4546 if {![info exists commitinfo($p)]} {
4550 if {[llength $commitinfo($p)] > 1} {
4551 set l [lindex $commitinfo($p) 0]
4556 # append some text to the ctext widget, and make any SHA1 ID
4557 # that we know about be a clickable link.
4558 proc appendwithlinks {text tags} {
4559 global ctext commitrow linknum curview pendinglinks
4561 set start [$ctext index "end - 1c"]
4562 $ctext insert end $text $tags
4563 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4567 set linkid [string range $text $s $e]
4569 $ctext tag delete link$linknum
4570 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4571 setlink $linkid link$linknum
4576 proc setlink {id lk} {
4577 global curview commitrow ctext pendinglinks commitinterest
4579 if {[info exists commitrow($curview,$id)]} {
4580 $ctext tag conf $lk -foreground blue -underline 1
4581 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4582 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4583 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4585 lappend pendinglinks($id) $lk
4586 lappend commitinterest($id) {makelink %I}
4590 proc makelink {id} {
4593 if {![info exists pendinglinks($id)]} return
4594 foreach lk $pendinglinks($id) {
4597 unset pendinglinks($id)
4600 proc linkcursor {w inc} {
4601 global linkentercount curtextcursor
4603 if {[incr linkentercount $inc] > 0} {
4604 $w configure -cursor hand2
4606 $w configure -cursor $curtextcursor
4607 if {$linkentercount < 0} {
4608 set linkentercount 0
4613 proc viewnextline {dir} {
4617 set ymax [lindex [$canv cget -scrollregion] 3]
4618 set wnow [$canv yview]
4619 set wtop [expr {[lindex $wnow 0] * $ymax}]
4620 set newtop [expr {$wtop + $dir * $linespc}]
4623 } elseif {$newtop > $ymax} {
4626 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4629 # add a list of tag or branch names at position pos
4630 # returns the number of names inserted
4631 proc appendrefs {pos ids var} {
4632 global ctext commitrow linknum curview $var maxrefs
4634 if {[catch {$ctext index $pos}]} {
4637 $ctext conf -state normal
4638 $ctext delete $pos "$pos lineend"
4641 foreach tag [set $var\($id\)] {
4642 lappend tags [list $tag $id]
4645 if {[llength $tags] > $maxrefs} {
4646 $ctext insert $pos "many ([llength $tags])"
4648 set tags [lsort -index 0 -decreasing $tags]
4651 set id [lindex $ti 1]
4654 $ctext tag delete $lk
4655 $ctext insert $pos $sep
4656 $ctext insert $pos [lindex $ti 0] $lk
4661 $ctext conf -state disabled
4662 return [llength $tags]
4665 # called when we have finished computing the nearby tags
4666 proc dispneartags {delay} {
4667 global selectedline currentid showneartags tagphase
4669 if {![info exists selectedline] || !$showneartags} return
4670 after cancel dispnexttag
4672 after 200 dispnexttag
4675 after idle dispnexttag
4680 proc dispnexttag {} {
4681 global selectedline currentid showneartags tagphase ctext
4683 if {![info exists selectedline] || !$showneartags} return
4684 switch -- $tagphase {
4686 set dtags [desctags $currentid]
4688 appendrefs precedes $dtags idtags
4692 set atags [anctags $currentid]
4694 appendrefs follows $atags idtags
4698 set dheads [descheads $currentid]
4699 if {$dheads ne {}} {
4700 if {[appendrefs branch $dheads idheads] > 1
4701 && [$ctext get "branch -3c"] eq "h"} {
4702 # turn "Branch" into "Branches"
4703 $ctext conf -state normal
4704 $ctext insert "branch -2c" "es"
4705 $ctext conf -state disabled
4710 if {[incr tagphase] <= 2} {
4711 after idle dispnexttag
4715 proc make_secsel {l} {
4716 global linehtag linentag linedtag canv canv2 canv3
4718 if {![info exists linehtag($l)]} return
4720 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4721 -tags secsel -fill [$canv cget -selectbackground]]
4723 $canv2 delete secsel
4724 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4725 -tags secsel -fill [$canv2 cget -selectbackground]]
4727 $canv3 delete secsel
4728 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4729 -tags secsel -fill [$canv3 cget -selectbackground]]
4733 proc selectline {l isnew} {
4734 global canv ctext commitinfo selectedline
4736 global canvy0 linespc parentlist children curview
4737 global currentid sha1entry
4738 global commentend idtags linknum
4739 global mergemax numcommits pending_select
4740 global cmitmode showneartags allcommits
4742 catch {unset pending_select}
4747 if {$l < 0 || $l >= $numcommits} return
4748 set y [expr {$canvy0 + $l * $linespc}]
4749 set ymax [lindex [$canv cget -scrollregion] 3]
4750 set ytop [expr {$y - $linespc - 1}]
4751 set ybot [expr {$y + $linespc + 1}]
4752 set wnow [$canv yview]
4753 set wtop [expr {[lindex $wnow 0] * $ymax}]
4754 set wbot [expr {[lindex $wnow 1] * $ymax}]
4755 set wh [expr {$wbot - $wtop}]
4757 if {$ytop < $wtop} {
4758 if {$ybot < $wtop} {
4759 set newtop [expr {$y - $wh / 2.0}]
4762 if {$newtop > $wtop - $linespc} {
4763 set newtop [expr {$wtop - $linespc}]
4766 } elseif {$ybot > $wbot} {
4767 if {$ytop > $wbot} {
4768 set newtop [expr {$y - $wh / 2.0}]
4770 set newtop [expr {$ybot - $wh}]
4771 if {$newtop < $wtop + $linespc} {
4772 set newtop [expr {$wtop + $linespc}]
4776 if {$newtop != $wtop} {
4780 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4787 addtohistory [list selectline $l 0]
4792 set id [lindex $displayorder $l]
4794 $sha1entry delete 0 end
4795 $sha1entry insert 0 $id
4796 $sha1entry selection from 0
4797 $sha1entry selection to end
4800 $ctext conf -state normal
4803 set info $commitinfo($id)
4804 set date [formatdate [lindex $info 2]]
4805 $ctext insert end "Author: [lindex $info 1] $date\n"
4806 set date [formatdate [lindex $info 4]]
4807 $ctext insert end "Committer: [lindex $info 3] $date\n"
4808 if {[info exists idtags($id)]} {
4809 $ctext insert end "Tags:"
4810 foreach tag $idtags($id) {
4811 $ctext insert end " $tag"
4813 $ctext insert end "\n"
4817 set olds [lindex $parentlist $l]
4818 if {[llength $olds] > 1} {
4821 if {$np >= $mergemax} {
4826 $ctext insert end "Parent: " $tag
4827 appendwithlinks [commit_descriptor $p] {}
4832 append headers "Parent: [commit_descriptor $p]"
4836 foreach c $children($curview,$id) {
4837 append headers "Child: [commit_descriptor $c]"
4840 # make anything that looks like a SHA1 ID be a clickable link
4841 appendwithlinks $headers {}
4842 if {$showneartags} {
4843 if {![info exists allcommits]} {
4846 $ctext insert end "Branch: "
4847 $ctext mark set branch "end -1c"
4848 $ctext mark gravity branch left
4849 $ctext insert end "\nFollows: "
4850 $ctext mark set follows "end -1c"
4851 $ctext mark gravity follows left
4852 $ctext insert end "\nPrecedes: "
4853 $ctext mark set precedes "end -1c"
4854 $ctext mark gravity precedes left
4855 $ctext insert end "\n"
4858 $ctext insert end "\n"
4859 set comment [lindex $info 5]
4860 if {[string first "\r" $comment] >= 0} {
4861 set comment [string map {"\r" "\n "} $comment]
4863 appendwithlinks $comment {comment}
4865 $ctext tag remove found 1.0 end
4866 $ctext conf -state disabled
4867 set commentend [$ctext index "end - 1c"]
4869 init_flist "Comments"
4870 if {$cmitmode eq "tree"} {
4872 } elseif {[llength $olds] <= 1} {
4879 proc selfirstline {} {
4884 proc sellastline {} {
4887 set l [expr {$numcommits - 1}]
4891 proc selnextline {dir} {
4894 if {![info exists selectedline]} return
4895 set l [expr {$selectedline + $dir}]
4900 proc selnextpage {dir} {
4901 global canv linespc selectedline numcommits
4903 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4907 allcanvs yview scroll [expr {$dir * $lpp}] units
4909 if {![info exists selectedline]} return
4910 set l [expr {$selectedline + $dir * $lpp}]
4913 } elseif {$l >= $numcommits} {
4914 set l [expr $numcommits - 1]
4920 proc unselectline {} {
4921 global selectedline currentid
4923 catch {unset selectedline}
4924 catch {unset currentid}
4925 allcanvs delete secsel
4929 proc reselectline {} {
4932 if {[info exists selectedline]} {
4933 selectline $selectedline 0
4937 proc addtohistory {cmd} {
4938 global history historyindex curview
4940 set elt [list $curview $cmd]
4941 if {$historyindex > 0
4942 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4946 if {$historyindex < [llength $history]} {
4947 set history [lreplace $history $historyindex end $elt]
4949 lappend history $elt
4952 if {$historyindex > 1} {
4953 .tf.bar.leftbut conf -state normal
4955 .tf.bar.leftbut conf -state disabled
4957 .tf.bar.rightbut conf -state disabled
4963 set view [lindex $elt 0]
4964 set cmd [lindex $elt 1]
4965 if {$curview != $view} {
4972 global history historyindex
4975 if {$historyindex > 1} {
4976 incr historyindex -1
4977 godo [lindex $history [expr {$historyindex - 1}]]
4978 .tf.bar.rightbut conf -state normal
4980 if {$historyindex <= 1} {
4981 .tf.bar.leftbut conf -state disabled
4986 global history historyindex
4989 if {$historyindex < [llength $history]} {
4990 set cmd [lindex $history $historyindex]
4993 .tf.bar.leftbut conf -state normal
4995 if {$historyindex >= [llength $history]} {
4996 .tf.bar.rightbut conf -state disabled
5001 global treefilelist treeidlist diffids diffmergeid treepending
5002 global nullid nullid2
5005 catch {unset diffmergeid}
5006 if {![info exists treefilelist($id)]} {
5007 if {![info exists treepending]} {
5008 if {$id eq $nullid} {
5009 set cmd [list | git ls-files]
5010 } elseif {$id eq $nullid2} {
5011 set cmd [list | git ls-files --stage -t]
5013 set cmd [list | git ls-tree -r $id]
5015 if {[catch {set gtf [open $cmd r]}]} {
5019 set treefilelist($id) {}
5020 set treeidlist($id) {}
5021 fconfigure $gtf -blocking 0
5022 filerun $gtf [list gettreeline $gtf $id]
5029 proc gettreeline {gtf id} {
5030 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5033 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5034 if {$diffids eq $nullid} {
5037 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5038 set i [string first "\t" $line]
5039 if {$i < 0} continue
5040 set sha1 [lindex $line 2]
5041 set fname [string range $line [expr {$i+1}] end]
5042 if {[string index $fname 0] eq "\""} {
5043 set fname [lindex $fname 0]
5045 lappend treeidlist($id) $sha1
5047 lappend treefilelist($id) $fname
5050 return [expr {$nl >= 1000? 2: 1}]
5054 if {$cmitmode ne "tree"} {
5055 if {![info exists diffmergeid]} {
5056 gettreediffs $diffids
5058 } elseif {$id ne $diffids} {
5067 global treefilelist treeidlist diffids nullid nullid2
5068 global ctext commentend
5070 set i [lsearch -exact $treefilelist($diffids) $f]
5072 puts "oops, $f not in list for id $diffids"
5075 if {$diffids eq $nullid} {
5076 if {[catch {set bf [open $f r]} err]} {
5077 puts "oops, can't read $f: $err"
5081 set blob [lindex $treeidlist($diffids) $i]
5082 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5083 puts "oops, error reading blob $blob: $err"
5087 fconfigure $bf -blocking 0
5088 filerun $bf [list getblobline $bf $diffids]
5089 $ctext config -state normal
5090 clear_ctext $commentend
5091 $ctext insert end "\n"
5092 $ctext insert end "$f\n" filesep
5093 $ctext config -state disabled
5094 $ctext yview $commentend
5097 proc getblobline {bf id} {
5098 global diffids cmitmode ctext
5100 if {$id ne $diffids || $cmitmode ne "tree"} {
5104 $ctext config -state normal
5106 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5107 $ctext insert end "$line\n"
5110 # delete last newline
5111 $ctext delete "end - 2c" "end - 1c"
5115 $ctext config -state disabled
5116 return [expr {$nl >= 1000? 2: 1}]
5119 proc mergediff {id l} {
5120 global diffmergeid diffopts mdifffd
5126 # this doesn't seem to actually affect anything...
5127 set env(GIT_DIFF_OPTS) $diffopts
5128 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5129 if {[catch {set mdf [open $cmd r]} err]} {
5130 error_popup "Error getting merge diffs: $err"
5133 fconfigure $mdf -blocking 0
5134 set mdifffd($id) $mdf
5135 set np [llength [lindex $parentlist $l]]
5136 filerun $mdf [list getmergediffline $mdf $id $np]
5139 proc getmergediffline {mdf id np} {
5140 global diffmergeid ctext cflist mergemax
5141 global difffilestart mdifffd
5143 $ctext conf -state normal
5145 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5146 if {![info exists diffmergeid] || $id != $diffmergeid
5147 || $mdf != $mdifffd($id)} {
5151 if {[regexp {^diff --cc (.*)} $line match fname]} {
5152 # start of a new file
5153 $ctext insert end "\n"
5154 set here [$ctext index "end - 1c"]
5155 lappend difffilestart $here
5156 add_flist [list $fname]
5157 set l [expr {(78 - [string length $fname]) / 2}]
5158 set pad [string range "----------------------------------------" 1 $l]
5159 $ctext insert end "$pad $fname $pad\n" filesep
5160 } elseif {[regexp {^@@} $line]} {
5161 $ctext insert end "$line\n" hunksep
5162 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5165 # parse the prefix - one ' ', '-' or '+' for each parent
5170 for {set j 0} {$j < $np} {incr j} {
5171 set c [string range $line $j $j]
5174 } elseif {$c == "-"} {
5176 } elseif {$c == "+"} {
5185 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5186 # line doesn't appear in result, parents in $minuses have the line
5187 set num [lindex $minuses 0]
5188 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5189 # line appears in result, parents in $pluses don't have the line
5190 lappend tags mresult
5191 set num [lindex $spaces 0]
5194 if {$num >= $mergemax} {
5199 $ctext insert end "$line\n" $tags
5202 $ctext conf -state disabled
5207 return [expr {$nr >= 1000? 2: 1}]
5210 proc startdiff {ids} {
5211 global treediffs diffids treepending diffmergeid nullid nullid2
5214 catch {unset diffmergeid}
5215 if {![info exists treediffs($ids)] ||
5216 [lsearch -exact $ids $nullid] >= 0 ||
5217 [lsearch -exact $ids $nullid2] >= 0} {
5218 if {![info exists treepending]} {
5226 proc addtocflist {ids} {
5227 global treediffs cflist
5228 add_flist $treediffs($ids)
5232 proc diffcmd {ids flags} {
5233 global nullid nullid2
5235 set i [lsearch -exact $ids $nullid]
5236 set j [lsearch -exact $ids $nullid2]
5238 if {[llength $ids] > 1 && $j < 0} {
5239 # comparing working directory with some specific revision
5240 set cmd [concat | git diff-index $flags]
5242 lappend cmd -R [lindex $ids 1]
5244 lappend cmd [lindex $ids 0]
5247 # comparing working directory with index
5248 set cmd [concat | git diff-files $flags]
5253 } elseif {$j >= 0} {
5254 set cmd [concat | git diff-index --cached $flags]
5255 if {[llength $ids] > 1} {
5256 # comparing index with specific revision
5258 lappend cmd -R [lindex $ids 1]
5260 lappend cmd [lindex $ids 0]
5263 # comparing index with HEAD
5267 set cmd [concat | git diff-tree -r $flags $ids]
5272 proc gettreediffs {ids} {
5273 global treediff treepending
5275 set treepending $ids
5277 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5278 fconfigure $gdtf -blocking 0
5279 filerun $gdtf [list gettreediffline $gdtf $ids]
5282 proc gettreediffline {gdtf ids} {
5283 global treediff treediffs treepending diffids diffmergeid
5287 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5288 set i [string first "\t" $line]
5290 set file [string range $line [expr {$i+1}] end]
5291 if {[string index $file 0] eq "\""} {
5292 set file [lindex $file 0]
5294 lappend treediff $file
5298 return [expr {$nr >= 1000? 2: 1}]
5301 set treediffs($ids) $treediff
5303 if {$cmitmode eq "tree"} {
5305 } elseif {$ids != $diffids} {
5306 if {![info exists diffmergeid]} {
5307 gettreediffs $diffids
5315 # empty string or positive integer
5316 proc diffcontextvalidate {v} {
5317 return [regexp {^(|[1-9][0-9]*)$} $v]
5320 proc diffcontextchange {n1 n2 op} {
5321 global diffcontextstring diffcontext
5323 if {[string is integer -strict $diffcontextstring]} {
5324 if {$diffcontextstring > 0} {
5325 set diffcontext $diffcontextstring
5331 proc getblobdiffs {ids} {
5332 global diffopts blobdifffd diffids env
5333 global diffinhdr treediffs
5336 set env(GIT_DIFF_OPTS) $diffopts
5337 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5338 puts "error getting diffs: $err"
5342 fconfigure $bdf -blocking 0
5343 set blobdifffd($ids) $bdf
5344 filerun $bdf [list getblobdiffline $bdf $diffids]
5347 proc setinlist {var i val} {
5350 while {[llength [set $var]] < $i} {
5353 if {[llength [set $var]] == $i} {
5360 proc makediffhdr {fname ids} {
5361 global ctext curdiffstart treediffs
5363 set i [lsearch -exact $treediffs($ids) $fname]
5365 setinlist difffilestart $i $curdiffstart
5367 set l [expr {(78 - [string length $fname]) / 2}]
5368 set pad [string range "----------------------------------------" 1 $l]
5369 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5372 proc getblobdiffline {bdf ids} {
5373 global diffids blobdifffd ctext curdiffstart
5374 global diffnexthead diffnextnote difffilestart
5375 global diffinhdr treediffs
5378 $ctext conf -state normal
5379 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5380 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5384 if {![string compare -length 11 "diff --git " $line]} {
5385 # trim off "diff --git "
5386 set line [string range $line 11 end]
5388 # start of a new file
5389 $ctext insert end "\n"
5390 set curdiffstart [$ctext index "end - 1c"]
5391 $ctext insert end "\n" filesep
5392 # If the name hasn't changed the length will be odd,
5393 # the middle char will be a space, and the two bits either
5394 # side will be a/name and b/name, or "a/name" and "b/name".
5395 # If the name has changed we'll get "rename from" and
5396 # "rename to" or "copy from" and "copy to" lines following this,
5397 # and we'll use them to get the filenames.
5398 # This complexity is necessary because spaces in the filename(s)
5399 # don't get escaped.
5400 set l [string length $line]
5401 set i [expr {$l / 2}]
5402 if {!(($l & 1) && [string index $line $i] eq " " &&
5403 [string range $line 2 [expr {$i - 1}]] eq \
5404 [string range $line [expr {$i + 3}] end])} {
5407 # unescape if quoted and chop off the a/ from the front
5408 if {[string index $line 0] eq "\""} {
5409 set fname [string range [lindex $line 0] 2 end]
5411 set fname [string range $line 2 [expr {$i - 1}]]
5413 makediffhdr $fname $ids
5415 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5416 $line match f1l f1c f2l f2c rest]} {
5417 $ctext insert end "$line\n" hunksep
5420 } elseif {$diffinhdr} {
5421 if {![string compare -length 12 "rename from " $line] ||
5422 ![string compare -length 10 "copy from " $line]} {
5423 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5424 if {[string index $fname 0] eq "\""} {
5425 set fname [lindex $fname 0]
5427 set i [lsearch -exact $treediffs($ids) $fname]
5429 setinlist difffilestart $i $curdiffstart
5431 } elseif {![string compare -length 10 $line "rename to "] ||
5432 ![string compare -length 8 $line "copy to "]} {
5433 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5434 if {[string index $fname 0] eq "\""} {
5435 set fname [lindex $fname 0]
5437 makediffhdr $fname $ids
5438 } elseif {[string compare -length 3 $line "---"] == 0} {
5441 } elseif {[string compare -length 3 $line "+++"] == 0} {
5445 $ctext insert end "$line\n" filesep
5448 set x [string range $line 0 0]
5449 if {$x == "-" || $x == "+"} {
5450 set tag [expr {$x == "+"}]
5451 $ctext insert end "$line\n" d$tag
5452 } elseif {$x == " "} {
5453 $ctext insert end "$line\n"
5455 # "\ No newline at end of file",
5456 # or something else we don't recognize
5457 $ctext insert end "$line\n" hunksep
5461 $ctext conf -state disabled
5466 return [expr {$nr >= 1000? 2: 1}]
5469 proc changediffdisp {} {
5470 global ctext diffelide
5472 $ctext tag conf d0 -elide [lindex $diffelide 0]
5473 $ctext tag conf d1 -elide [lindex $diffelide 1]
5477 global difffilestart ctext
5478 set prev [lindex $difffilestart 0]
5479 set here [$ctext index @0,0]
5480 foreach loc $difffilestart {
5481 if {[$ctext compare $loc >= $here]} {
5491 global difffilestart ctext
5492 set here [$ctext index @0,0]
5493 foreach loc $difffilestart {
5494 if {[$ctext compare $loc > $here]} {
5501 proc clear_ctext {{first 1.0}} {
5502 global ctext smarktop smarkbot
5505 set l [lindex [split $first .] 0]
5506 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5509 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5512 $ctext delete $first end
5513 if {$first eq "1.0"} {
5514 catch {unset pendinglinks}
5518 proc incrsearch {name ix op} {
5519 global ctext searchstring searchdirn
5521 $ctext tag remove found 1.0 end
5522 if {[catch {$ctext index anchor}]} {
5523 # no anchor set, use start of selection, or of visible area
5524 set sel [$ctext tag ranges sel]
5526 $ctext mark set anchor [lindex $sel 0]
5527 } elseif {$searchdirn eq "-forwards"} {
5528 $ctext mark set anchor @0,0
5530 $ctext mark set anchor @0,[winfo height $ctext]
5533 if {$searchstring ne {}} {
5534 set here [$ctext search $searchdirn -- $searchstring anchor]
5543 global sstring ctext searchstring searchdirn
5546 $sstring icursor end
5547 set searchdirn -forwards
5548 if {$searchstring ne {}} {
5549 set sel [$ctext tag ranges sel]
5551 set start "[lindex $sel 0] + 1c"
5552 } elseif {[catch {set start [$ctext index anchor]}]} {
5555 set match [$ctext search -count mlen -- $searchstring $start]
5556 $ctext tag remove sel 1.0 end
5562 set mend "$match + $mlen c"
5563 $ctext tag add sel $match $mend
5564 $ctext mark unset anchor
5568 proc dosearchback {} {
5569 global sstring ctext searchstring searchdirn
5572 $sstring icursor end
5573 set searchdirn -backwards
5574 if {$searchstring ne {}} {
5575 set sel [$ctext tag ranges sel]
5577 set start [lindex $sel 0]
5578 } elseif {[catch {set start [$ctext index anchor]}]} {
5579 set start @0,[winfo height $ctext]
5581 set match [$ctext search -backwards -count ml -- $searchstring $start]
5582 $ctext tag remove sel 1.0 end
5588 set mend "$match + $ml c"
5589 $ctext tag add sel $match $mend
5590 $ctext mark unset anchor
5594 proc searchmark {first last} {
5595 global ctext searchstring
5599 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5600 if {$match eq {}} break
5601 set mend "$match + $mlen c"
5602 $ctext tag add found $match $mend
5606 proc searchmarkvisible {doall} {
5607 global ctext smarktop smarkbot
5609 set topline [lindex [split [$ctext index @0,0] .] 0]
5610 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5611 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5612 # no overlap with previous
5613 searchmark $topline $botline
5614 set smarktop $topline
5615 set smarkbot $botline
5617 if {$topline < $smarktop} {
5618 searchmark $topline [expr {$smarktop-1}]
5619 set smarktop $topline
5621 if {$botline > $smarkbot} {
5622 searchmark [expr {$smarkbot+1}] $botline
5623 set smarkbot $botline
5628 proc scrolltext {f0 f1} {
5631 .bleft.sb set $f0 $f1
5632 if {$searchstring ne {}} {
5638 global linespc charspc canvx0 canvy0 mainfont
5639 global xspc1 xspc2 lthickness
5641 set linespc [font metrics $mainfont -linespace]
5642 set charspc [font measure $mainfont "m"]
5643 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5644 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5645 set lthickness [expr {int($linespc / 9) + 1}]
5646 set xspc1(0) $linespc
5654 set ymax [lindex [$canv cget -scrollregion] 3]
5655 if {$ymax eq {} || $ymax == 0} return
5656 set span [$canv yview]
5659 allcanvs yview moveto [lindex $span 0]
5661 if {[info exists selectedline]} {
5662 selectline $selectedline 0
5663 allcanvs yview moveto [lindex $span 0]
5667 proc incrfont {inc} {
5668 global mainfont textfont ctext canv phase cflist showrefstop
5669 global charspc tabstop
5670 global stopped entries
5672 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5673 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5675 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5676 $cflist conf -font $textfont
5677 $ctext tag conf filesep -font [concat $textfont bold]
5678 foreach e $entries {
5679 $e conf -font $mainfont
5681 if {$phase eq "getcommits"} {
5682 $canv itemconf textitems -font $mainfont
5684 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5685 $showrefstop.list conf -font $mainfont
5691 global sha1entry sha1string
5692 if {[string length $sha1string] == 40} {
5693 $sha1entry delete 0 end
5697 proc sha1change {n1 n2 op} {
5698 global sha1string currentid sha1but
5699 if {$sha1string == {}
5700 || ([info exists currentid] && $sha1string == $currentid)} {
5705 if {[$sha1but cget -state] == $state} return
5706 if {$state == "normal"} {
5707 $sha1but conf -state normal -relief raised -text "Goto: "
5709 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5713 proc gotocommit {} {
5714 global sha1string currentid commitrow tagids headids
5715 global displayorder numcommits curview
5717 if {$sha1string == {}
5718 || ([info exists currentid] && $sha1string == $currentid)} return
5719 if {[info exists tagids($sha1string)]} {
5720 set id $tagids($sha1string)
5721 } elseif {[info exists headids($sha1string)]} {
5722 set id $headids($sha1string)
5724 set id [string tolower $sha1string]
5725 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5727 foreach i $displayorder {
5728 if {[string match $id* $i]} {
5732 if {$matches ne {}} {
5733 if {[llength $matches] > 1} {
5734 error_popup "Short SHA1 id $id is ambiguous"
5737 set id [lindex $matches 0]
5741 if {[info exists commitrow($curview,$id)]} {
5742 selectline $commitrow($curview,$id) 1
5745 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5750 error_popup "$type $sha1string is not known"
5753 proc lineenter {x y id} {
5754 global hoverx hovery hoverid hovertimer
5755 global commitinfo canv
5757 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5761 if {[info exists hovertimer]} {
5762 after cancel $hovertimer
5764 set hovertimer [after 500 linehover]
5768 proc linemotion {x y id} {
5769 global hoverx hovery hoverid hovertimer
5771 if {[info exists hoverid] && $id == $hoverid} {
5774 if {[info exists hovertimer]} {
5775 after cancel $hovertimer
5777 set hovertimer [after 500 linehover]
5781 proc lineleave {id} {
5782 global hoverid hovertimer canv
5784 if {[info exists hoverid] && $id == $hoverid} {
5786 if {[info exists hovertimer]} {
5787 after cancel $hovertimer
5795 global hoverx hovery hoverid hovertimer
5796 global canv linespc lthickness
5797 global commitinfo mainfont
5799 set text [lindex $commitinfo($hoverid) 0]
5800 set ymax [lindex [$canv cget -scrollregion] 3]
5801 if {$ymax == {}} return
5802 set yfrac [lindex [$canv yview] 0]
5803 set x [expr {$hoverx + 2 * $linespc}]
5804 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5805 set x0 [expr {$x - 2 * $lthickness}]
5806 set y0 [expr {$y - 2 * $lthickness}]
5807 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5808 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5809 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5810 -fill \#ffff80 -outline black -width 1 -tags hover]
5812 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5817 proc clickisonarrow {id y} {
5820 set ranges [rowranges $id]
5821 set thresh [expr {2 * $lthickness + 6}]
5822 set n [expr {[llength $ranges] - 1}]
5823 for {set i 1} {$i < $n} {incr i} {
5824 set row [lindex $ranges $i]
5825 if {abs([yc $row] - $y) < $thresh} {
5832 proc arrowjump {id n y} {
5835 # 1 <-> 2, 3 <-> 4, etc...
5836 set n [expr {(($n - 1) ^ 1) + 1}]
5837 set row [lindex [rowranges $id] $n]
5839 set ymax [lindex [$canv cget -scrollregion] 3]
5840 if {$ymax eq {} || $ymax <= 0} return
5841 set view [$canv yview]
5842 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5843 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5847 allcanvs yview moveto $yfrac
5850 proc lineclick {x y id isnew} {
5851 global ctext commitinfo children canv thickerline curview commitrow
5853 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5858 # draw this line thicker than normal
5862 set ymax [lindex [$canv cget -scrollregion] 3]
5863 if {$ymax eq {}} return
5864 set yfrac [lindex [$canv yview] 0]
5865 set y [expr {$y + $yfrac * $ymax}]
5867 set dirn [clickisonarrow $id $y]
5869 arrowjump $id $dirn $y
5874 addtohistory [list lineclick $x $y $id 0]
5876 # fill the details pane with info about this line
5877 $ctext conf -state normal
5879 $ctext insert end "Parent:\t"
5880 $ctext insert end $id link0
5882 set info $commitinfo($id)
5883 $ctext insert end "\n\t[lindex $info 0]\n"
5884 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5885 set date [formatdate [lindex $info 2]]
5886 $ctext insert end "\tDate:\t$date\n"
5887 set kids $children($curview,$id)
5889 $ctext insert end "\nChildren:"
5891 foreach child $kids {
5893 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5894 set info $commitinfo($child)
5895 $ctext insert end "\n\t"
5896 $ctext insert end $child link$i
5897 setlink $child link$i
5898 $ctext insert end "\n\t[lindex $info 0]"
5899 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5900 set date [formatdate [lindex $info 2]]
5901 $ctext insert end "\n\tDate:\t$date\n"
5904 $ctext conf -state disabled
5908 proc normalline {} {
5910 if {[info exists thickerline]} {
5918 global commitrow curview
5919 if {[info exists commitrow($curview,$id)]} {
5920 selectline $commitrow($curview,$id) 1
5926 if {![info exists startmstime]} {
5927 set startmstime [clock clicks -milliseconds]
5929 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5932 proc rowmenu {x y id} {
5933 global rowctxmenu commitrow selectedline rowmenuid curview
5934 global nullid nullid2 fakerowmenu mainhead
5938 if {![info exists selectedline]
5939 || $commitrow($curview,$id) eq $selectedline} {
5944 if {$id ne $nullid && $id ne $nullid2} {
5945 set menu $rowctxmenu
5946 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5948 set menu $fakerowmenu
5950 $menu entryconfigure "Diff this*" -state $state
5951 $menu entryconfigure "Diff selected*" -state $state
5952 $menu entryconfigure "Make patch" -state $state
5953 tk_popup $menu $x $y
5956 proc diffvssel {dirn} {
5957 global rowmenuid selectedline displayorder
5959 if {![info exists selectedline]} return
5961 set oldid [lindex $displayorder $selectedline]
5962 set newid $rowmenuid
5964 set oldid $rowmenuid
5965 set newid [lindex $displayorder $selectedline]
5967 addtohistory [list doseldiff $oldid $newid]
5968 doseldiff $oldid $newid
5971 proc doseldiff {oldid newid} {
5975 $ctext conf -state normal
5978 $ctext insert end "From "
5979 $ctext insert end $oldid link0
5980 setlink $oldid link0
5981 $ctext insert end "\n "
5982 $ctext insert end [lindex $commitinfo($oldid) 0]
5983 $ctext insert end "\n\nTo "
5984 $ctext insert end $newid link1
5985 setlink $newid link1
5986 $ctext insert end "\n "
5987 $ctext insert end [lindex $commitinfo($newid) 0]
5988 $ctext insert end "\n"
5989 $ctext conf -state disabled
5990 $ctext tag remove found 1.0 end
5991 startdiff [list $oldid $newid]
5995 global rowmenuid currentid commitinfo patchtop patchnum
5997 if {![info exists currentid]} return
5998 set oldid $currentid
5999 set oldhead [lindex $commitinfo($oldid) 0]
6000 set newid $rowmenuid
6001 set newhead [lindex $commitinfo($newid) 0]
6004 catch {destroy $top}
6006 label $top.title -text "Generate patch"
6007 grid $top.title - -pady 10
6008 label $top.from -text "From:"
6009 entry $top.fromsha1 -width 40 -relief flat
6010 $top.fromsha1 insert 0 $oldid
6011 $top.fromsha1 conf -state readonly
6012 grid $top.from $top.fromsha1 -sticky w
6013 entry $top.fromhead -width 60 -relief flat
6014 $top.fromhead insert 0 $oldhead
6015 $top.fromhead conf -state readonly
6016 grid x $top.fromhead -sticky w
6017 label $top.to -text "To:"
6018 entry $top.tosha1 -width 40 -relief flat
6019 $top.tosha1 insert 0 $newid
6020 $top.tosha1 conf -state readonly
6021 grid $top.to $top.tosha1 -sticky w
6022 entry $top.tohead -width 60 -relief flat
6023 $top.tohead insert 0 $newhead
6024 $top.tohead conf -state readonly
6025 grid x $top.tohead -sticky w
6026 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
6027 grid $top.rev x -pady 10
6028 label $top.flab -text "Output file:"
6029 entry $top.fname -width 60
6030 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6032 grid $top.flab $top.fname -sticky w
6034 button $top.buts.gen -text "Generate" -command mkpatchgo
6035 button $top.buts.can -text "Cancel" -command mkpatchcan
6036 grid $top.buts.gen $top.buts.can
6037 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6038 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6039 grid $top.buts - -pady 10 -sticky ew
6043 proc mkpatchrev {} {
6046 set oldid [$patchtop.fromsha1 get]
6047 set oldhead [$patchtop.fromhead get]
6048 set newid [$patchtop.tosha1 get]
6049 set newhead [$patchtop.tohead get]
6050 foreach e [list fromsha1 fromhead tosha1 tohead] \
6051 v [list $newid $newhead $oldid $oldhead] {
6052 $patchtop.$e conf -state normal
6053 $patchtop.$e delete 0 end
6054 $patchtop.$e insert 0 $v
6055 $patchtop.$e conf -state readonly
6060 global patchtop nullid nullid2
6062 set oldid [$patchtop.fromsha1 get]
6063 set newid [$patchtop.tosha1 get]
6064 set fname [$patchtop.fname get]
6065 set cmd [diffcmd [list $oldid $newid] -p]
6066 # trim off the initial "|"
6067 set cmd [lrange $cmd 1 end]
6068 lappend cmd >$fname &
6069 if {[catch {eval exec $cmd} err]} {
6070 error_popup "Error creating patch: $err"
6072 catch {destroy $patchtop}
6076 proc mkpatchcan {} {
6079 catch {destroy $patchtop}
6084 global rowmenuid mktagtop commitinfo
6088 catch {destroy $top}
6090 label $top.title -text "Create tag"
6091 grid $top.title - -pady 10
6092 label $top.id -text "ID:"
6093 entry $top.sha1 -width 40 -relief flat
6094 $top.sha1 insert 0 $rowmenuid
6095 $top.sha1 conf -state readonly
6096 grid $top.id $top.sha1 -sticky w
6097 entry $top.head -width 60 -relief flat
6098 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6099 $top.head conf -state readonly
6100 grid x $top.head -sticky w
6101 label $top.tlab -text "Tag name:"
6102 entry $top.tag -width 60
6103 grid $top.tlab $top.tag -sticky w
6105 button $top.buts.gen -text "Create" -command mktaggo
6106 button $top.buts.can -text "Cancel" -command mktagcan
6107 grid $top.buts.gen $top.buts.can
6108 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6109 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6110 grid $top.buts - -pady 10 -sticky ew
6115 global mktagtop env tagids idtags
6117 set id [$mktagtop.sha1 get]
6118 set tag [$mktagtop.tag get]
6120 error_popup "No tag name specified"
6123 if {[info exists tagids($tag)]} {
6124 error_popup "Tag \"$tag\" already exists"
6129 set fname [file join $dir "refs/tags" $tag]
6130 set f [open $fname w]
6134 error_popup "Error creating tag: $err"
6138 set tagids($tag) $id
6139 lappend idtags($id) $tag
6146 proc redrawtags {id} {
6147 global canv linehtag commitrow idpos selectedline curview
6148 global mainfont canvxmax iddrawn
6150 if {![info exists commitrow($curview,$id)]} return
6151 if {![info exists iddrawn($id)]} return
6152 drawcommits $commitrow($curview,$id)
6153 $canv delete tag.$id
6154 set xt [eval drawtags $id $idpos($id)]
6155 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6156 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6157 set xr [expr {$xt + [font measure $mainfont $text]}]
6158 if {$xr > $canvxmax} {
6162 if {[info exists selectedline]
6163 && $selectedline == $commitrow($curview,$id)} {
6164 selectline $selectedline 0
6171 catch {destroy $mktagtop}
6180 proc writecommit {} {
6181 global rowmenuid wrcomtop commitinfo wrcomcmd
6183 set top .writecommit
6185 catch {destroy $top}
6187 label $top.title -text "Write commit to file"
6188 grid $top.title - -pady 10
6189 label $top.id -text "ID:"
6190 entry $top.sha1 -width 40 -relief flat
6191 $top.sha1 insert 0 $rowmenuid
6192 $top.sha1 conf -state readonly
6193 grid $top.id $top.sha1 -sticky w
6194 entry $top.head -width 60 -relief flat
6195 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6196 $top.head conf -state readonly
6197 grid x $top.head -sticky w
6198 label $top.clab -text "Command:"
6199 entry $top.cmd -width 60 -textvariable wrcomcmd
6200 grid $top.clab $top.cmd -sticky w -pady 10
6201 label $top.flab -text "Output file:"
6202 entry $top.fname -width 60
6203 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6204 grid $top.flab $top.fname -sticky w
6206 button $top.buts.gen -text "Write" -command wrcomgo
6207 button $top.buts.can -text "Cancel" -command wrcomcan
6208 grid $top.buts.gen $top.buts.can
6209 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6210 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6211 grid $top.buts - -pady 10 -sticky ew
6218 set id [$wrcomtop.sha1 get]
6219 set cmd "echo $id | [$wrcomtop.cmd get]"
6220 set fname [$wrcomtop.fname get]
6221 if {[catch {exec sh -c $cmd >$fname &} err]} {
6222 error_popup "Error writing commit: $err"
6224 catch {destroy $wrcomtop}
6231 catch {destroy $wrcomtop}
6236 global rowmenuid mkbrtop
6239 catch {destroy $top}
6241 label $top.title -text "Create new branch"
6242 grid $top.title - -pady 10
6243 label $top.id -text "ID:"
6244 entry $top.sha1 -width 40 -relief flat
6245 $top.sha1 insert 0 $rowmenuid
6246 $top.sha1 conf -state readonly
6247 grid $top.id $top.sha1 -sticky w
6248 label $top.nlab -text "Name:"
6249 entry $top.name -width 40
6250 grid $top.nlab $top.name -sticky w
6252 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6253 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6254 grid $top.buts.go $top.buts.can
6255 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6256 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6257 grid $top.buts - -pady 10 -sticky ew
6262 global headids idheads
6264 set name [$top.name get]
6265 set id [$top.sha1 get]
6267 error_popup "Please specify a name for the new branch"
6270 catch {destroy $top}
6274 exec git branch $name $id
6279 set headids($name) $id
6280 lappend idheads($id) $name
6289 proc cherrypick {} {
6290 global rowmenuid curview commitrow
6293 set oldhead [exec git rev-parse HEAD]
6294 set dheads [descheads $rowmenuid]
6295 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6296 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6297 included in branch $mainhead -- really re-apply it?"]
6302 # Unfortunately git-cherry-pick writes stuff to stderr even when
6303 # no error occurs, and exec takes that as an indication of error...
6304 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6309 set newhead [exec git rev-parse HEAD]
6310 if {$newhead eq $oldhead} {
6312 error_popup "No changes committed"
6315 addnewchild $newhead $oldhead
6316 if {[info exists commitrow($curview,$oldhead)]} {
6317 insertrow $commitrow($curview,$oldhead) $newhead
6318 if {$mainhead ne {}} {
6319 movehead $newhead $mainhead
6320 movedhead $newhead $mainhead
6329 global mainheadid mainhead rowmenuid confirm_ok resettype
6332 set w ".confirmreset"
6335 wm title $w "Confirm reset"
6336 message $w.m -text \
6337 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6338 -justify center -aspect 1000
6339 pack $w.m -side top -fill x -padx 20 -pady 20
6340 frame $w.f -relief sunken -border 2
6341 message $w.f.rt -text "Reset type:" -aspect 1000
6342 grid $w.f.rt -sticky w
6344 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6345 -text "Soft: Leave working tree and index untouched"
6346 grid $w.f.soft -sticky w
6347 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6348 -text "Mixed: Leave working tree untouched, reset index"
6349 grid $w.f.mixed -sticky w
6350 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6351 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6352 grid $w.f.hard -sticky w
6353 pack $w.f -side top -fill x
6354 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6355 pack $w.ok -side left -fill x -padx 20 -pady 20
6356 button $w.cancel -text Cancel -command "destroy $w"
6357 pack $w.cancel -side right -fill x -padx 20 -pady 20
6358 bind $w <Visibility> "grab $w; focus $w"
6360 if {!$confirm_ok} return
6361 if {[catch {set fd [open \
6362 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6366 set w ".resetprogress"
6367 filerun $fd [list readresetstat $fd $w]
6370 wm title $w "Reset progress"
6371 message $w.m -text "Reset in progress, please wait..." \
6372 -justify center -aspect 1000
6373 pack $w.m -side top -fill x -padx 20 -pady 5
6374 canvas $w.c -width 150 -height 20 -bg white
6375 $w.c create rect 0 0 0 20 -fill green -tags rect
6376 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6381 proc readresetstat {fd w} {
6382 global mainhead mainheadid showlocalchanges
6384 if {[gets $fd line] >= 0} {
6385 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6386 set x [expr {($m * 150) / $n}]
6387 $w.c coords rect 0 0 $x 20
6393 if {[catch {close $fd} err]} {
6396 set oldhead $mainheadid
6397 set newhead [exec git rev-parse HEAD]
6398 if {$newhead ne $oldhead} {
6399 movehead $newhead $mainhead
6400 movedhead $newhead $mainhead
6401 set mainheadid $newhead
6405 if {$showlocalchanges} {
6411 # context menu for a head
6412 proc headmenu {x y id head} {
6413 global headmenuid headmenuhead headctxmenu mainhead
6417 set headmenuhead $head
6419 if {$head eq $mainhead} {
6422 $headctxmenu entryconfigure 0 -state $state
6423 $headctxmenu entryconfigure 1 -state $state
6424 tk_popup $headctxmenu $x $y
6428 global headmenuid headmenuhead mainhead headids
6429 global showlocalchanges mainheadid
6431 # check the tree is clean first??
6432 set oldmainhead $mainhead
6437 exec git checkout -q $headmenuhead
6443 set mainhead $headmenuhead
6444 set mainheadid $headmenuid
6445 if {[info exists headids($oldmainhead)]} {
6446 redrawtags $headids($oldmainhead)
6448 redrawtags $headmenuid
6450 if {$showlocalchanges} {
6456 global headmenuid headmenuhead mainhead
6459 set head $headmenuhead
6461 # this check shouldn't be needed any more...
6462 if {$head eq $mainhead} {
6463 error_popup "Cannot delete the currently checked-out branch"
6466 set dheads [descheads $id]
6467 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6468 # the stuff on this branch isn't on any other branch
6469 if {![confirm_popup "The commits on branch $head aren't on any other\
6470 branch.\nReally delete branch $head?"]} return
6474 if {[catch {exec git branch -D $head} err]} {
6479 removehead $id $head
6480 removedhead $id $head
6487 # Display a list of tags and heads
6489 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6490 global bglist fglist uifont reflistfilter reflist maincursor
6493 set showrefstop $top
6494 if {[winfo exists $top]} {
6500 wm title $top "Tags and heads: [file tail [pwd]]"
6501 text $top.list -background $bgcolor -foreground $fgcolor \
6502 -selectbackground $selectbgcolor -font $mainfont \
6503 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6504 -width 30 -height 20 -cursor $maincursor \
6505 -spacing1 1 -spacing3 1 -state disabled
6506 $top.list tag configure highlight -background $selectbgcolor
6507 lappend bglist $top.list
6508 lappend fglist $top.list
6509 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6510 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6511 grid $top.list $top.ysb -sticky nsew
6512 grid $top.xsb x -sticky ew
6514 label $top.f.l -text "Filter: " -font $uifont
6515 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6516 set reflistfilter "*"
6517 trace add variable reflistfilter write reflistfilter_change
6518 pack $top.f.e -side right -fill x -expand 1
6519 pack $top.f.l -side left
6520 grid $top.f - -sticky ew -pady 2
6521 button $top.close -command [list destroy $top] -text "Close" \
6524 grid columnconfigure $top 0 -weight 1
6525 grid rowconfigure $top 0 -weight 1
6526 bind $top.list <1> {break}
6527 bind $top.list <B1-Motion> {break}
6528 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6533 proc sel_reflist {w x y} {
6534 global showrefstop reflist headids tagids otherrefids
6536 if {![winfo exists $showrefstop]} return
6537 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6538 set ref [lindex $reflist [expr {$l-1}]]
6539 set n [lindex $ref 0]
6540 switch -- [lindex $ref 1] {
6541 "H" {selbyid $headids($n)}
6542 "T" {selbyid $tagids($n)}
6543 "o" {selbyid $otherrefids($n)}
6545 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6548 proc unsel_reflist {} {
6551 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6552 $showrefstop.list tag remove highlight 0.0 end
6555 proc reflistfilter_change {n1 n2 op} {
6556 global reflistfilter
6558 after cancel refill_reflist
6559 after 200 refill_reflist
6562 proc refill_reflist {} {
6563 global reflist reflistfilter showrefstop headids tagids otherrefids
6564 global commitrow curview commitinterest
6566 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6568 foreach n [array names headids] {
6569 if {[string match $reflistfilter $n]} {
6570 if {[info exists commitrow($curview,$headids($n))]} {
6571 lappend refs [list $n H]
6573 set commitinterest($headids($n)) {run refill_reflist}
6577 foreach n [array names tagids] {
6578 if {[string match $reflistfilter $n]} {
6579 if {[info exists commitrow($curview,$tagids($n))]} {
6580 lappend refs [list $n T]
6582 set commitinterest($tagids($n)) {run refill_reflist}
6586 foreach n [array names otherrefids] {
6587 if {[string match $reflistfilter $n]} {
6588 if {[info exists commitrow($curview,$otherrefids($n))]} {
6589 lappend refs [list $n o]
6591 set commitinterest($otherrefids($n)) {run refill_reflist}
6595 set refs [lsort -index 0 $refs]
6596 if {$refs eq $reflist} return
6598 # Update the contents of $showrefstop.list according to the
6599 # differences between $reflist (old) and $refs (new)
6600 $showrefstop.list conf -state normal
6601 $showrefstop.list insert end "\n"
6604 while {$i < [llength $reflist] || $j < [llength $refs]} {
6605 if {$i < [llength $reflist]} {
6606 if {$j < [llength $refs]} {
6607 set cmp [string compare [lindex $reflist $i 0] \
6608 [lindex $refs $j 0]]
6610 set cmp [string compare [lindex $reflist $i 1] \
6611 [lindex $refs $j 1]]
6621 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6629 set l [expr {$j + 1}]
6630 $showrefstop.list image create $l.0 -align baseline \
6631 -image reficon-[lindex $refs $j 1] -padx 2
6632 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6638 # delete last newline
6639 $showrefstop.list delete end-2c end-1c
6640 $showrefstop.list conf -state disabled
6643 # Stuff for finding nearby tags
6644 proc getallcommits {} {
6645 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6646 global idheads idtags idotherrefs allparents tagobjid
6648 if {![info exists allcommits]} {
6654 set allccache [file join [gitdir] "gitk.cache"]
6656 set f [open $allccache r]
6665 set cmd [list | git rev-list --parents]
6666 set allcupdate [expr {$seeds ne {}}]
6670 set refs [concat [array names idheads] [array names idtags] \
6671 [array names idotherrefs]]
6674 foreach name [array names tagobjid] {
6675 lappend tagobjs $tagobjid($name)
6677 foreach id [lsort -unique $refs] {
6678 if {![info exists allparents($id)] &&
6679 [lsearch -exact $tagobjs $id] < 0} {
6690 set fd [open [concat $cmd $ids] r]
6691 fconfigure $fd -blocking 0
6694 filerun $fd [list getallclines $fd]
6700 # Since most commits have 1 parent and 1 child, we group strings of
6701 # such commits into "arcs" joining branch/merge points (BMPs), which
6702 # are commits that either don't have 1 parent or don't have 1 child.
6704 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6705 # arcout(id) - outgoing arcs for BMP
6706 # arcids(a) - list of IDs on arc including end but not start
6707 # arcstart(a) - BMP ID at start of arc
6708 # arcend(a) - BMP ID at end of arc
6709 # growing(a) - arc a is still growing
6710 # arctags(a) - IDs out of arcids (excluding end) that have tags
6711 # archeads(a) - IDs out of arcids (excluding end) that have heads
6712 # The start of an arc is at the descendent end, so "incoming" means
6713 # coming from descendents, and "outgoing" means going towards ancestors.
6715 proc getallclines {fd} {
6716 global allparents allchildren idtags idheads nextarc
6717 global arcnos arcids arctags arcout arcend arcstart archeads growing
6718 global seeds allcommits cachedarcs allcupdate
6721 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6722 set id [lindex $line 0]
6723 if {[info exists allparents($id)]} {
6728 set olds [lrange $line 1 end]
6729 set allparents($id) $olds
6730 if {![info exists allchildren($id)]} {
6731 set allchildren($id) {}
6736 if {[llength $olds] == 1 && [llength $a] == 1} {
6737 lappend arcids($a) $id
6738 if {[info exists idtags($id)]} {
6739 lappend arctags($a) $id
6741 if {[info exists idheads($id)]} {
6742 lappend archeads($a) $id
6744 if {[info exists allparents($olds)]} {
6745 # seen parent already
6746 if {![info exists arcout($olds)]} {
6749 lappend arcids($a) $olds
6750 set arcend($a) $olds
6753 lappend allchildren($olds) $id
6754 lappend arcnos($olds) $a
6758 foreach a $arcnos($id) {
6759 lappend arcids($a) $id
6766 lappend allchildren($p) $id
6767 set a [incr nextarc]
6768 set arcstart($a) $id
6775 if {[info exists allparents($p)]} {
6776 # seen it already, may need to make a new branch
6777 if {![info exists arcout($p)]} {
6780 lappend arcids($a) $p
6784 lappend arcnos($p) $a
6789 global cached_dheads cached_dtags cached_atags
6790 catch {unset cached_dheads}
6791 catch {unset cached_dtags}
6792 catch {unset cached_atags}
6795 return [expr {$nid >= 1000? 2: 1}]
6799 fconfigure $fd -blocking 1
6802 # got an error reading the list of commits
6803 # if we were updating, try rereading the whole thing again
6809 error_popup "Error reading commit topology information;\
6810 branch and preceding/following tag information\
6811 will be incomplete.\n($err)"
6814 if {[incr allcommits -1] == 0} {
6824 proc recalcarc {a} {
6825 global arctags archeads arcids idtags idheads
6829 foreach id [lrange $arcids($a) 0 end-1] {
6830 if {[info exists idtags($id)]} {
6833 if {[info exists idheads($id)]} {
6838 set archeads($a) $ah
6842 global arcnos arcids nextarc arctags archeads idtags idheads
6843 global arcstart arcend arcout allparents growing
6846 if {[llength $a] != 1} {
6847 puts "oops splitarc called but [llength $a] arcs already"
6851 set i [lsearch -exact $arcids($a) $p]
6853 puts "oops splitarc $p not in arc $a"
6856 set na [incr nextarc]
6857 if {[info exists arcend($a)]} {
6858 set arcend($na) $arcend($a)
6860 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6861 set j [lsearch -exact $arcnos($l) $a]
6862 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6864 set tail [lrange $arcids($a) [expr {$i+1}] end]
6865 set arcids($a) [lrange $arcids($a) 0 $i]
6867 set arcstart($na) $p
6869 set arcids($na) $tail
6870 if {[info exists growing($a)]} {
6876 if {[llength $arcnos($id)] == 1} {
6879 set j [lsearch -exact $arcnos($id) $a]
6880 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6884 # reconstruct tags and heads lists
6885 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6890 set archeads($na) {}
6894 # Update things for a new commit added that is a child of one
6895 # existing commit. Used when cherry-picking.
6896 proc addnewchild {id p} {
6897 global allparents allchildren idtags nextarc
6898 global arcnos arcids arctags arcout arcend arcstart archeads growing
6899 global seeds allcommits
6901 if {![info exists allcommits]} return
6902 set allparents($id) [list $p]
6903 set allchildren($id) {}
6906 lappend allchildren($p) $id
6907 set a [incr nextarc]
6908 set arcstart($a) $id
6911 set arcids($a) [list $p]
6913 if {![info exists arcout($p)]} {
6916 lappend arcnos($p) $a
6917 set arcout($id) [list $a]
6920 # This implements a cache for the topology information.
6921 # The cache saves, for each arc, the start and end of the arc,
6922 # the ids on the arc, and the outgoing arcs from the end.
6923 proc readcache {f} {
6924 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6925 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6930 if {$lim - $a > 500} {
6931 set lim [expr {$a + 500}]
6935 # finish reading the cache and setting up arctags, etc.
6937 if {$line ne "1"} {error "bad final version"}
6939 foreach id [array names idtags] {
6940 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6941 [llength $allparents($id)] == 1} {
6942 set a [lindex $arcnos($id) 0]
6943 if {$arctags($a) eq {}} {
6948 foreach id [array names idheads] {
6949 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6950 [llength $allparents($id)] == 1} {
6951 set a [lindex $arcnos($id) 0]
6952 if {$archeads($a) eq {}} {
6957 foreach id [lsort -unique $possible_seeds] {
6958 if {$arcnos($id) eq {}} {
6964 while {[incr a] <= $lim} {
6966 if {[llength $line] != 3} {error "bad line"}
6967 set s [lindex $line 0]
6969 lappend arcout($s) $a
6970 if {![info exists arcnos($s)]} {
6971 lappend possible_seeds $s
6974 set e [lindex $line 1]
6979 if {![info exists arcout($e)]} {
6983 set arcids($a) [lindex $line 2]
6984 foreach id $arcids($a) {
6985 lappend allparents($s) $id
6987 lappend arcnos($id) $a
6989 if {![info exists allparents($s)]} {
6990 set allparents($s) {}
6995 set nextarc [expr {$a - 1}]
7008 global nextarc cachedarcs possible_seeds
7012 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7013 # make sure it's an integer
7014 set cachedarcs [expr {int([lindex $line 1])}]
7015 if {$cachedarcs < 0} {error "bad number of arcs"}
7017 set possible_seeds {}
7025 proc dropcache {err} {
7026 global allcwait nextarc cachedarcs seeds
7028 #puts "dropping cache ($err)"
7029 foreach v {arcnos arcout arcids arcstart arcend growing \
7030 arctags archeads allparents allchildren} {
7041 proc writecache {f} {
7042 global cachearc cachedarcs allccache
7043 global arcstart arcend arcnos arcids arcout
7047 if {$lim - $a > 1000} {
7048 set lim [expr {$a + 1000}]
7051 while {[incr a] <= $lim} {
7052 if {[info exists arcend($a)]} {
7053 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7055 puts $f [list $arcstart($a) {} $arcids($a)]
7060 catch {file delete $allccache}
7061 #puts "writing cache failed ($err)"
7064 set cachearc [expr {$a - 1}]
7065 if {$a > $cachedarcs} {
7074 global nextarc cachedarcs cachearc allccache
7076 if {$nextarc == $cachedarcs} return
7078 set cachedarcs $nextarc
7080 set f [open $allccache w]
7081 puts $f [list 1 $cachedarcs]
7086 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7087 # or 0 if neither is true.
7088 proc anc_or_desc {a b} {
7089 global arcout arcstart arcend arcnos cached_isanc
7091 if {$arcnos($a) eq $arcnos($b)} {
7092 # Both are on the same arc(s); either both are the same BMP,
7093 # or if one is not a BMP, the other is also not a BMP or is
7094 # the BMP at end of the arc (and it only has 1 incoming arc).
7095 # Or both can be BMPs with no incoming arcs.
7096 if {$a eq $b || $arcnos($a) eq {}} {
7099 # assert {[llength $arcnos($a)] == 1}
7100 set arc [lindex $arcnos($a) 0]
7101 set i [lsearch -exact $arcids($arc) $a]
7102 set j [lsearch -exact $arcids($arc) $b]
7103 if {$i < 0 || $i > $j} {
7110 if {![info exists arcout($a)]} {
7111 set arc [lindex $arcnos($a) 0]
7112 if {[info exists arcend($arc)]} {
7113 set aend $arcend($arc)
7117 set a $arcstart($arc)
7121 if {![info exists arcout($b)]} {
7122 set arc [lindex $arcnos($b) 0]
7123 if {[info exists arcend($arc)]} {
7124 set bend $arcend($arc)
7128 set b $arcstart($arc)
7138 if {[info exists cached_isanc($a,$bend)]} {
7139 if {$cached_isanc($a,$bend)} {
7143 if {[info exists cached_isanc($b,$aend)]} {
7144 if {$cached_isanc($b,$aend)} {
7147 if {[info exists cached_isanc($a,$bend)]} {
7152 set todo [list $a $b]
7155 for {set i 0} {$i < [llength $todo]} {incr i} {
7156 set x [lindex $todo $i]
7157 if {$anc($x) eq {}} {
7160 foreach arc $arcnos($x) {
7161 set xd $arcstart($arc)
7163 set cached_isanc($a,$bend) 1
7164 set cached_isanc($b,$aend) 0
7166 } elseif {$xd eq $aend} {
7167 set cached_isanc($b,$aend) 1
7168 set cached_isanc($a,$bend) 0
7171 if {![info exists anc($xd)]} {
7172 set anc($xd) $anc($x)
7174 } elseif {$anc($xd) ne $anc($x)} {
7179 set cached_isanc($a,$bend) 0
7180 set cached_isanc($b,$aend) 0
7184 # This identifies whether $desc has an ancestor that is
7185 # a growing tip of the graph and which is not an ancestor of $anc
7186 # and returns 0 if so and 1 if not.
7187 # If we subsequently discover a tag on such a growing tip, and that
7188 # turns out to be a descendent of $anc (which it could, since we
7189 # don't necessarily see children before parents), then $desc
7190 # isn't a good choice to display as a descendent tag of
7191 # $anc (since it is the descendent of another tag which is
7192 # a descendent of $anc). Similarly, $anc isn't a good choice to
7193 # display as a ancestor tag of $desc.
7195 proc is_certain {desc anc} {
7196 global arcnos arcout arcstart arcend growing problems
7199 if {[llength $arcnos($anc)] == 1} {
7200 # tags on the same arc are certain
7201 if {$arcnos($desc) eq $arcnos($anc)} {
7204 if {![info exists arcout($anc)]} {
7205 # if $anc is partway along an arc, use the start of the arc instead
7206 set a [lindex $arcnos($anc) 0]
7207 set anc $arcstart($a)
7210 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7213 set a [lindex $arcnos($desc) 0]
7219 set anclist [list $x]
7223 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7224 set x [lindex $anclist $i]
7229 foreach a $arcout($x) {
7230 if {[info exists growing($a)]} {
7231 if {![info exists growanc($x)] && $dl($x)} {
7237 if {[info exists dl($y)]} {
7241 if {![info exists done($y)]} {
7244 if {[info exists growanc($x)]} {
7248 for {set k 0} {$k < [llength $xl]} {incr k} {
7249 set z [lindex $xl $k]
7250 foreach c $arcout($z) {
7251 if {[info exists arcend($c)]} {
7253 if {[info exists dl($v)] && $dl($v)} {
7255 if {![info exists done($v)]} {
7258 if {[info exists growanc($v)]} {
7268 } elseif {$y eq $anc || !$dl($x)} {
7279 foreach x [array names growanc] {
7288 proc validate_arctags {a} {
7289 global arctags idtags
7293 foreach id $arctags($a) {
7295 if {![info exists idtags($id)]} {
7296 set na [lreplace $na $i $i]
7303 proc validate_archeads {a} {
7304 global archeads idheads
7307 set na $archeads($a)
7308 foreach id $archeads($a) {
7310 if {![info exists idheads($id)]} {
7311 set na [lreplace $na $i $i]
7315 set archeads($a) $na
7318 # Return the list of IDs that have tags that are descendents of id,
7319 # ignoring IDs that are descendents of IDs already reported.
7320 proc desctags {id} {
7321 global arcnos arcstart arcids arctags idtags allparents
7322 global growing cached_dtags
7324 if {![info exists allparents($id)]} {
7327 set t1 [clock clicks -milliseconds]
7329 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7330 # part-way along an arc; check that arc first
7331 set a [lindex $arcnos($id) 0]
7332 if {$arctags($a) ne {}} {
7334 set i [lsearch -exact $arcids($a) $id]
7336 foreach t $arctags($a) {
7337 set j [lsearch -exact $arcids($a) $t]
7345 set id $arcstart($a)
7346 if {[info exists idtags($id)]} {
7350 if {[info exists cached_dtags($id)]} {
7351 return $cached_dtags($id)
7358 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7359 set id [lindex $todo $i]
7361 set ta [info exists hastaggedancestor($id)]
7365 # ignore tags on starting node
7366 if {!$ta && $i > 0} {
7367 if {[info exists idtags($id)]} {
7370 } elseif {[info exists cached_dtags($id)]} {
7371 set tagloc($id) $cached_dtags($id)
7375 foreach a $arcnos($id) {
7377 if {!$ta && $arctags($a) ne {}} {
7379 if {$arctags($a) ne {}} {
7380 lappend tagloc($id) [lindex $arctags($a) end]
7383 if {$ta || $arctags($a) ne {}} {
7384 set tomark [list $d]
7385 for {set j 0} {$j < [llength $tomark]} {incr j} {
7386 set dd [lindex $tomark $j]
7387 if {![info exists hastaggedancestor($dd)]} {
7388 if {[info exists done($dd)]} {
7389 foreach b $arcnos($dd) {
7390 lappend tomark $arcstart($b)
7392 if {[info exists tagloc($dd)]} {
7395 } elseif {[info exists queued($dd)]} {
7398 set hastaggedancestor($dd) 1
7402 if {![info exists queued($d)]} {
7405 if {![info exists hastaggedancestor($d)]} {
7412 foreach id [array names tagloc] {
7413 if {![info exists hastaggedancestor($id)]} {
7414 foreach t $tagloc($id) {
7415 if {[lsearch -exact $tags $t] < 0} {
7421 set t2 [clock clicks -milliseconds]
7424 # remove tags that are descendents of other tags
7425 for {set i 0} {$i < [llength $tags]} {incr i} {
7426 set a [lindex $tags $i]
7427 for {set j 0} {$j < $i} {incr j} {
7428 set b [lindex $tags $j]
7429 set r [anc_or_desc $a $b]
7431 set tags [lreplace $tags $j $j]
7434 } elseif {$r == -1} {
7435 set tags [lreplace $tags $i $i]
7442 if {[array names growing] ne {}} {
7443 # graph isn't finished, need to check if any tag could get
7444 # eclipsed by another tag coming later. Simply ignore any
7445 # tags that could later get eclipsed.
7448 if {[is_certain $t $origid]} {
7452 if {$tags eq $ctags} {
7453 set cached_dtags($origid) $tags
7458 set cached_dtags($origid) $tags
7460 set t3 [clock clicks -milliseconds]
7461 if {0 && $t3 - $t1 >= 100} {
7462 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7463 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7469 global arcnos arcids arcout arcend arctags idtags allparents
7470 global growing cached_atags
7472 if {![info exists allparents($id)]} {
7475 set t1 [clock clicks -milliseconds]
7477 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7478 # part-way along an arc; check that arc first
7479 set a [lindex $arcnos($id) 0]
7480 if {$arctags($a) ne {}} {
7482 set i [lsearch -exact $arcids($a) $id]
7483 foreach t $arctags($a) {
7484 set j [lsearch -exact $arcids($a) $t]
7490 if {![info exists arcend($a)]} {
7494 if {[info exists idtags($id)]} {
7498 if {[info exists cached_atags($id)]} {
7499 return $cached_atags($id)
7507 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7508 set id [lindex $todo $i]
7510 set td [info exists hastaggeddescendent($id)]
7514 # ignore tags on starting node
7515 if {!$td && $i > 0} {
7516 if {[info exists idtags($id)]} {
7519 } elseif {[info exists cached_atags($id)]} {
7520 set tagloc($id) $cached_atags($id)
7524 foreach a $arcout($id) {
7525 if {!$td && $arctags($a) ne {}} {
7527 if {$arctags($a) ne {}} {
7528 lappend tagloc($id) [lindex $arctags($a) 0]
7531 if {![info exists arcend($a)]} continue
7533 if {$td || $arctags($a) ne {}} {
7534 set tomark [list $d]
7535 for {set j 0} {$j < [llength $tomark]} {incr j} {
7536 set dd [lindex $tomark $j]
7537 if {![info exists hastaggeddescendent($dd)]} {
7538 if {[info exists done($dd)]} {
7539 foreach b $arcout($dd) {
7540 if {[info exists arcend($b)]} {
7541 lappend tomark $arcend($b)
7544 if {[info exists tagloc($dd)]} {
7547 } elseif {[info exists queued($dd)]} {
7550 set hastaggeddescendent($dd) 1
7554 if {![info exists queued($d)]} {
7557 if {![info exists hastaggeddescendent($d)]} {
7563 set t2 [clock clicks -milliseconds]
7566 foreach id [array names tagloc] {
7567 if {![info exists hastaggeddescendent($id)]} {
7568 foreach t $tagloc($id) {
7569 if {[lsearch -exact $tags $t] < 0} {
7576 # remove tags that are ancestors of other tags
7577 for {set i 0} {$i < [llength $tags]} {incr i} {
7578 set a [lindex $tags $i]
7579 for {set j 0} {$j < $i} {incr j} {
7580 set b [lindex $tags $j]
7581 set r [anc_or_desc $a $b]
7583 set tags [lreplace $tags $j $j]
7586 } elseif {$r == 1} {
7587 set tags [lreplace $tags $i $i]
7594 if {[array names growing] ne {}} {
7595 # graph isn't finished, need to check if any tag could get
7596 # eclipsed by another tag coming later. Simply ignore any
7597 # tags that could later get eclipsed.
7600 if {[is_certain $origid $t]} {
7604 if {$tags eq $ctags} {
7605 set cached_atags($origid) $tags
7610 set cached_atags($origid) $tags
7612 set t3 [clock clicks -milliseconds]
7613 if {0 && $t3 - $t1 >= 100} {
7614 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7615 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7620 # Return the list of IDs that have heads that are descendents of id,
7621 # including id itself if it has a head.
7622 proc descheads {id} {
7623 global arcnos arcstart arcids archeads idheads cached_dheads
7626 if {![info exists allparents($id)]} {
7630 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7631 # part-way along an arc; check it first
7632 set a [lindex $arcnos($id) 0]
7633 if {$archeads($a) ne {}} {
7634 validate_archeads $a
7635 set i [lsearch -exact $arcids($a) $id]
7636 foreach t $archeads($a) {
7637 set j [lsearch -exact $arcids($a) $t]
7642 set id $arcstart($a)
7648 for {set i 0} {$i < [llength $todo]} {incr i} {
7649 set id [lindex $todo $i]
7650 if {[info exists cached_dheads($id)]} {
7651 set ret [concat $ret $cached_dheads($id)]
7653 if {[info exists idheads($id)]} {
7656 foreach a $arcnos($id) {
7657 if {$archeads($a) ne {}} {
7658 validate_archeads $a
7659 if {$archeads($a) ne {}} {
7660 set ret [concat $ret $archeads($a)]
7664 if {![info exists seen($d)]} {
7671 set ret [lsort -unique $ret]
7672 set cached_dheads($origid) $ret
7673 return [concat $ret $aret]
7676 proc addedtag {id} {
7677 global arcnos arcout cached_dtags cached_atags
7679 if {![info exists arcnos($id)]} return
7680 if {![info exists arcout($id)]} {
7681 recalcarc [lindex $arcnos($id) 0]
7683 catch {unset cached_dtags}
7684 catch {unset cached_atags}
7687 proc addedhead {hid head} {
7688 global arcnos arcout cached_dheads
7690 if {![info exists arcnos($hid)]} return
7691 if {![info exists arcout($hid)]} {
7692 recalcarc [lindex $arcnos($hid) 0]
7694 catch {unset cached_dheads}
7697 proc removedhead {hid head} {
7698 global cached_dheads
7700 catch {unset cached_dheads}
7703 proc movedhead {hid head} {
7704 global arcnos arcout cached_dheads
7706 if {![info exists arcnos($hid)]} return
7707 if {![info exists arcout($hid)]} {
7708 recalcarc [lindex $arcnos($hid) 0]
7710 catch {unset cached_dheads}
7713 proc changedrefs {} {
7714 global cached_dheads cached_dtags cached_atags
7715 global arctags archeads arcnos arcout idheads idtags
7717 foreach id [concat [array names idheads] [array names idtags]] {
7718 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7719 set a [lindex $arcnos($id) 0]
7720 if {![info exists donearc($a)]} {
7726 catch {unset cached_dtags}
7727 catch {unset cached_atags}
7728 catch {unset cached_dheads}
7731 proc rereadrefs {} {
7732 global idtags idheads idotherrefs mainhead
7734 set refids [concat [array names idtags] \
7735 [array names idheads] [array names idotherrefs]]
7736 foreach id $refids {
7737 if {![info exists ref($id)]} {
7738 set ref($id) [listrefs $id]
7741 set oldmainhead $mainhead
7744 set refids [lsort -unique [concat $refids [array names idtags] \
7745 [array names idheads] [array names idotherrefs]]]
7746 foreach id $refids {
7747 set v [listrefs $id]
7748 if {![info exists ref($id)] || $ref($id) != $v ||
7749 ($id eq $oldmainhead && $id ne $mainhead) ||
7750 ($id eq $mainhead && $id ne $oldmainhead)} {
7757 proc listrefs {id} {
7758 global idtags idheads idotherrefs
7761 if {[info exists idtags($id)]} {
7765 if {[info exists idheads($id)]} {
7769 if {[info exists idotherrefs($id)]} {
7770 set z $idotherrefs($id)
7772 return [list $x $y $z]
7775 proc showtag {tag isnew} {
7776 global ctext tagcontents tagids linknum tagobjid
7779 addtohistory [list showtag $tag 0]
7781 $ctext conf -state normal
7784 if {![info exists tagcontents($tag)]} {
7786 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7789 if {[info exists tagcontents($tag)]} {
7790 set text $tagcontents($tag)
7792 set text "Tag: $tag\nId: $tagids($tag)"
7794 appendwithlinks $text {}
7795 $ctext conf -state disabled
7807 global maxwidth maxgraphpct diffopts
7808 global oldprefs prefstop showneartags showlocalchanges
7809 global bgcolor fgcolor ctext diffcolors selectbgcolor
7810 global uifont tabstop
7814 if {[winfo exists $top]} {
7818 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7819 set oldprefs($v) [set $v]
7822 wm title $top "Gitk preferences"
7823 label $top.ldisp -text "Commit list display options"
7824 $top.ldisp configure -font $uifont
7825 grid $top.ldisp - -sticky w -pady 10
7826 label $top.spacer -text " "
7827 label $top.maxwidthl -text "Maximum graph width (lines)" \
7829 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7830 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7831 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7833 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7834 grid x $top.maxpctl $top.maxpct -sticky w
7835 frame $top.showlocal
7836 label $top.showlocal.l -text "Show local changes" -font optionfont
7837 checkbutton $top.showlocal.b -variable showlocalchanges
7838 pack $top.showlocal.b $top.showlocal.l -side left
7839 grid x $top.showlocal -sticky w
7841 label $top.ddisp -text "Diff display options"
7842 $top.ddisp configure -font $uifont
7843 grid $top.ddisp - -sticky w -pady 10
7844 label $top.diffoptl -text "Options for diff program" \
7846 entry $top.diffopt -width 20 -textvariable diffopts
7847 grid x $top.diffoptl $top.diffopt -sticky w
7849 label $top.ntag.l -text "Display nearby tags" -font optionfont
7850 checkbutton $top.ntag.b -variable showneartags
7851 pack $top.ntag.b $top.ntag.l -side left
7852 grid x $top.ntag -sticky w
7853 label $top.tabstopl -text "tabstop" -font optionfont
7854 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7855 grid x $top.tabstopl $top.tabstop -sticky w
7857 label $top.cdisp -text "Colors: press to choose"
7858 $top.cdisp configure -font $uifont
7859 grid $top.cdisp - -sticky w -pady 10
7860 label $top.bg -padx 40 -relief sunk -background $bgcolor
7861 button $top.bgbut -text "Background" -font optionfont \
7862 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7863 grid x $top.bgbut $top.bg -sticky w
7864 label $top.fg -padx 40 -relief sunk -background $fgcolor
7865 button $top.fgbut -text "Foreground" -font optionfont \
7866 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7867 grid x $top.fgbut $top.fg -sticky w
7868 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7869 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7870 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7871 [list $ctext tag conf d0 -foreground]]
7872 grid x $top.diffoldbut $top.diffold -sticky w
7873 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7874 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7875 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7876 [list $ctext tag conf d1 -foreground]]
7877 grid x $top.diffnewbut $top.diffnew -sticky w
7878 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7879 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7880 -command [list choosecolor diffcolors 2 $top.hunksep \
7881 "diff hunk header" \
7882 [list $ctext tag conf hunksep -foreground]]
7883 grid x $top.hunksepbut $top.hunksep -sticky w
7884 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7885 button $top.selbgbut -text "Select bg" -font optionfont \
7886 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7887 grid x $top.selbgbut $top.selbgsep -sticky w
7890 button $top.buts.ok -text "OK" -command prefsok -default active
7891 $top.buts.ok configure -font $uifont
7892 button $top.buts.can -text "Cancel" -command prefscan -default normal
7893 $top.buts.can configure -font $uifont
7894 grid $top.buts.ok $top.buts.can
7895 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7896 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7897 grid $top.buts - - -pady 10 -sticky ew
7898 bind $top <Visibility> "focus $top.buts.ok"
7901 proc choosecolor {v vi w x cmd} {
7904 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7905 -title "Gitk: choose color for $x"]
7906 if {$c eq {}} return
7907 $w conf -background $c
7913 global bglist cflist
7915 $w configure -selectbackground $c
7917 $cflist tag configure highlight \
7918 -background [$cflist cget -selectbackground]
7919 allcanvs itemconf secsel -fill $c
7926 $w conf -background $c
7934 $w conf -foreground $c
7936 allcanvs itemconf text -fill $c
7937 $canv itemconf circle -outline $c
7941 global maxwidth maxgraphpct diffopts
7942 global oldprefs prefstop showneartags showlocalchanges
7944 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7945 set $v $oldprefs($v)
7947 catch {destroy $prefstop}
7952 global maxwidth maxgraphpct
7953 global oldprefs prefstop showneartags showlocalchanges
7954 global charspc ctext tabstop
7956 catch {destroy $prefstop}
7958 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7959 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7960 if {$showlocalchanges} {
7966 if {$maxwidth != $oldprefs(maxwidth)
7967 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7969 } elseif {$showneartags != $oldprefs(showneartags)} {
7974 proc formatdate {d} {
7975 global datetimeformat
7977 set d [clock format $d -format $datetimeformat]
7982 # This list of encoding names and aliases is distilled from
7983 # http://www.iana.org/assignments/character-sets.
7984 # Not all of them are supported by Tcl.
7985 set encoding_aliases {
7986 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7987 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7988 { ISO-10646-UTF-1 csISO10646UTF1 }
7989 { ISO_646.basic:1983 ref csISO646basic1983 }
7990 { INVARIANT csINVARIANT }
7991 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7992 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7993 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7994 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7995 { NATS-DANO iso-ir-9-1 csNATSDANO }
7996 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7997 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7998 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7999 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8000 { ISO-2022-KR csISO2022KR }
8002 { ISO-2022-JP csISO2022JP }
8003 { ISO-2022-JP-2 csISO2022JP2 }
8004 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8006 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8007 { IT iso-ir-15 ISO646-IT csISO15Italian }
8008 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8009 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8010 { greek7-old iso-ir-18 csISO18Greek7Old }
8011 { latin-greek iso-ir-19 csISO19LatinGreek }
8012 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8013 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8014 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8015 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8016 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8017 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8018 { INIS iso-ir-49 csISO49INIS }
8019 { INIS-8 iso-ir-50 csISO50INIS8 }
8020 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8021 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8022 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8023 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8024 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8025 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8027 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8028 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8029 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8030 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8031 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8032 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8033 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8034 { greek7 iso-ir-88 csISO88Greek7 }
8035 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8036 { iso-ir-90 csISO90 }
8037 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8038 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8039 csISO92JISC62991984b }
8040 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8041 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8042 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8043 csISO95JIS62291984handadd }
8044 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8045 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8046 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8047 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8049 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8050 { T.61-7bit iso-ir-102 csISO102T617bit }
8051 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8052 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8053 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8054 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8055 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8056 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8057 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8058 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8059 arabic csISOLatinArabic }
8060 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8061 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8062 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8063 greek greek8 csISOLatinGreek }
8064 { T.101-G2 iso-ir-128 csISO128T101G2 }
8065 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8067 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8068 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8069 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8070 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8071 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8072 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8073 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8074 csISOLatinCyrillic }
8075 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8076 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8077 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8078 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8079 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8080 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8081 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8082 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8083 { ISO_10367-box iso-ir-155 csISO10367Box }
8084 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8085 { latin-lap lap iso-ir-158 csISO158Lap }
8086 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8087 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8090 { JIS_X0201 X0201 csHalfWidthKatakana }
8091 { KSC5636 ISO646-KR csKSC5636 }
8092 { ISO-10646-UCS-2 csUnicode }
8093 { ISO-10646-UCS-4 csUCS4 }
8094 { DEC-MCS dec csDECMCS }
8095 { hp-roman8 roman8 r8 csHPRoman8 }
8096 { macintosh mac csMacintosh }
8097 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8099 { IBM038 EBCDIC-INT cp038 csIBM038 }
8100 { IBM273 CP273 csIBM273 }
8101 { IBM274 EBCDIC-BE CP274 csIBM274 }
8102 { IBM275 EBCDIC-BR cp275 csIBM275 }
8103 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8104 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8105 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8106 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8107 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8108 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8109 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8110 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8111 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8112 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8113 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8114 { IBM437 cp437 437 csPC8CodePage437 }
8115 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8116 { IBM775 cp775 csPC775Baltic }
8117 { IBM850 cp850 850 csPC850Multilingual }
8118 { IBM851 cp851 851 csIBM851 }
8119 { IBM852 cp852 852 csPCp852 }
8120 { IBM855 cp855 855 csIBM855 }
8121 { IBM857 cp857 857 csIBM857 }
8122 { IBM860 cp860 860 csIBM860 }
8123 { IBM861 cp861 861 cp-is csIBM861 }
8124 { IBM862 cp862 862 csPC862LatinHebrew }
8125 { IBM863 cp863 863 csIBM863 }
8126 { IBM864 cp864 csIBM864 }
8127 { IBM865 cp865 865 csIBM865 }
8128 { IBM866 cp866 866 csIBM866 }
8129 { IBM868 CP868 cp-ar csIBM868 }
8130 { IBM869 cp869 869 cp-gr csIBM869 }
8131 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8132 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8133 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8134 { IBM891 cp891 csIBM891 }
8135 { IBM903 cp903 csIBM903 }
8136 { IBM904 cp904 904 csIBBM904 }
8137 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8138 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8139 { IBM1026 CP1026 csIBM1026 }
8140 { EBCDIC-AT-DE csIBMEBCDICATDE }
8141 { EBCDIC-AT-DE-A csEBCDICATDEA }
8142 { EBCDIC-CA-FR csEBCDICCAFR }
8143 { EBCDIC-DK-NO csEBCDICDKNO }
8144 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8145 { EBCDIC-FI-SE csEBCDICFISE }
8146 { EBCDIC-FI-SE-A csEBCDICFISEA }
8147 { EBCDIC-FR csEBCDICFR }
8148 { EBCDIC-IT csEBCDICIT }
8149 { EBCDIC-PT csEBCDICPT }
8150 { EBCDIC-ES csEBCDICES }
8151 { EBCDIC-ES-A csEBCDICESA }
8152 { EBCDIC-ES-S csEBCDICESS }
8153 { EBCDIC-UK csEBCDICUK }
8154 { EBCDIC-US csEBCDICUS }
8155 { UNKNOWN-8BIT csUnknown8BiT }
8156 { MNEMONIC csMnemonic }
8161 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8162 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8163 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8164 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8165 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8166 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8167 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8168 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8169 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8170 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8171 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8172 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8173 { IBM1047 IBM-1047 }
8174 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8175 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8176 { UNICODE-1-1 csUnicode11 }
8179 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8180 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8182 { ISO-8859-15 ISO_8859-15 Latin-9 }
8183 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8184 { GBK CP936 MS936 windows-936 }
8185 { JIS_Encoding csJISEncoding }
8186 { Shift_JIS MS_Kanji csShiftJIS }
8187 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8189 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8190 { ISO-10646-UCS-Basic csUnicodeASCII }
8191 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8192 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8193 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8194 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8195 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8196 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8197 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8198 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8199 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8200 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8201 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8202 { Ventura-US csVenturaUS }
8203 { Ventura-International csVenturaInternational }
8204 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8205 { PC8-Turkish csPC8Turkish }
8206 { IBM-Symbols csIBMSymbols }
8207 { IBM-Thai csIBMThai }
8208 { HP-Legal csHPLegal }
8209 { HP-Pi-font csHPPiFont }
8210 { HP-Math8 csHPMath8 }
8211 { Adobe-Symbol-Encoding csHPPSMath }
8212 { HP-DeskTop csHPDesktop }
8213 { Ventura-Math csVenturaMath }
8214 { Microsoft-Publishing csMicrosoftPublishing }
8215 { Windows-31J csWindows31J }
8220 proc tcl_encoding {enc} {
8221 global encoding_aliases
8222 set names [encoding names]
8223 set lcnames [string tolower $names]
8224 set enc [string tolower $enc]
8225 set i [lsearch -exact $lcnames $enc]
8227 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8228 if {[regsub {^iso[-_]} $enc iso encx]} {
8229 set i [lsearch -exact $lcnames $encx]
8233 foreach l $encoding_aliases {
8234 set ll [string tolower $l]
8235 if {[lsearch -exact $ll $enc] < 0} continue
8236 # look through the aliases for one that tcl knows about
8238 set i [lsearch -exact $lcnames $e]
8240 if {[regsub {^iso[-_]} $e iso ex]} {
8241 set i [lsearch -exact $lcnames $ex]
8250 return [lindex $names $i]
8257 set diffopts "-U 5 -p"
8258 set wrcomcmd "git diff-tree --stdin -p --pretty"
8262 set gitencoding [exec git config --get i18n.commitencoding]
8264 if {$gitencoding == ""} {
8265 set gitencoding "utf-8"
8267 set tclencoding [tcl_encoding $gitencoding]
8268 if {$tclencoding == {}} {
8269 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8272 set mainfont {Helvetica 9}
8273 set textfont {Courier 9}
8274 set uifont {Helvetica 9 bold}
8276 set findmergefiles 0
8284 set cmitmode "patch"
8285 set wrapcomment "none"
8289 set showlocalchanges 1
8290 set datetimeformat "%Y-%m-%d %H:%M:%S"
8292 set colors {green red blue magenta darkgrey brown orange}
8295 set diffcolors {red "#00a000" blue}
8297 set selectbgcolor gray85
8299 catch {source ~/.gitk}
8301 font create optionfont -family sans-serif -size -12
8303 # check that we can find a .git directory somewhere...
8304 if {[catch {set gitdir [gitdir]}]} {
8305 show_error {} . "Cannot find a git repository here."
8308 if {![file isdirectory $gitdir]} {
8309 show_error {} . "Cannot find the git directory \"$gitdir\"."
8314 set cmdline_files {}
8319 "-d" { set datemode 1 }
8321 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8325 lappend revtreeargs $arg
8331 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8332 # no -- on command line, but some arguments (other than -d)
8334 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8335 set cmdline_files [split $f "\n"]
8336 set n [llength $cmdline_files]
8337 set revtreeargs [lrange $revtreeargs 0 end-$n]
8338 # Unfortunately git rev-parse doesn't produce an error when
8339 # something is both a revision and a filename. To be consistent
8340 # with git log and git rev-list, check revtreeargs for filenames.
8341 foreach arg $revtreeargs {
8342 if {[file exists $arg]} {
8343 show_error {} . "Ambiguous argument '$arg': both revision\
8349 # unfortunately we get both stdout and stderr in $err,
8350 # so look for "fatal:".
8351 set i [string first "fatal:" $err]
8353 set err [string range $err [expr {$i + 6}] end]
8355 show_error {} . "Bad arguments to gitk:\n$err"
8360 set nullid "0000000000000000000000000000000000000000"
8361 set nullid2 "0000000000000000000000000000000000000001"
8369 set highlight_paths {}
8371 set searchdirn -forwards
8375 set markingmatches 0
8376 set linkentercount 0
8377 set need_redisplay 0
8383 set selectedhlview None
8384 set highlight_related None
8385 set highlight_files {}
8399 # wait for the window to become visible
8401 wm title . "[file tail $argv0]: [file tail [pwd]]"
8404 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8405 # create a view for the files/dirs specified on the command line
8409 set viewname(1) "Command line"
8410 set viewfiles(1) $cmdline_files
8411 set viewargs(1) $revtreeargs
8414 .bar.view entryconf Edit* -state normal
8415 .bar.view entryconf Delete* -state normal
8418 if {[info exists permviews]} {
8419 foreach v $permviews {
8422 set viewname($n) [lindex $v 0]
8423 set viewfiles($n) [lindex $v 1]
8424 set viewargs($n) [lindex $v 2]