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 lookingforhead showlocalchanges
88 set startmsecs [clock clicks -milliseconds]
89 set commitidx($view) 0
90 set viewcomplete($view) 0
91 set vnextroot($view) 0
92 set order "--topo-order"
94 set order "--date-order"
97 set fd [open [concat | git log -z --pretty=raw $order --parents \
98 --boundary $viewargs($view) "--" $viewfiles($view)] r]
100 error_popup "Error executing git rev-list: $err"
103 set commfd($view) $fd
104 set leftover($view) {}
105 set lookingforhead $showlocalchanges
106 fconfigure $fd -blocking 0 -translation lf -eofchar {}
107 if {$tclencoding != {}} {
108 fconfigure $fd -encoding $tclencoding
110 filerun $fd [list getcommitlines $fd $view]
114 proc stop_rev_list {} {
115 global commfd curview
117 if {![info exists commfd($curview)]} return
118 set fd $commfd($curview)
124 unset commfd($curview)
128 global phase canv mainfont curview
132 start_rev_list $curview
133 show_status "Reading commits..."
136 # This makes a string representation of a positive integer which
137 # sorts as a string in numerical order
140 return [format "%x" $n]
141 } elseif {$n < 256} {
142 return [format "x%.2x" $n]
143 } elseif {$n < 65536} {
144 return [format "y%.4x" $n]
146 return [format "z%.8x" $n]
149 proc getcommitlines {fd view} {
151 global leftover commfd
152 global displayorder commitidx viewcomplete commitrow commitdata
153 global parentlist children curview hlview
154 global vparentlist vdisporder vcmitlisted
155 global ordertok vnextroot idpending
157 set stuff [read $fd 500000]
158 # git log doesn't terminate the last commit with a null...
159 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
166 # Check if we have seen any ids listed as parents that haven't
167 # appeared in the list
168 foreach vid [array names idpending "$view,*"] {
169 # should only get here if git log is buggy
170 set id [lindex [split $vid ","] 1]
171 set commitrow($vid) $commitidx($view)
172 incr commitidx($view)
173 if {$view == $curview} {
174 lappend parentlist {}
175 lappend displayorder $id
176 lappend commitlisted 0
178 lappend vparentlist($view) {}
179 lappend vdisporder($view) $id
180 lappend vcmitlisted($view) 0
183 set viewcomplete($view) 1
187 # set it blocking so we wait for the process to terminate
188 fconfigure $fd -blocking 1
189 if {[catch {close $fd} err]} {
191 if {$view != $curview} {
192 set fv " for the \"$viewname($view)\" view"
194 if {[string range $err 0 4] == "usage"} {
195 set err "Gitk: error reading commits$fv:\
196 bad arguments to git rev-list."
197 if {$viewname($view) eq "Command line"} {
199 " (Note: arguments to gitk are passed to git rev-list\
200 to allow selection of commits to be displayed.)"
203 set err "Error reading commits$fv: $err"
207 if {$view == $curview} {
208 run chewcommits $view
215 set i [string first "\0" $stuff $start]
217 append leftover($view) [string range $stuff $start end]
221 set cmit $leftover($view)
222 append cmit [string range $stuff 0 [expr {$i - 1}]]
223 set leftover($view) {}
225 set cmit [string range $stuff $start [expr {$i - 1}]]
227 set start [expr {$i + 1}]
228 set j [string first "\n" $cmit]
231 if {$j >= 0 && [string match "commit *" $cmit]} {
232 set ids [string range $cmit 7 [expr {$j - 1}]]
233 if {[string match {[-<>]*} $ids]} {
234 switch -- [string index $ids 0] {
239 set ids [string range $ids 1 end]
243 if {[string length $id] != 40} {
251 if {[string length $shortcmit] > 80} {
252 set shortcmit "[string range $shortcmit 0 80]..."
254 error_popup "Can't parse git log output: {$shortcmit}"
257 set id [lindex $ids 0]
258 if {![info exists ordertok($view,$id)]} {
259 set otok "o[strrep $vnextroot($view)]"
260 incr vnextroot($view)
261 set ordertok($view,$id) $otok
263 set otok $ordertok($view,$id)
264 unset idpending($view,$id)
267 set olds [lrange $ids 1 end]
268 if {[llength $olds] == 1} {
269 set p [lindex $olds 0]
270 lappend children($view,$p) $id
271 if {![info exists ordertok($view,$p)]} {
272 set ordertok($view,$p) $ordertok($view,$id)
273 set idpending($view,$p) 1
278 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
279 lappend children($view,$p) $id
281 if {![info exists ordertok($view,$p)]} {
282 set ordertok($view,$p) "$otok[strrep $i]]"
283 set idpending($view,$p) 1
291 if {![info exists children($view,$id)]} {
292 set children($view,$id) {}
294 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
295 set commitrow($view,$id) $commitidx($view)
296 incr commitidx($view)
297 if {$view == $curview} {
298 lappend parentlist $olds
299 lappend displayorder $id
300 lappend commitlisted $listed
302 lappend vparentlist($view) $olds
303 lappend vdisporder($view) $id
304 lappend vcmitlisted($view) $listed
309 run chewcommits $view
314 proc chewcommits {view} {
315 global curview hlview viewcomplete
316 global selectedline pending_select
318 if {$view == $curview} {
320 if {$viewcomplete($view)} {
321 global displayorder commitidx phase
322 global numcommits startmsecs
324 if {[info exists pending_select]} {
325 set row [first_real_row]
328 if {$commitidx($curview) > 0} {
329 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
330 #puts "overall $ms ms for $numcommits commits"
332 show_status "No commits selected"
338 if {[info exists hlview] && $view == $hlview} {
344 proc readcommit {id} {
345 if {[catch {set contents [exec git cat-file commit $id]}]} return
346 parsecommit $id $contents 0
349 proc updatecommits {} {
350 global viewdata curview phase displayorder ordertok idpending
351 global children commitrow selectedline thickerline showneartags
358 foreach id $displayorder {
359 catch {unset children($n,$id)}
360 catch {unset commitrow($n,$id)}
361 catch {unset ordertok($n,$id)}
363 foreach vid [array names idpending "$n,*"] {
364 unset idpending($vid)
367 catch {unset selectedline}
368 catch {unset thickerline}
369 catch {unset viewdata($n)}
378 proc parsecommit {id contents listed} {
379 global commitinfo cdate
388 set hdrend [string first "\n\n" $contents]
390 # should never happen...
391 set hdrend [string length $contents]
393 set header [string range $contents 0 [expr {$hdrend - 1}]]
394 set comment [string range $contents [expr {$hdrend + 2}] end]
395 foreach line [split $header "\n"] {
396 set tag [lindex $line 0]
397 if {$tag == "author"} {
398 set audate [lindex $line end-1]
399 set auname [lrange $line 1 end-2]
400 } elseif {$tag == "committer"} {
401 set comdate [lindex $line end-1]
402 set comname [lrange $line 1 end-2]
406 # take the first non-blank line of the comment as the headline
407 set headline [string trimleft $comment]
408 set i [string first "\n" $headline]
410 set headline [string range $headline 0 $i]
412 set headline [string trimright $headline]
413 set i [string first "\r" $headline]
415 set headline [string trimright [string range $headline 0 $i]]
418 # git rev-list indents the comment by 4 spaces;
419 # if we got this via git cat-file, add the indentation
421 foreach line [split $comment "\n"] {
422 append newcomment " "
423 append newcomment $line
424 append newcomment "\n"
426 set comment $newcomment
428 if {$comdate != {}} {
429 set cdate($id) $comdate
431 set commitinfo($id) [list $headline $auname $audate \
432 $comname $comdate $comment]
435 proc getcommit {id} {
436 global commitdata commitinfo
438 if {[info exists commitdata($id)]} {
439 parsecommit $id $commitdata($id) 1
442 if {![info exists commitinfo($id)]} {
443 set commitinfo($id) {"No commit information available"}
450 global tagids idtags headids idheads tagobjid
451 global otherrefids idotherrefs mainhead mainheadid
453 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
456 set refd [open [list | git show-ref -d] r]
457 while {[gets $refd line] >= 0} {
458 if {[string index $line 40] ne " "} continue
459 set id [string range $line 0 39]
460 set ref [string range $line 41 end]
461 if {![string match "refs/*" $ref]} continue
462 set name [string range $ref 5 end]
463 if {[string match "remotes/*" $name]} {
464 if {![string match "*/HEAD" $name]} {
465 set headids($name) $id
466 lappend idheads($id) $name
468 } elseif {[string match "heads/*" $name]} {
469 set name [string range $name 6 end]
470 set headids($name) $id
471 lappend idheads($id) $name
472 } elseif {[string match "tags/*" $name]} {
473 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
474 # which is what we want since the former is the commit ID
475 set name [string range $name 5 end]
476 if {[string match "*^{}" $name]} {
477 set name [string range $name 0 end-3]
479 set tagobjid($name) $id
481 set tagids($name) $id
482 lappend idtags($id) $name
484 set otherrefids($name) $id
485 lappend idotherrefs($id) $name
492 set thehead [exec git symbolic-ref HEAD]
493 if {[string match "refs/heads/*" $thehead]} {
494 set mainhead [string range $thehead 11 end]
495 if {[info exists headids($mainhead)]} {
496 set mainheadid $headids($mainhead)
502 # skip over fake commits
503 proc first_real_row {} {
504 global nullid nullid2 displayorder numcommits
506 for {set row 0} {$row < $numcommits} {incr row} {
507 set id [lindex $displayorder $row]
508 if {$id ne $nullid && $id ne $nullid2} {
515 # update things for a head moved to a child of its previous location
516 proc movehead {id name} {
517 global headids idheads
519 removehead $headids($name) $name
520 set headids($name) $id
521 lappend idheads($id) $name
524 # update things when a head has been removed
525 proc removehead {id name} {
526 global headids idheads
528 if {$idheads($id) eq $name} {
531 set i [lsearch -exact $idheads($id) $name]
533 set idheads($id) [lreplace $idheads($id) $i $i]
539 proc show_error {w top msg} {
540 message $w.m -text $msg -justify center -aspect 400
541 pack $w.m -side top -fill x -padx 20 -pady 20
542 button $w.ok -text OK -command "destroy $top"
543 pack $w.ok -side bottom -fill x
544 bind $top <Visibility> "grab $top; focus $top"
545 bind $top <Key-Return> "destroy $top"
549 proc error_popup msg {
553 show_error $w $w $msg
556 proc confirm_popup msg {
562 message $w.m -text $msg -justify center -aspect 400
563 pack $w.m -side top -fill x -padx 20 -pady 20
564 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
565 pack $w.ok -side left -fill x
566 button $w.cancel -text Cancel -command "destroy $w"
567 pack $w.cancel -side right -fill x
568 bind $w <Visibility> "grab $w; focus $w"
574 global canv canv2 canv3 linespc charspc ctext cflist
575 global textfont mainfont uifont tabstop
576 global findtype findtypemenu findloc findstring fstring geometry
577 global entries sha1entry sha1string sha1but
578 global diffcontextstring diffcontext
579 global maincursor textcursor curtextcursor
580 global rowctxmenu fakerowmenu mergemax wrapcomment
581 global highlight_files gdttype
582 global searchstring sstring
583 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
587 .bar add cascade -label "File" -menu .bar.file
588 .bar configure -font $uifont
590 .bar.file add command -label "Update" -command updatecommits
591 .bar.file add command -label "Reread references" -command rereadrefs
592 .bar.file add command -label "List references" -command showrefs
593 .bar.file add command -label "Quit" -command doquit
594 .bar.file configure -font $uifont
596 .bar add cascade -label "Edit" -menu .bar.edit
597 .bar.edit add command -label "Preferences" -command doprefs
598 .bar.edit configure -font $uifont
600 menu .bar.view -font $uifont
601 .bar add cascade -label "View" -menu .bar.view
602 .bar.view add command -label "New view..." -command {newview 0}
603 .bar.view add command -label "Edit view..." -command editview \
605 .bar.view add command -label "Delete view" -command delview -state disabled
606 .bar.view add separator
607 .bar.view add radiobutton -label "All files" -command {showview 0} \
608 -variable selectedview -value 0
611 .bar add cascade -label "Help" -menu .bar.help
612 .bar.help add command -label "About gitk" -command about
613 .bar.help add command -label "Key bindings" -command keys
614 .bar.help configure -font $uifont
615 . configure -menu .bar
617 # the gui has upper and lower half, parts of a paned window.
618 panedwindow .ctop -orient vertical
620 # possibly use assumed geometry
621 if {![info exists geometry(pwsash0)]} {
622 set geometry(topheight) [expr {15 * $linespc}]
623 set geometry(topwidth) [expr {80 * $charspc}]
624 set geometry(botheight) [expr {15 * $linespc}]
625 set geometry(botwidth) [expr {50 * $charspc}]
626 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
627 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
630 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
631 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
633 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
635 # create three canvases
636 set cscroll .tf.histframe.csb
637 set canv .tf.histframe.pwclist.canv
639 -selectbackground $selectbgcolor \
640 -background $bgcolor -bd 0 \
641 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
642 .tf.histframe.pwclist add $canv
643 set canv2 .tf.histframe.pwclist.canv2
645 -selectbackground $selectbgcolor \
646 -background $bgcolor -bd 0 -yscrollincr $linespc
647 .tf.histframe.pwclist add $canv2
648 set canv3 .tf.histframe.pwclist.canv3
650 -selectbackground $selectbgcolor \
651 -background $bgcolor -bd 0 -yscrollincr $linespc
652 .tf.histframe.pwclist add $canv3
653 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
654 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
656 # a scroll bar to rule them
657 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
658 pack $cscroll -side right -fill y
659 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
660 lappend bglist $canv $canv2 $canv3
661 pack .tf.histframe.pwclist -fill both -expand 1 -side left
663 # we have two button bars at bottom of top frame. Bar 1
665 frame .tf.lbar -height 15
667 set sha1entry .tf.bar.sha1
668 set entries $sha1entry
669 set sha1but .tf.bar.sha1label
670 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
671 -command gotocommit -width 8 -font $uifont
672 $sha1but conf -disabledforeground [$sha1but cget -foreground]
673 pack .tf.bar.sha1label -side left
674 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
675 trace add variable sha1string write sha1change
676 pack $sha1entry -side left -pady 2
678 image create bitmap bm-left -data {
679 #define left_width 16
680 #define left_height 16
681 static unsigned char left_bits[] = {
682 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
683 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
684 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
686 image create bitmap bm-right -data {
687 #define right_width 16
688 #define right_height 16
689 static unsigned char right_bits[] = {
690 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
691 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
692 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
694 button .tf.bar.leftbut -image bm-left -command goback \
695 -state disabled -width 26
696 pack .tf.bar.leftbut -side left -fill y
697 button .tf.bar.rightbut -image bm-right -command goforw \
698 -state disabled -width 26
699 pack .tf.bar.rightbut -side left -fill y
701 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
702 pack .tf.bar.findbut -side left
704 set fstring .tf.bar.findstring
705 lappend entries $fstring
706 entry $fstring -width 30 -font $textfont -textvariable findstring
707 trace add variable findstring write find_change
708 pack $fstring -side left -expand 1 -fill x -in .tf.bar
710 set findtypemenu [tk_optionMenu .tf.bar.findtype \
711 findtype Exact IgnCase Regexp]
712 trace add variable findtype write find_change
713 .tf.bar.findtype configure -font $uifont
714 .tf.bar.findtype.menu configure -font $uifont
715 set findloc "All fields"
716 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
717 Comments Author Committer
718 trace add variable findloc write find_change
719 .tf.bar.findloc configure -font $uifont
720 .tf.bar.findloc.menu configure -font $uifont
721 pack .tf.bar.findloc -side right
722 pack .tf.bar.findtype -side right
724 # build up the bottom bar of upper window
725 label .tf.lbar.flabel -text "Highlight: Commits " \
727 pack .tf.lbar.flabel -side left -fill y
728 set gdttype "touching paths:"
729 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
730 "adding/removing string:"]
731 trace add variable gdttype write hfiles_change
732 $gm conf -font $uifont
733 .tf.lbar.gdttype conf -font $uifont
734 pack .tf.lbar.gdttype -side left -fill y
735 entry .tf.lbar.fent -width 25 -font $textfont \
736 -textvariable highlight_files
737 trace add variable highlight_files write hfiles_change
738 lappend entries .tf.lbar.fent
739 pack .tf.lbar.fent -side left -fill x -expand 1
740 label .tf.lbar.vlabel -text " OR in view" -font $uifont
741 pack .tf.lbar.vlabel -side left -fill y
742 global viewhlmenu selectedhlview
743 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
744 $viewhlmenu entryconf None -command delvhighlight
745 $viewhlmenu conf -font $uifont
746 .tf.lbar.vhl conf -font $uifont
747 pack .tf.lbar.vhl -side left -fill y
748 label .tf.lbar.rlabel -text " OR " -font $uifont
749 pack .tf.lbar.rlabel -side left -fill y
750 global highlight_related
751 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
752 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
753 $m conf -font $uifont
754 .tf.lbar.relm conf -font $uifont
755 trace add variable highlight_related write vrel_change
756 pack .tf.lbar.relm -side left -fill y
758 # Finish putting the upper half of the viewer together
759 pack .tf.lbar -in .tf -side bottom -fill x
760 pack .tf.bar -in .tf -side bottom -fill x
761 pack .tf.histframe -fill both -side top -expand 1
763 .ctop paneconfigure .tf -height $geometry(topheight)
764 .ctop paneconfigure .tf -width $geometry(topwidth)
766 # now build up the bottom
767 panedwindow .pwbottom -orient horizontal
769 # lower left, a text box over search bar, scroll bar to the right
770 # if we know window height, then that will set the lower text height, otherwise
771 # we set lower text height which will drive window height
772 if {[info exists geometry(main)]} {
773 frame .bleft -width $geometry(botwidth)
775 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
780 button .bleft.top.search -text "Search" -command dosearch \
782 pack .bleft.top.search -side left -padx 5
783 set sstring .bleft.top.sstring
784 entry $sstring -width 20 -font $textfont -textvariable searchstring
785 lappend entries $sstring
786 trace add variable searchstring write incrsearch
787 pack $sstring -side left -expand 1 -fill x
788 radiobutton .bleft.mid.diff -text "Diff" \
789 -command changediffdisp -variable diffelide -value {0 0}
790 radiobutton .bleft.mid.old -text "Old version" \
791 -command changediffdisp -variable diffelide -value {0 1}
792 radiobutton .bleft.mid.new -text "New version" \
793 -command changediffdisp -variable diffelide -value {1 0}
794 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
796 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
797 spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
798 -from 1 -increment 1 -to 10000000 \
799 -validate all -validatecommand "diffcontextvalidate %P" \
800 -textvariable diffcontextstring
801 .bleft.mid.diffcontext set $diffcontext
802 trace add variable diffcontextstring write diffcontextchange
803 lappend entries .bleft.mid.diffcontext
804 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
805 set ctext .bleft.ctext
806 text $ctext -background $bgcolor -foreground $fgcolor \
807 -tabs "[expr {$tabstop * $charspc}]" \
808 -state disabled -font $textfont \
809 -yscrollcommand scrolltext -wrap none
810 scrollbar .bleft.sb -command "$ctext yview"
811 pack .bleft.top -side top -fill x
812 pack .bleft.mid -side top -fill x
813 pack .bleft.sb -side right -fill y
814 pack $ctext -side left -fill both -expand 1
815 lappend bglist $ctext
816 lappend fglist $ctext
818 $ctext tag conf comment -wrap $wrapcomment
819 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
820 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
821 $ctext tag conf d0 -fore [lindex $diffcolors 0]
822 $ctext tag conf d1 -fore [lindex $diffcolors 1]
823 $ctext tag conf m0 -fore red
824 $ctext tag conf m1 -fore blue
825 $ctext tag conf m2 -fore green
826 $ctext tag conf m3 -fore purple
827 $ctext tag conf m4 -fore brown
828 $ctext tag conf m5 -fore "#009090"
829 $ctext tag conf m6 -fore magenta
830 $ctext tag conf m7 -fore "#808000"
831 $ctext tag conf m8 -fore "#009000"
832 $ctext tag conf m9 -fore "#ff0080"
833 $ctext tag conf m10 -fore cyan
834 $ctext tag conf m11 -fore "#b07070"
835 $ctext tag conf m12 -fore "#70b0f0"
836 $ctext tag conf m13 -fore "#70f0b0"
837 $ctext tag conf m14 -fore "#f0b070"
838 $ctext tag conf m15 -fore "#ff70b0"
839 $ctext tag conf mmax -fore darkgrey
841 $ctext tag conf mresult -font [concat $textfont bold]
842 $ctext tag conf msep -font [concat $textfont bold]
843 $ctext tag conf found -back yellow
846 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
851 radiobutton .bright.mode.patch -text "Patch" \
852 -command reselectline -variable cmitmode -value "patch"
853 .bright.mode.patch configure -font $uifont
854 radiobutton .bright.mode.tree -text "Tree" \
855 -command reselectline -variable cmitmode -value "tree"
856 .bright.mode.tree configure -font $uifont
857 grid .bright.mode.patch .bright.mode.tree -sticky ew
858 pack .bright.mode -side top -fill x
859 set cflist .bright.cfiles
860 set indent [font measure $mainfont "nn"]
862 -selectbackground $selectbgcolor \
863 -background $bgcolor -foreground $fgcolor \
865 -tabs [list $indent [expr {2 * $indent}]] \
866 -yscrollcommand ".bright.sb set" \
867 -cursor [. cget -cursor] \
868 -spacing1 1 -spacing3 1
869 lappend bglist $cflist
870 lappend fglist $cflist
871 scrollbar .bright.sb -command "$cflist yview"
872 pack .bright.sb -side right -fill y
873 pack $cflist -side left -fill both -expand 1
874 $cflist tag configure highlight \
875 -background [$cflist cget -selectbackground]
876 $cflist tag configure bold -font [concat $mainfont bold]
878 .pwbottom add .bright
881 # restore window position if known
882 if {[info exists geometry(main)]} {
883 wm geometry . "$geometry(main)"
886 if {[tk windowingsystem] eq {aqua}} {
892 bind .pwbottom <Configure> {resizecdetpanes %W %w}
893 pack .ctop -fill both -expand 1
894 bindall <1> {selcanvline %W %x %y}
895 #bindall <B1-Motion> {selcanvline %W %x %y}
896 if {[tk windowingsystem] == "win32"} {
897 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
898 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
900 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
901 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
903 bindall <2> "canvscan mark %W %x %y"
904 bindall <B2-Motion> "canvscan dragto %W %x %y"
905 bindkey <Home> selfirstline
906 bindkey <End> sellastline
907 bind . <Key-Up> "selnextline -1"
908 bind . <Key-Down> "selnextline 1"
909 bind . <Shift-Key-Up> "next_highlight -1"
910 bind . <Shift-Key-Down> "next_highlight 1"
911 bindkey <Key-Right> "goforw"
912 bindkey <Key-Left> "goback"
913 bind . <Key-Prior> "selnextpage -1"
914 bind . <Key-Next> "selnextpage 1"
915 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
916 bind . <$M1B-End> "allcanvs yview moveto 1.0"
917 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
918 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
919 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
920 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
921 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
922 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
923 bindkey <Key-space> "$ctext yview scroll 1 pages"
924 bindkey p "selnextline -1"
925 bindkey n "selnextline 1"
928 bindkey i "selnextline -1"
929 bindkey k "selnextline 1"
932 bindkey b "$ctext yview scroll -1 pages"
933 bindkey d "$ctext yview scroll 18 units"
934 bindkey u "$ctext yview scroll -18 units"
935 bindkey / {findnext 1}
936 bindkey <Key-Return> {findnext 0}
939 bindkey <F5> updatecommits
940 bind . <$M1B-q> doquit
941 bind . <$M1B-f> dofind
942 bind . <$M1B-g> {findnext 0}
943 bind . <$M1B-r> dosearchback
944 bind . <$M1B-s> dosearch
945 bind . <$M1B-equal> {incrfont 1}
946 bind . <$M1B-KP_Add> {incrfont 1}
947 bind . <$M1B-minus> {incrfont -1}
948 bind . <$M1B-KP_Subtract> {incrfont -1}
949 wm protocol . WM_DELETE_WINDOW doquit
950 bind . <Button-1> "click %W"
951 bind $fstring <Key-Return> dofind
952 bind $sha1entry <Key-Return> gotocommit
953 bind $sha1entry <<PasteSelection>> clearsha1
954 bind $cflist <1> {sel_flist %W %x %y; break}
955 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
956 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
957 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
959 set maincursor [. cget -cursor]
960 set textcursor [$ctext cget -cursor]
961 set curtextcursor $textcursor
963 set rowctxmenu .rowctxmenu
964 menu $rowctxmenu -tearoff 0
965 $rowctxmenu add command -label "Diff this -> selected" \
966 -command {diffvssel 0}
967 $rowctxmenu add command -label "Diff selected -> this" \
968 -command {diffvssel 1}
969 $rowctxmenu add command -label "Make patch" -command mkpatch
970 $rowctxmenu add command -label "Create tag" -command mktag
971 $rowctxmenu add command -label "Write commit to file" -command writecommit
972 $rowctxmenu add command -label "Create new branch" -command mkbranch
973 $rowctxmenu add command -label "Cherry-pick this commit" \
975 $rowctxmenu add command -label "Reset HEAD branch to here" \
978 set fakerowmenu .fakerowmenu
979 menu $fakerowmenu -tearoff 0
980 $fakerowmenu add command -label "Diff this -> selected" \
981 -command {diffvssel 0}
982 $fakerowmenu add command -label "Diff selected -> this" \
983 -command {diffvssel 1}
984 $fakerowmenu add command -label "Make patch" -command mkpatch
985 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
986 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
987 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
989 set headctxmenu .headctxmenu
990 menu $headctxmenu -tearoff 0
991 $headctxmenu add command -label "Check out this branch" \
993 $headctxmenu add command -label "Remove this branch" \
997 set flist_menu .flistctxmenu
998 menu $flist_menu -tearoff 0
999 $flist_menu add command -label "Highlight this too" \
1000 -command {flist_hl 0}
1001 $flist_menu add command -label "Highlight this only" \
1002 -command {flist_hl 1}
1005 # Windows sends all mouse wheel events to the current focused window, not
1006 # the one where the mouse hovers, so bind those events here and redirect
1007 # to the correct window
1008 proc windows_mousewheel_redirector {W X Y D} {
1009 global canv canv2 canv3
1010 set w [winfo containing -displayof $W $X $Y]
1012 set u [expr {$D < 0 ? 5 : -5}]
1013 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1014 allcanvs yview scroll $u units
1017 $w yview scroll $u units
1023 # mouse-2 makes all windows scan vertically, but only the one
1024 # the cursor is in scans horizontally
1025 proc canvscan {op w x y} {
1026 global canv canv2 canv3
1027 foreach c [list $canv $canv2 $canv3] {
1036 proc scrollcanv {cscroll f0 f1} {
1037 $cscroll set $f0 $f1
1042 # when we make a key binding for the toplevel, make sure
1043 # it doesn't get triggered when that key is pressed in the
1044 # find string entry widget.
1045 proc bindkey {ev script} {
1048 set escript [bind Entry $ev]
1049 if {$escript == {}} {
1050 set escript [bind Entry <Key>]
1052 foreach e $entries {
1053 bind $e $ev "$escript; break"
1057 # set the focus back to the toplevel for any click outside
1060 global ctext entries
1061 foreach e [concat $entries $ctext] {
1062 if {$w == $e} return
1067 proc savestuff {w} {
1068 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1069 global stuffsaved findmergefiles maxgraphpct
1070 global maxwidth showneartags showlocalchanges
1071 global viewname viewfiles viewargs viewperm nextviewnum
1072 global cmitmode wrapcomment datetimeformat
1073 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1075 if {$stuffsaved} return
1076 if {![winfo viewable .]} return
1078 set f [open "~/.gitk-new" w]
1079 puts $f [list set mainfont $mainfont]
1080 puts $f [list set textfont $textfont]
1081 puts $f [list set uifont $uifont]
1082 puts $f [list set tabstop $tabstop]
1083 puts $f [list set findmergefiles $findmergefiles]
1084 puts $f [list set maxgraphpct $maxgraphpct]
1085 puts $f [list set maxwidth $maxwidth]
1086 puts $f [list set cmitmode $cmitmode]
1087 puts $f [list set wrapcomment $wrapcomment]
1088 puts $f [list set showneartags $showneartags]
1089 puts $f [list set showlocalchanges $showlocalchanges]
1090 puts $f [list set datetimeformat $datetimeformat]
1091 puts $f [list set bgcolor $bgcolor]
1092 puts $f [list set fgcolor $fgcolor]
1093 puts $f [list set colors $colors]
1094 puts $f [list set diffcolors $diffcolors]
1095 puts $f [list set diffcontext $diffcontext]
1096 puts $f [list set selectbgcolor $selectbgcolor]
1098 puts $f "set geometry(main) [wm geometry .]"
1099 puts $f "set geometry(topwidth) [winfo width .tf]"
1100 puts $f "set geometry(topheight) [winfo height .tf]"
1101 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1102 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1103 puts $f "set geometry(botwidth) [winfo width .bleft]"
1104 puts $f "set geometry(botheight) [winfo height .bleft]"
1106 puts -nonewline $f "set permviews {"
1107 for {set v 0} {$v < $nextviewnum} {incr v} {
1108 if {$viewperm($v)} {
1109 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1114 file rename -force "~/.gitk-new" "~/.gitk"
1119 proc resizeclistpanes {win w} {
1121 if {[info exists oldwidth($win)]} {
1122 set s0 [$win sash coord 0]
1123 set s1 [$win sash coord 1]
1125 set sash0 [expr {int($w/2 - 2)}]
1126 set sash1 [expr {int($w*5/6 - 2)}]
1128 set factor [expr {1.0 * $w / $oldwidth($win)}]
1129 set sash0 [expr {int($factor * [lindex $s0 0])}]
1130 set sash1 [expr {int($factor * [lindex $s1 0])}]
1134 if {$sash1 < $sash0 + 20} {
1135 set sash1 [expr {$sash0 + 20}]
1137 if {$sash1 > $w - 10} {
1138 set sash1 [expr {$w - 10}]
1139 if {$sash0 > $sash1 - 20} {
1140 set sash0 [expr {$sash1 - 20}]
1144 $win sash place 0 $sash0 [lindex $s0 1]
1145 $win sash place 1 $sash1 [lindex $s1 1]
1147 set oldwidth($win) $w
1150 proc resizecdetpanes {win w} {
1152 if {[info exists oldwidth($win)]} {
1153 set s0 [$win sash coord 0]
1155 set sash0 [expr {int($w*3/4 - 2)}]
1157 set factor [expr {1.0 * $w / $oldwidth($win)}]
1158 set sash0 [expr {int($factor * [lindex $s0 0])}]
1162 if {$sash0 > $w - 15} {
1163 set sash0 [expr {$w - 15}]
1166 $win sash place 0 $sash0 [lindex $s0 1]
1168 set oldwidth($win) $w
1171 proc allcanvs args {
1172 global canv canv2 canv3
1178 proc bindall {event action} {
1179 global canv canv2 canv3
1180 bind $canv $event $action
1181 bind $canv2 $event $action
1182 bind $canv3 $event $action
1188 if {[winfo exists $w]} {
1193 wm title $w "About gitk"
1194 message $w.m -text {
1195 Gitk - a commit viewer for git
1197 Copyright © 2005-2006 Paul Mackerras
1199 Use and redistribute under the terms of the GNU General Public License} \
1200 -justify center -aspect 400 -border 2 -bg white -relief groove
1201 pack $w.m -side top -fill x -padx 2 -pady 2
1202 $w.m configure -font $uifont
1203 button $w.ok -text Close -command "destroy $w" -default active
1204 pack $w.ok -side bottom
1205 $w.ok configure -font $uifont
1206 bind $w <Visibility> "focus $w.ok"
1207 bind $w <Key-Escape> "destroy $w"
1208 bind $w <Key-Return> "destroy $w"
1214 if {[winfo exists $w]} {
1218 if {[tk windowingsystem] eq {aqua}} {
1224 wm title $w "Gitk key bindings"
1225 message $w.m -text "
1229 <Home> Move to first commit
1230 <End> Move to last commit
1231 <Up>, p, i Move up one commit
1232 <Down>, n, k Move down one commit
1233 <Left>, z, j Go back in history list
1234 <Right>, x, l Go forward in history list
1235 <PageUp> Move up one page in commit list
1236 <PageDown> Move down one page in commit list
1237 <$M1T-Home> Scroll to top of commit list
1238 <$M1T-End> Scroll to bottom of commit list
1239 <$M1T-Up> Scroll commit list up one line
1240 <$M1T-Down> Scroll commit list down one line
1241 <$M1T-PageUp> Scroll commit list up one page
1242 <$M1T-PageDown> Scroll commit list down one page
1243 <Shift-Up> Move to previous highlighted line
1244 <Shift-Down> Move to next highlighted line
1245 <Delete>, b Scroll diff view up one page
1246 <Backspace> Scroll diff view up one page
1247 <Space> Scroll diff view down one page
1248 u Scroll diff view up 18 lines
1249 d Scroll diff view down 18 lines
1251 <$M1T-G> Move to next find hit
1252 <Return> Move to next find hit
1253 / Move to next find hit, or redo find
1254 ? Move to previous find hit
1255 f Scroll diff view to next file
1256 <$M1T-S> Search for next hit in diff view
1257 <$M1T-R> Search for previous hit in diff view
1258 <$M1T-KP+> Increase font size
1259 <$M1T-plus> Increase font size
1260 <$M1T-KP-> Decrease font size
1261 <$M1T-minus> Decrease font size
1264 -justify left -bg white -border 2 -relief groove
1265 pack $w.m -side top -fill both -padx 2 -pady 2
1266 $w.m configure -font $uifont
1267 button $w.ok -text Close -command "destroy $w" -default active
1268 pack $w.ok -side bottom
1269 $w.ok configure -font $uifont
1270 bind $w <Visibility> "focus $w.ok"
1271 bind $w <Key-Escape> "destroy $w"
1272 bind $w <Key-Return> "destroy $w"
1275 # Procedures for manipulating the file list window at the
1276 # bottom right of the overall window.
1278 proc treeview {w l openlevs} {
1279 global treecontents treediropen treeheight treeparent treeindex
1289 set treecontents() {}
1290 $w conf -state normal
1292 while {[string range $f 0 $prefixend] ne $prefix} {
1293 if {$lev <= $openlevs} {
1294 $w mark set e:$treeindex($prefix) "end -1c"
1295 $w mark gravity e:$treeindex($prefix) left
1297 set treeheight($prefix) $ht
1298 incr ht [lindex $htstack end]
1299 set htstack [lreplace $htstack end end]
1300 set prefixend [lindex $prefendstack end]
1301 set prefendstack [lreplace $prefendstack end end]
1302 set prefix [string range $prefix 0 $prefixend]
1305 set tail [string range $f [expr {$prefixend+1}] end]
1306 while {[set slash [string first "/" $tail]] >= 0} {
1309 lappend prefendstack $prefixend
1310 incr prefixend [expr {$slash + 1}]
1311 set d [string range $tail 0 $slash]
1312 lappend treecontents($prefix) $d
1313 set oldprefix $prefix
1315 set treecontents($prefix) {}
1316 set treeindex($prefix) [incr ix]
1317 set treeparent($prefix) $oldprefix
1318 set tail [string range $tail [expr {$slash+1}] end]
1319 if {$lev <= $openlevs} {
1321 set treediropen($prefix) [expr {$lev < $openlevs}]
1322 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1323 $w mark set d:$ix "end -1c"
1324 $w mark gravity d:$ix left
1326 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1328 $w image create end -align center -image $bm -padx 1 \
1330 $w insert end $d [highlight_tag $prefix]
1331 $w mark set s:$ix "end -1c"
1332 $w mark gravity s:$ix left
1337 if {$lev <= $openlevs} {
1340 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1342 $w insert end $tail [highlight_tag $f]
1344 lappend treecontents($prefix) $tail
1347 while {$htstack ne {}} {
1348 set treeheight($prefix) $ht
1349 incr ht [lindex $htstack end]
1350 set htstack [lreplace $htstack end end]
1351 set prefixend [lindex $prefendstack end]
1352 set prefendstack [lreplace $prefendstack end end]
1353 set prefix [string range $prefix 0 $prefixend]
1355 $w conf -state disabled
1358 proc linetoelt {l} {
1359 global treeheight treecontents
1364 foreach e $treecontents($prefix) {
1369 if {[string index $e end] eq "/"} {
1370 set n $treeheight($prefix$e)
1382 proc highlight_tree {y prefix} {
1383 global treeheight treecontents cflist
1385 foreach e $treecontents($prefix) {
1387 if {[highlight_tag $path] ne {}} {
1388 $cflist tag add bold $y.0 "$y.0 lineend"
1391 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1392 set y [highlight_tree $y $path]
1398 proc treeclosedir {w dir} {
1399 global treediropen treeheight treeparent treeindex
1401 set ix $treeindex($dir)
1402 $w conf -state normal
1403 $w delete s:$ix e:$ix
1404 set treediropen($dir) 0
1405 $w image configure a:$ix -image tri-rt
1406 $w conf -state disabled
1407 set n [expr {1 - $treeheight($dir)}]
1408 while {$dir ne {}} {
1409 incr treeheight($dir) $n
1410 set dir $treeparent($dir)
1414 proc treeopendir {w dir} {
1415 global treediropen treeheight treeparent treecontents treeindex
1417 set ix $treeindex($dir)
1418 $w conf -state normal
1419 $w image configure a:$ix -image tri-dn
1420 $w mark set e:$ix s:$ix
1421 $w mark gravity e:$ix right
1424 set n [llength $treecontents($dir)]
1425 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1428 incr treeheight($x) $n
1430 foreach e $treecontents($dir) {
1432 if {[string index $e end] eq "/"} {
1433 set iy $treeindex($de)
1434 $w mark set d:$iy e:$ix
1435 $w mark gravity d:$iy left
1436 $w insert e:$ix $str
1437 set treediropen($de) 0
1438 $w image create e:$ix -align center -image tri-rt -padx 1 \
1440 $w insert e:$ix $e [highlight_tag $de]
1441 $w mark set s:$iy e:$ix
1442 $w mark gravity s:$iy left
1443 set treeheight($de) 1
1445 $w insert e:$ix $str
1446 $w insert e:$ix $e [highlight_tag $de]
1449 $w mark gravity e:$ix left
1450 $w conf -state disabled
1451 set treediropen($dir) 1
1452 set top [lindex [split [$w index @0,0] .] 0]
1453 set ht [$w cget -height]
1454 set l [lindex [split [$w index s:$ix] .] 0]
1457 } elseif {$l + $n + 1 > $top + $ht} {
1458 set top [expr {$l + $n + 2 - $ht}]
1466 proc treeclick {w x y} {
1467 global treediropen cmitmode ctext cflist cflist_top
1469 if {$cmitmode ne "tree"} return
1470 if {![info exists cflist_top]} return
1471 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1472 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1473 $cflist tag add highlight $l.0 "$l.0 lineend"
1479 set e [linetoelt $l]
1480 if {[string index $e end] ne "/"} {
1482 } elseif {$treediropen($e)} {
1489 proc setfilelist {id} {
1490 global treefilelist cflist
1492 treeview $cflist $treefilelist($id) 0
1495 image create bitmap tri-rt -background black -foreground blue -data {
1496 #define tri-rt_width 13
1497 #define tri-rt_height 13
1498 static unsigned char tri-rt_bits[] = {
1499 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1500 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1503 #define tri-rt-mask_width 13
1504 #define tri-rt-mask_height 13
1505 static unsigned char tri-rt-mask_bits[] = {
1506 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1507 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1510 image create bitmap tri-dn -background black -foreground blue -data {
1511 #define tri-dn_width 13
1512 #define tri-dn_height 13
1513 static unsigned char tri-dn_bits[] = {
1514 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1515 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1518 #define tri-dn-mask_width 13
1519 #define tri-dn-mask_height 13
1520 static unsigned char tri-dn-mask_bits[] = {
1521 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1522 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1526 image create bitmap reficon-T -background black -foreground yellow -data {
1527 #define tagicon_width 13
1528 #define tagicon_height 9
1529 static unsigned char tagicon_bits[] = {
1530 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1531 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1533 #define tagicon-mask_width 13
1534 #define tagicon-mask_height 9
1535 static unsigned char tagicon-mask_bits[] = {
1536 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1537 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1540 #define headicon_width 13
1541 #define headicon_height 9
1542 static unsigned char headicon_bits[] = {
1543 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1544 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1547 #define headicon-mask_width 13
1548 #define headicon-mask_height 9
1549 static unsigned char headicon-mask_bits[] = {
1550 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1551 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1553 image create bitmap reficon-H -background black -foreground green \
1554 -data $rectdata -maskdata $rectmask
1555 image create bitmap reficon-o -background black -foreground "#ddddff" \
1556 -data $rectdata -maskdata $rectmask
1558 proc init_flist {first} {
1559 global cflist cflist_top selectedline difffilestart
1561 $cflist conf -state normal
1562 $cflist delete 0.0 end
1564 $cflist insert end $first
1566 $cflist tag add highlight 1.0 "1.0 lineend"
1568 catch {unset cflist_top}
1570 $cflist conf -state disabled
1571 set difffilestart {}
1574 proc highlight_tag {f} {
1575 global highlight_paths
1577 foreach p $highlight_paths {
1578 if {[string match $p $f]} {
1585 proc highlight_filelist {} {
1586 global cmitmode cflist
1588 $cflist conf -state normal
1589 if {$cmitmode ne "tree"} {
1590 set end [lindex [split [$cflist index end] .] 0]
1591 for {set l 2} {$l < $end} {incr l} {
1592 set line [$cflist get $l.0 "$l.0 lineend"]
1593 if {[highlight_tag $line] ne {}} {
1594 $cflist tag add bold $l.0 "$l.0 lineend"
1600 $cflist conf -state disabled
1603 proc unhighlight_filelist {} {
1606 $cflist conf -state normal
1607 $cflist tag remove bold 1.0 end
1608 $cflist conf -state disabled
1611 proc add_flist {fl} {
1614 $cflist conf -state normal
1616 $cflist insert end "\n"
1617 $cflist insert end $f [highlight_tag $f]
1619 $cflist conf -state disabled
1622 proc sel_flist {w x y} {
1623 global ctext difffilestart cflist cflist_top cmitmode
1625 if {$cmitmode eq "tree"} return
1626 if {![info exists cflist_top]} return
1627 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1628 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1629 $cflist tag add highlight $l.0 "$l.0 lineend"
1634 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1638 proc pop_flist_menu {w X Y x y} {
1639 global ctext cflist cmitmode flist_menu flist_menu_file
1640 global treediffs diffids
1642 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1644 if {$cmitmode eq "tree"} {
1645 set e [linetoelt $l]
1646 if {[string index $e end] eq "/"} return
1648 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1650 set flist_menu_file $e
1651 tk_popup $flist_menu $X $Y
1654 proc flist_hl {only} {
1655 global flist_menu_file highlight_files
1657 set x [shellquote $flist_menu_file]
1658 if {$only || $highlight_files eq {}} {
1659 set highlight_files $x
1661 append highlight_files " " $x
1665 # Functions for adding and removing shell-type quoting
1667 proc shellquote {str} {
1668 if {![string match "*\['\"\\ \t]*" $str]} {
1671 if {![string match "*\['\"\\]*" $str]} {
1674 if {![string match "*'*" $str]} {
1677 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1680 proc shellarglist {l} {
1686 append str [shellquote $a]
1691 proc shelldequote {str} {
1696 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1697 append ret [string range $str $used end]
1698 set used [string length $str]
1701 set first [lindex $first 0]
1702 set ch [string index $str $first]
1703 if {$first > $used} {
1704 append ret [string range $str $used [expr {$first - 1}]]
1707 if {$ch eq " " || $ch eq "\t"} break
1710 set first [string first "'" $str $used]
1712 error "unmatched single-quote"
1714 append ret [string range $str $used [expr {$first - 1}]]
1719 if {$used >= [string length $str]} {
1720 error "trailing backslash"
1722 append ret [string index $str $used]
1727 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1728 error "unmatched double-quote"
1730 set first [lindex $first 0]
1731 set ch [string index $str $first]
1732 if {$first > $used} {
1733 append ret [string range $str $used [expr {$first - 1}]]
1736 if {$ch eq "\""} break
1738 append ret [string index $str $used]
1742 return [list $used $ret]
1745 proc shellsplit {str} {
1748 set str [string trimleft $str]
1749 if {$str eq {}} break
1750 set dq [shelldequote $str]
1751 set n [lindex $dq 0]
1752 set word [lindex $dq 1]
1753 set str [string range $str $n end]
1759 # Code to implement multiple views
1761 proc newview {ishighlight} {
1762 global nextviewnum newviewname newviewperm uifont newishighlight
1763 global newviewargs revtreeargs
1765 set newishighlight $ishighlight
1767 if {[winfo exists $top]} {
1771 set newviewname($nextviewnum) "View $nextviewnum"
1772 set newviewperm($nextviewnum) 0
1773 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1774 vieweditor $top $nextviewnum "Gitk view definition"
1779 global viewname viewperm newviewname newviewperm
1780 global viewargs newviewargs
1782 set top .gitkvedit-$curview
1783 if {[winfo exists $top]} {
1787 set newviewname($curview) $viewname($curview)
1788 set newviewperm($curview) $viewperm($curview)
1789 set newviewargs($curview) [shellarglist $viewargs($curview)]
1790 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1793 proc vieweditor {top n title} {
1794 global newviewname newviewperm viewfiles
1798 wm title $top $title
1799 label $top.nl -text "Name" -font $uifont
1800 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1801 grid $top.nl $top.name -sticky w -pady 5
1802 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1804 grid $top.perm - -pady 5 -sticky w
1805 message $top.al -aspect 1000 -font $uifont \
1806 -text "Commits to include (arguments to git rev-list):"
1807 grid $top.al - -sticky w -pady 5
1808 entry $top.args -width 50 -textvariable newviewargs($n) \
1809 -background white -font $uifont
1810 grid $top.args - -sticky ew -padx 5
1811 message $top.l -aspect 1000 -font $uifont \
1812 -text "Enter files and directories to include, one per line:"
1813 grid $top.l - -sticky w
1814 text $top.t -width 40 -height 10 -background white -font $uifont
1815 if {[info exists viewfiles($n)]} {
1816 foreach f $viewfiles($n) {
1817 $top.t insert end $f
1818 $top.t insert end "\n"
1820 $top.t delete {end - 1c} end
1821 $top.t mark set insert 0.0
1823 grid $top.t - -sticky ew -padx 5
1825 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1827 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1829 grid $top.buts.ok $top.buts.can
1830 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1831 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1832 grid $top.buts - -pady 10 -sticky ew
1836 proc doviewmenu {m first cmd op argv} {
1837 set nmenu [$m index end]
1838 for {set i $first} {$i <= $nmenu} {incr i} {
1839 if {[$m entrycget $i -command] eq $cmd} {
1840 eval $m $op $i $argv
1846 proc allviewmenus {n op args} {
1849 doviewmenu .bar.view 5 [list showview $n] $op $args
1850 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1853 proc newviewok {top n} {
1854 global nextviewnum newviewperm newviewname newishighlight
1855 global viewname viewfiles viewperm selectedview curview
1856 global viewargs newviewargs viewhlmenu
1859 set newargs [shellsplit $newviewargs($n)]
1861 error_popup "Error in commit selection arguments: $err"
1867 foreach f [split [$top.t get 0.0 end] "\n"] {
1868 set ft [string trim $f]
1873 if {![info exists viewfiles($n)]} {
1874 # creating a new view
1876 set viewname($n) $newviewname($n)
1877 set viewperm($n) $newviewperm($n)
1878 set viewfiles($n) $files
1879 set viewargs($n) $newargs
1881 if {!$newishighlight} {
1884 run addvhighlight $n
1887 # editing an existing view
1888 set viewperm($n) $newviewperm($n)
1889 if {$newviewname($n) ne $viewname($n)} {
1890 set viewname($n) $newviewname($n)
1891 doviewmenu .bar.view 5 [list showview $n] \
1892 entryconf [list -label $viewname($n)]
1893 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1894 entryconf [list -label $viewname($n) -value $viewname($n)]
1896 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1897 set viewfiles($n) $files
1898 set viewargs($n) $newargs
1899 if {$curview == $n} {
1904 catch {destroy $top}
1908 global curview viewdata viewperm hlview selectedhlview
1910 if {$curview == 0} return
1911 if {[info exists hlview] && $hlview == $curview} {
1912 set selectedhlview None
1915 allviewmenus $curview delete
1916 set viewdata($curview) {}
1917 set viewperm($curview) 0
1921 proc addviewmenu {n} {
1922 global viewname viewhlmenu
1924 .bar.view add radiobutton -label $viewname($n) \
1925 -command [list showview $n] -variable selectedview -value $n
1926 $viewhlmenu add radiobutton -label $viewname($n) \
1927 -command [list addvhighlight $n] -variable selectedhlview
1930 proc flatten {var} {
1934 foreach i [array names $var] {
1935 lappend ret $i [set $var\($i\)]
1940 proc unflatten {var l} {
1950 global curview viewdata viewfiles
1951 global displayorder parentlist rowidlist rowisopt rowfinal
1952 global colormap rowtextx commitrow nextcolor canvxmax
1953 global numcommits commitlisted
1954 global selectedline currentid canv canvy0
1956 global pending_select phase
1959 global selectedview selectfirst
1960 global vparentlist vdisporder vcmitlisted
1961 global hlview selectedhlview commitinterest
1963 if {$n == $curview} return
1965 if {[info exists selectedline]} {
1966 set selid $currentid
1967 set y [yc $selectedline]
1968 set ymax [lindex [$canv cget -scrollregion] 3]
1969 set span [$canv yview]
1970 set ytop [expr {[lindex $span 0] * $ymax}]
1971 set ybot [expr {[lindex $span 1] * $ymax}]
1972 if {$ytop < $y && $y < $ybot} {
1973 set yscreen [expr {$y - $ytop}]
1975 set yscreen [expr {($ybot - $ytop) / 2}]
1977 } elseif {[info exists pending_select]} {
1978 set selid $pending_select
1979 unset pending_select
1983 if {$curview >= 0} {
1984 set vparentlist($curview) $parentlist
1985 set vdisporder($curview) $displayorder
1986 set vcmitlisted($curview) $commitlisted
1988 ![info exists viewdata($curview)] ||
1989 [lindex $viewdata($curview) 0] ne {}} {
1990 set viewdata($curview) \
1991 [list $phase $rowidlist $rowisopt $rowfinal]
1994 catch {unset treediffs}
1996 if {[info exists hlview] && $hlview == $n} {
1998 set selectedhlview None
2000 catch {unset commitinterest}
2004 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2005 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2008 if {![info exists viewdata($n)]} {
2010 set pending_select $selid
2017 set phase [lindex $v 0]
2018 set displayorder $vdisporder($n)
2019 set parentlist $vparentlist($n)
2020 set commitlisted $vcmitlisted($n)
2021 set rowidlist [lindex $v 1]
2022 set rowisopt [lindex $v 2]
2023 set rowfinal [lindex $v 3]
2024 set numcommits $commitidx($n)
2026 catch {unset colormap}
2027 catch {unset rowtextx}
2029 set canvxmax [$canv cget -width]
2036 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2037 set row $commitrow($n,$selid)
2038 # try to get the selected row in the same position on the screen
2039 set ymax [lindex [$canv cget -scrollregion] 3]
2040 set ytop [expr {[yc $row] - $yscreen}]
2044 set yf [expr {$ytop * 1.0 / $ymax}]
2046 allcanvs yview moveto $yf
2050 } elseif {$selid ne {}} {
2051 set pending_select $selid
2053 set row [first_real_row]
2054 if {$row < $numcommits} {
2061 if {$phase eq "getcommits"} {
2062 show_status "Reading commits..."
2065 } elseif {$numcommits == 0} {
2066 show_status "No commits selected"
2070 # Stuff relating to the highlighting facility
2072 proc ishighlighted {row} {
2073 global vhighlights fhighlights nhighlights rhighlights
2075 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2076 return $nhighlights($row)
2078 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2079 return $vhighlights($row)
2081 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2082 return $fhighlights($row)
2084 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2085 return $rhighlights($row)
2090 proc bolden {row font} {
2091 global canv linehtag selectedline boldrows
2093 lappend boldrows $row
2094 $canv itemconf $linehtag($row) -font $font
2095 if {[info exists selectedline] && $row == $selectedline} {
2097 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2098 -outline {{}} -tags secsel \
2099 -fill [$canv cget -selectbackground]]
2104 proc bolden_name {row font} {
2105 global canv2 linentag selectedline boldnamerows
2107 lappend boldnamerows $row
2108 $canv2 itemconf $linentag($row) -font $font
2109 if {[info exists selectedline] && $row == $selectedline} {
2110 $canv2 delete secsel
2111 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2112 -outline {{}} -tags secsel \
2113 -fill [$canv2 cget -selectbackground]]
2119 global mainfont boldrows
2122 foreach row $boldrows {
2123 if {![ishighlighted $row]} {
2124 bolden $row $mainfont
2126 lappend stillbold $row
2129 set boldrows $stillbold
2132 proc addvhighlight {n} {
2133 global hlview curview viewdata vhl_done vhighlights commitidx
2135 if {[info exists hlview]} {
2139 if {$n != $curview && ![info exists viewdata($n)]} {
2140 set viewdata($n) [list getcommits {{}} 0 0 0]
2141 set vparentlist($n) {}
2142 set vdisporder($n) {}
2143 set vcmitlisted($n) {}
2146 set vhl_done $commitidx($hlview)
2147 if {$vhl_done > 0} {
2152 proc delvhighlight {} {
2153 global hlview vhighlights
2155 if {![info exists hlview]} return
2157 catch {unset vhighlights}
2161 proc vhighlightmore {} {
2162 global hlview vhl_done commitidx vhighlights
2163 global displayorder vdisporder curview mainfont
2165 set font [concat $mainfont bold]
2166 set max $commitidx($hlview)
2167 if {$hlview == $curview} {
2168 set disp $displayorder
2170 set disp $vdisporder($hlview)
2172 set vr [visiblerows]
2173 set r0 [lindex $vr 0]
2174 set r1 [lindex $vr 1]
2175 for {set i $vhl_done} {$i < $max} {incr i} {
2176 set id [lindex $disp $i]
2177 if {[info exists commitrow($curview,$id)]} {
2178 set row $commitrow($curview,$id)
2179 if {$r0 <= $row && $row <= $r1} {
2180 if {![highlighted $row]} {
2183 set vhighlights($row) 1
2190 proc askvhighlight {row id} {
2191 global hlview vhighlights commitrow iddrawn mainfont
2193 if {[info exists commitrow($hlview,$id)]} {
2194 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2195 bolden $row [concat $mainfont bold]
2197 set vhighlights($row) 1
2199 set vhighlights($row) 0
2203 proc hfiles_change {name ix op} {
2204 global highlight_files filehighlight fhighlights fh_serial
2205 global mainfont highlight_paths
2207 if {[info exists filehighlight]} {
2208 # delete previous highlights
2209 catch {close $filehighlight}
2211 catch {unset fhighlights}
2213 unhighlight_filelist
2215 set highlight_paths {}
2216 after cancel do_file_hl $fh_serial
2218 if {$highlight_files ne {}} {
2219 after 300 do_file_hl $fh_serial
2223 proc makepatterns {l} {
2226 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2227 if {[string index $ee end] eq "/"} {
2237 proc do_file_hl {serial} {
2238 global highlight_files filehighlight highlight_paths gdttype fhl_list
2240 if {$gdttype eq "touching paths:"} {
2241 if {[catch {set paths [shellsplit $highlight_files]}]} return
2242 set highlight_paths [makepatterns $paths]
2244 set gdtargs [concat -- $paths]
2246 set gdtargs [list "-S$highlight_files"]
2248 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2249 set filehighlight [open $cmd r+]
2250 fconfigure $filehighlight -blocking 0
2251 filerun $filehighlight readfhighlight
2257 proc flushhighlights {} {
2258 global filehighlight fhl_list
2260 if {[info exists filehighlight]} {
2262 puts $filehighlight ""
2263 flush $filehighlight
2267 proc askfilehighlight {row id} {
2268 global filehighlight fhighlights fhl_list
2270 lappend fhl_list $id
2271 set fhighlights($row) -1
2272 puts $filehighlight $id
2275 proc readfhighlight {} {
2276 global filehighlight fhighlights commitrow curview mainfont iddrawn
2279 if {![info exists filehighlight]} {
2283 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2284 set line [string trim $line]
2285 set i [lsearch -exact $fhl_list $line]
2286 if {$i < 0} continue
2287 for {set j 0} {$j < $i} {incr j} {
2288 set id [lindex $fhl_list $j]
2289 if {[info exists commitrow($curview,$id)]} {
2290 set fhighlights($commitrow($curview,$id)) 0
2293 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2294 if {$line eq {}} continue
2295 if {![info exists commitrow($curview,$line)]} continue
2296 set row $commitrow($curview,$line)
2297 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2298 bolden $row [concat $mainfont bold]
2300 set fhighlights($row) 1
2302 if {[eof $filehighlight]} {
2304 puts "oops, git diff-tree died"
2305 catch {close $filehighlight}
2313 proc find_change {name ix op} {
2314 global nhighlights mainfont boldnamerows
2315 global findstring findpattern findtype
2317 # delete previous highlights, if any
2318 foreach row $boldnamerows {
2319 bolden_name $row $mainfont
2322 catch {unset nhighlights}
2325 if {$findtype ne "Regexp"} {
2326 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2328 set findpattern "*$e*"
2333 proc doesmatch {f} {
2334 global findtype findstring findpattern
2336 if {$findtype eq "Regexp"} {
2337 return [regexp $findstring $f]
2338 } elseif {$findtype eq "IgnCase"} {
2339 return [string match -nocase $findpattern $f]
2341 return [string match $findpattern $f]
2345 proc askfindhighlight {row id} {
2346 global nhighlights commitinfo iddrawn mainfont
2348 global markingmatches
2350 if {![info exists commitinfo($id)]} {
2353 set info $commitinfo($id)
2355 set fldtypes {Headline Author Date Committer CDate Comments}
2356 foreach f $info ty $fldtypes {
2357 if {($findloc eq "All fields" || $findloc eq $ty) &&
2359 if {$ty eq "Author"} {
2366 if {$isbold && [info exists iddrawn($id)]} {
2367 set f [concat $mainfont bold]
2368 if {![ishighlighted $row]} {
2374 if {$markingmatches} {
2375 markrowmatches $row $id
2378 set nhighlights($row) $isbold
2381 proc markrowmatches {row id} {
2382 global canv canv2 linehtag linentag commitinfo findloc
2384 set headline [lindex $commitinfo($id) 0]
2385 set author [lindex $commitinfo($id) 1]
2386 $canv delete match$row
2387 $canv2 delete match$row
2388 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2389 set m [findmatches $headline]
2391 markmatches $canv $row $headline $linehtag($row) $m \
2392 [$canv itemcget $linehtag($row) -font] $row
2395 if {$findloc eq "All fields" || $findloc eq "Author"} {
2396 set m [findmatches $author]
2398 markmatches $canv2 $row $author $linentag($row) $m \
2399 [$canv2 itemcget $linentag($row) -font] $row
2404 proc vrel_change {name ix op} {
2405 global highlight_related
2408 if {$highlight_related ne "None"} {
2413 # prepare for testing whether commits are descendents or ancestors of a
2414 proc rhighlight_sel {a} {
2415 global descendent desc_todo ancestor anc_todo
2416 global highlight_related rhighlights
2418 catch {unset descendent}
2419 set desc_todo [list $a]
2420 catch {unset ancestor}
2421 set anc_todo [list $a]
2422 if {$highlight_related ne "None"} {
2428 proc rhighlight_none {} {
2431 catch {unset rhighlights}
2435 proc is_descendent {a} {
2436 global curview children commitrow descendent desc_todo
2439 set la $commitrow($v,$a)
2443 for {set i 0} {$i < [llength $todo]} {incr i} {
2444 set do [lindex $todo $i]
2445 if {$commitrow($v,$do) < $la} {
2446 lappend leftover $do
2449 foreach nk $children($v,$do) {
2450 if {![info exists descendent($nk)]} {
2451 set descendent($nk) 1
2459 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2463 set descendent($a) 0
2464 set desc_todo $leftover
2467 proc is_ancestor {a} {
2468 global curview parentlist commitrow ancestor anc_todo
2471 set la $commitrow($v,$a)
2475 for {set i 0} {$i < [llength $todo]} {incr i} {
2476 set do [lindex $todo $i]
2477 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2478 lappend leftover $do
2481 foreach np [lindex $parentlist $commitrow($v,$do)] {
2482 if {![info exists ancestor($np)]} {
2491 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2496 set anc_todo $leftover
2499 proc askrelhighlight {row id} {
2500 global descendent highlight_related iddrawn mainfont rhighlights
2501 global selectedline ancestor
2503 if {![info exists selectedline]} return
2505 if {$highlight_related eq "Descendent" ||
2506 $highlight_related eq "Not descendent"} {
2507 if {![info exists descendent($id)]} {
2510 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2513 } elseif {$highlight_related eq "Ancestor" ||
2514 $highlight_related eq "Not ancestor"} {
2515 if {![info exists ancestor($id)]} {
2518 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2522 if {[info exists iddrawn($id)]} {
2523 if {$isbold && ![ishighlighted $row]} {
2524 bolden $row [concat $mainfont bold]
2527 set rhighlights($row) $isbold
2530 proc next_hlcont {} {
2531 global fhl_row fhl_dirn displayorder numcommits
2532 global vhighlights fhighlights nhighlights rhighlights
2533 global hlview filehighlight findstring highlight_related
2535 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2538 if {$row < 0 || $row >= $numcommits} {
2543 set id [lindex $displayorder $row]
2544 if {[info exists hlview]} {
2545 if {![info exists vhighlights($row)]} {
2546 askvhighlight $row $id
2548 if {$vhighlights($row) > 0} break
2550 if {$findstring ne {}} {
2551 if {![info exists nhighlights($row)]} {
2552 askfindhighlight $row $id
2554 if {$nhighlights($row) > 0} break
2556 if {$highlight_related ne "None"} {
2557 if {![info exists rhighlights($row)]} {
2558 askrelhighlight $row $id
2560 if {$rhighlights($row) > 0} break
2562 if {[info exists filehighlight]} {
2563 if {![info exists fhighlights($row)]} {
2564 # ask for a few more while we're at it...
2566 for {set n 0} {$n < 100} {incr n} {
2567 if {![info exists fhighlights($r)]} {
2568 askfilehighlight $r [lindex $displayorder $r]
2571 if {$r < 0 || $r >= $numcommits} break
2575 if {$fhighlights($row) < 0} {
2579 if {$fhighlights($row) > 0} break
2587 proc next_highlight {dirn} {
2588 global selectedline fhl_row fhl_dirn
2589 global hlview filehighlight findstring highlight_related
2591 if {![info exists selectedline]} return
2592 if {!([info exists hlview] || $findstring ne {} ||
2593 $highlight_related ne "None" || [info exists filehighlight])} return
2594 set fhl_row [expr {$selectedline + $dirn}]
2599 proc cancel_next_highlight {} {
2605 # Graph layout functions
2607 proc shortids {ids} {
2610 if {[llength $id] > 1} {
2611 lappend res [shortids $id]
2612 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2613 lappend res [string range $id 0 7]
2624 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2625 if {($n & $mask) != 0} {
2626 set ret [concat $ret $o]
2628 set o [concat $o $o]
2633 # Work out where id should go in idlist so that order-token
2634 # values increase from left to right
2635 proc idcol {idlist id {i 0}} {
2636 global ordertok curview
2638 set t $ordertok($curview,$id)
2639 if {$i >= [llength $idlist] ||
2640 $t < $ordertok($curview,[lindex $idlist $i])} {
2641 if {$i > [llength $idlist]} {
2642 set i [llength $idlist]
2644 while {[incr i -1] >= 0 &&
2645 $t < $ordertok($curview,[lindex $idlist $i])} {}
2648 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2649 while {[incr i] < [llength $idlist] &&
2650 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2656 proc initlayout {} {
2657 global rowidlist rowisopt rowfinal displayorder commitlisted
2658 global numcommits canvxmax canv
2661 global colormap rowtextx
2672 set canvxmax [$canv cget -width]
2673 catch {unset colormap}
2674 catch {unset rowtextx}
2678 proc setcanvscroll {} {
2679 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2681 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2682 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2683 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2684 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2687 proc visiblerows {} {
2688 global canv numcommits linespc
2690 set ymax [lindex [$canv cget -scrollregion] 3]
2691 if {$ymax eq {} || $ymax == 0} return
2693 set y0 [expr {int([lindex $f 0] * $ymax)}]
2694 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2698 set y1 [expr {int([lindex $f 1] * $ymax)}]
2699 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2700 if {$r1 >= $numcommits} {
2701 set r1 [expr {$numcommits - 1}]
2703 return [list $r0 $r1]
2706 proc layoutmore {} {
2707 global commitidx viewcomplete numcommits
2708 global uparrowlen downarrowlen mingaplen curview
2710 set show $commitidx($curview)
2711 if {$show > $numcommits} {
2712 showstuff $show $viewcomplete($curview)
2716 proc showstuff {canshow last} {
2717 global numcommits commitrow pending_select selectedline curview
2718 global lookingforhead mainheadid displayorder selectfirst
2719 global lastscrollset commitinterest
2721 if {$numcommits == 0} {
2723 set phase "incrdraw"
2726 for {set l $numcommits} {$l < $canshow} {incr l} {
2727 set id [lindex $displayorder $l]
2728 if {[info exists commitinterest($id)]} {
2729 foreach script $commitinterest($id) {
2730 eval [string map [list "%I" $id] $script]
2732 unset commitinterest($id)
2736 set prev $numcommits
2737 set numcommits $canshow
2738 set t [clock clicks -milliseconds]
2739 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2740 set lastscrollset $t
2743 set rows [visiblerows]
2744 set r1 [lindex $rows 1]
2745 if {$r1 >= $canshow} {
2746 set r1 [expr {$canshow - 1}]
2751 if {[info exists pending_select] &&
2752 [info exists commitrow($curview,$pending_select)] &&
2753 $commitrow($curview,$pending_select) < $numcommits} {
2754 selectline $commitrow($curview,$pending_select) 1
2757 if {[info exists selectedline] || [info exists pending_select]} {
2760 set l [first_real_row]
2765 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2766 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2767 set lookingforhead 0
2772 proc doshowlocalchanges {} {
2773 global lookingforhead curview mainheadid phase commitrow
2775 if {[info exists commitrow($curview,$mainheadid)] &&
2776 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2778 } elseif {$phase ne {}} {
2779 set lookingforhead 1
2783 proc dohidelocalchanges {} {
2784 global lookingforhead localfrow localirow lserial
2786 set lookingforhead 0
2787 if {$localfrow >= 0} {
2788 removerow $localfrow
2790 if {$localirow > 0} {
2794 if {$localirow >= 0} {
2795 removerow $localirow
2801 # spawn off a process to do git diff-index --cached HEAD
2802 proc dodiffindex {} {
2803 global localirow localfrow lserial
2808 set fd [open "|git diff-index --cached HEAD" r]
2809 fconfigure $fd -blocking 0
2810 filerun $fd [list readdiffindex $fd $lserial]
2813 proc readdiffindex {fd serial} {
2814 global localirow commitrow mainheadid nullid2 curview
2815 global commitinfo commitdata lserial
2818 if {[gets $fd line] < 0} {
2824 # we only need to see one line and we don't really care what it says...
2827 # now see if there are any local changes not checked in to the index
2828 if {$serial == $lserial} {
2829 set fd [open "|git diff-files" r]
2830 fconfigure $fd -blocking 0
2831 filerun $fd [list readdifffiles $fd $serial]
2834 if {$isdiff && $serial == $lserial && $localirow == -1} {
2835 # add the line for the changes in the index to the graph
2836 set localirow $commitrow($curview,$mainheadid)
2837 set hl "Local changes checked in to index but not committed"
2838 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2839 set commitdata($nullid2) "\n $hl\n"
2840 insertrow $localirow $nullid2
2845 proc readdifffiles {fd serial} {
2846 global localirow localfrow commitrow mainheadid nullid curview
2847 global commitinfo commitdata lserial
2850 if {[gets $fd line] < 0} {
2856 # we only need to see one line and we don't really care what it says...
2859 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2860 # add the line for the local diff to the graph
2861 if {$localirow >= 0} {
2862 set localfrow $localirow
2865 set localfrow $commitrow($curview,$mainheadid)
2867 set hl "Local uncommitted changes, not checked in to index"
2868 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2869 set commitdata($nullid) "\n $hl\n"
2870 insertrow $localfrow $nullid
2875 proc nextuse {id row} {
2876 global commitrow curview children
2878 if {[info exists children($curview,$id)]} {
2879 foreach kid $children($curview,$id) {
2880 if {![info exists commitrow($curview,$kid)]} {
2883 if {$commitrow($curview,$kid) > $row} {
2884 return $commitrow($curview,$kid)
2888 if {[info exists commitrow($curview,$id)]} {
2889 return $commitrow($curview,$id)
2894 proc prevuse {id row} {
2895 global commitrow curview children
2898 if {[info exists children($curview,$id)]} {
2899 foreach kid $children($curview,$id) {
2900 if {![info exists commitrow($curview,$kid)]} break
2901 if {$commitrow($curview,$kid) < $row} {
2902 set ret $commitrow($curview,$kid)
2909 proc make_idlist {row} {
2910 global displayorder parentlist uparrowlen downarrowlen mingaplen
2911 global commitidx curview ordertok children commitrow
2913 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2917 set ra [expr {$row - $downarrowlen}]
2921 set rb [expr {$row + $uparrowlen}]
2922 if {$rb > $commitidx($curview)} {
2923 set rb $commitidx($curview)
2926 for {} {$r < $ra} {incr r} {
2927 set nextid [lindex $displayorder [expr {$r + 1}]]
2928 foreach p [lindex $parentlist $r] {
2929 if {$p eq $nextid} continue
2930 set rn [nextuse $p $r]
2932 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2933 lappend ids [list $ordertok($curview,$p) $p]
2937 for {} {$r < $row} {incr r} {
2938 set nextid [lindex $displayorder [expr {$r + 1}]]
2939 foreach p [lindex $parentlist $r] {
2940 if {$p eq $nextid} continue
2941 set rn [nextuse $p $r]
2942 if {$rn < 0 || $rn >= $row} {
2943 lappend ids [list $ordertok($curview,$p) $p]
2947 set id [lindex $displayorder $row]
2948 lappend ids [list $ordertok($curview,$id) $id]
2950 foreach p [lindex $parentlist $r] {
2951 set firstkid [lindex $children($curview,$p) 0]
2952 if {$commitrow($curview,$firstkid) < $row} {
2953 lappend ids [list $ordertok($curview,$p) $p]
2957 set id [lindex $displayorder $r]
2959 set firstkid [lindex $children($curview,$id) 0]
2960 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
2961 lappend ids [list $ordertok($curview,$id) $id]
2966 foreach idx [lsort -unique $ids] {
2967 lappend idlist [lindex $idx 1]
2972 proc rowsequal {a b} {
2973 while {[set i [lsearch -exact $a {}]] >= 0} {
2974 set a [lreplace $a $i $i]
2976 while {[set i [lsearch -exact $b {}]] >= 0} {
2977 set b [lreplace $b $i $i]
2979 return [expr {$a eq $b}]
2982 proc makeupline {id row rend col} {
2983 global rowidlist uparrowlen downarrowlen mingaplen
2985 for {set r $rend} {1} {set r $rstart} {
2986 set rstart [prevuse $id $r]
2987 if {$rstart < 0} return
2988 if {$rstart < $row} break
2990 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
2991 set rstart [expr {$rend - $uparrowlen - 1}]
2993 for {set r $rstart} {[incr r] <= $row} {} {
2994 set idlist [lindex $rowidlist $r]
2995 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
2996 set col [idcol $idlist $id $col]
2997 lset rowidlist $r [linsert $idlist $col $id]
3003 proc layoutrows {row endrow} {
3004 global rowidlist rowisopt rowfinal displayorder
3005 global uparrowlen downarrowlen maxwidth mingaplen
3006 global children parentlist
3007 global commitidx viewcomplete curview commitrow
3011 set rm1 [expr {$row - 1}]
3012 foreach id [lindex $rowidlist $rm1] {
3017 set final [lindex $rowfinal $rm1]
3019 for {} {$row < $endrow} {incr row} {
3020 set rm1 [expr {$row - 1}]
3021 if {$rm1 < 0 || $idlist eq {}} {
3022 set idlist [make_idlist $row]
3025 set id [lindex $displayorder $rm1]
3026 set col [lsearch -exact $idlist $id]
3027 set idlist [lreplace $idlist $col $col]
3028 foreach p [lindex $parentlist $rm1] {
3029 if {[lsearch -exact $idlist $p] < 0} {
3030 set col [idcol $idlist $p $col]
3031 set idlist [linsert $idlist $col $p]
3032 # if not the first child, we have to insert a line going up
3033 if {$id ne [lindex $children($curview,$p) 0]} {
3034 makeupline $p $rm1 $row $col
3038 set id [lindex $displayorder $row]
3039 if {$row > $downarrowlen} {
3040 set termrow [expr {$row - $downarrowlen - 1}]
3041 foreach p [lindex $parentlist $termrow] {
3042 set i [lsearch -exact $idlist $p]
3043 if {$i < 0} continue
3044 set nr [nextuse $p $termrow]
3045 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3046 set idlist [lreplace $idlist $i $i]
3050 set col [lsearch -exact $idlist $id]
3052 set col [idcol $idlist $id]
3053 set idlist [linsert $idlist $col $id]
3054 if {$children($curview,$id) ne {}} {
3055 makeupline $id $rm1 $row $col
3058 set r [expr {$row + $uparrowlen - 1}]
3059 if {$r < $commitidx($curview)} {
3061 foreach p [lindex $parentlist $r] {
3062 if {[lsearch -exact $idlist $p] >= 0} continue
3063 set fk [lindex $children($curview,$p) 0]
3064 if {$commitrow($curview,$fk) < $row} {
3065 set x [idcol $idlist $p $x]
3066 set idlist [linsert $idlist $x $p]
3069 if {[incr r] < $commitidx($curview)} {
3070 set p [lindex $displayorder $r]
3071 if {[lsearch -exact $idlist $p] < 0} {
3072 set fk [lindex $children($curview,$p) 0]
3073 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3074 set x [idcol $idlist $p $x]
3075 set idlist [linsert $idlist $x $p]
3081 if {$final && !$viewcomplete($curview) &&
3082 $row + $uparrowlen + $mingaplen + $downarrowlen
3083 >= $commitidx($curview)} {
3086 set l [llength $rowidlist]
3088 lappend rowidlist $idlist
3090 lappend rowfinal $final
3091 } elseif {$row < $l} {
3092 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3093 lset rowidlist $row $idlist
3096 lset rowfinal $row $final
3098 set pad [ntimes [expr {$row - $l}] {}]
3099 set rowidlist [concat $rowidlist $pad]
3100 lappend rowidlist $idlist
3101 set rowfinal [concat $rowfinal $pad]
3102 lappend rowfinal $final
3103 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3109 proc changedrow {row} {
3110 global displayorder iddrawn rowisopt need_redisplay
3112 set l [llength $rowisopt]
3114 lset rowisopt $row 0
3115 if {$row + 1 < $l} {
3116 lset rowisopt [expr {$row + 1}] 0
3117 if {$row + 2 < $l} {
3118 lset rowisopt [expr {$row + 2}] 0
3122 set id [lindex $displayorder $row]
3123 if {[info exists iddrawn($id)]} {
3124 set need_redisplay 1
3128 proc insert_pad {row col npad} {
3131 set pad [ntimes $npad {}]
3132 set idlist [lindex $rowidlist $row]
3133 set bef [lrange $idlist 0 [expr {$col - 1}]]
3134 set aft [lrange $idlist $col end]
3135 set i [lsearch -exact $aft {}]
3137 set aft [lreplace $aft $i $i]
3139 lset rowidlist $row [concat $bef $pad $aft]
3143 proc optimize_rows {row col endrow} {
3144 global rowidlist rowisopt displayorder curview children
3149 for {} {$row < $endrow} {incr row; set col 0} {
3150 if {[lindex $rowisopt $row]} continue
3152 set y0 [expr {$row - 1}]
3153 set ym [expr {$row - 2}]
3154 set idlist [lindex $rowidlist $row]
3155 set previdlist [lindex $rowidlist $y0]
3156 if {$idlist eq {} || $previdlist eq {}} continue
3158 set pprevidlist [lindex $rowidlist $ym]
3159 if {$pprevidlist eq {}} continue
3165 for {} {$col < [llength $idlist]} {incr col} {
3166 set id [lindex $idlist $col]
3167 if {[lindex $previdlist $col] eq $id} continue
3172 set x0 [lsearch -exact $previdlist $id]
3173 if {$x0 < 0} continue
3174 set z [expr {$x0 - $col}]
3178 set xm [lsearch -exact $pprevidlist $id]
3180 set z0 [expr {$xm - $x0}]
3184 # if row y0 is the first child of $id then it's not an arrow
3185 if {[lindex $children($curview,$id) 0] ne
3186 [lindex $displayorder $y0]} {
3190 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3191 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3194 # Looking at lines from this row to the previous row,
3195 # make them go straight up if they end in an arrow on
3196 # the previous row; otherwise make them go straight up
3198 if {$z < -1 || ($z < 0 && $isarrow)} {
3199 # Line currently goes left too much;
3200 # insert pads in the previous row, then optimize it
3201 set npad [expr {-1 - $z + $isarrow}]
3202 insert_pad $y0 $x0 $npad
3204 optimize_rows $y0 $x0 $row
3206 set previdlist [lindex $rowidlist $y0]
3207 set x0 [lsearch -exact $previdlist $id]
3208 set z [expr {$x0 - $col}]
3210 set pprevidlist [lindex $rowidlist $ym]
3211 set xm [lsearch -exact $pprevidlist $id]
3212 set z0 [expr {$xm - $x0}]
3214 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3215 # Line currently goes right too much;
3216 # insert pads in this line
3217 set npad [expr {$z - 1 + $isarrow}]
3218 insert_pad $row $col $npad
3219 set idlist [lindex $rowidlist $row]
3221 set z [expr {$x0 - $col}]
3224 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3225 # this line links to its first child on row $row-2
3226 set id [lindex $displayorder $ym]
3227 set xc [lsearch -exact $pprevidlist $id]
3229 set z0 [expr {$xc - $x0}]
3232 # avoid lines jigging left then immediately right
3233 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3234 insert_pad $y0 $x0 1
3236 optimize_rows $y0 $x0 $row
3237 set previdlist [lindex $rowidlist $y0]
3241 # Find the first column that doesn't have a line going right
3242 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3243 set id [lindex $idlist $col]
3244 if {$id eq {}} break
3245 set x0 [lsearch -exact $previdlist $id]
3247 # check if this is the link to the first child
3248 set kid [lindex $displayorder $y0]
3249 if {[lindex $children($curview,$id) 0] eq $kid} {
3250 # it is, work out offset to child
3251 set x0 [lsearch -exact $previdlist $kid]
3254 if {$x0 <= $col} break
3256 # Insert a pad at that column as long as it has a line and
3257 # isn't the last column
3258 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3259 set idlist [linsert $idlist $col {}]
3260 lset rowidlist $row $idlist
3268 global canvx0 linespc
3269 return [expr {$canvx0 + $col * $linespc}]
3273 global canvy0 linespc
3274 return [expr {$canvy0 + $row * $linespc}]
3277 proc linewidth {id} {
3278 global thickerline lthickness
3281 if {[info exists thickerline] && $id eq $thickerline} {
3282 set wid [expr {2 * $lthickness}]
3287 proc rowranges {id} {
3288 global commitrow curview children uparrowlen downarrowlen
3291 set kids $children($curview,$id)
3297 foreach child $kids {
3298 if {![info exists commitrow($curview,$child)]} break
3299 set row $commitrow($curview,$child)
3300 if {![info exists prev]} {
3301 lappend ret [expr {$row + 1}]
3303 if {$row <= $prevrow} {
3304 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3306 # see if the line extends the whole way from prevrow to row
3307 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3308 [lsearch -exact [lindex $rowidlist \
3309 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3310 # it doesn't, see where it ends
3311 set r [expr {$prevrow + $downarrowlen}]
3312 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3313 while {[incr r -1] > $prevrow &&
3314 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3316 while {[incr r] <= $row &&
3317 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3321 # see where it starts up again
3322 set r [expr {$row - $uparrowlen}]
3323 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3324 while {[incr r] < $row &&
3325 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3327 while {[incr r -1] >= $prevrow &&
3328 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3334 if {$child eq $id} {
3343 proc drawlineseg {id row endrow arrowlow} {
3344 global rowidlist displayorder iddrawn linesegs
3345 global canv colormap linespc curview maxlinelen parentlist
3347 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3348 set le [expr {$row + 1}]
3351 set c [lsearch -exact [lindex $rowidlist $le] $id]
3357 set x [lindex $displayorder $le]
3362 if {[info exists iddrawn($x)] || $le == $endrow} {
3363 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3379 if {[info exists linesegs($id)]} {
3380 set lines $linesegs($id)
3382 set r0 [lindex $li 0]
3384 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3394 set li [lindex $lines [expr {$i-1}]]
3395 set r1 [lindex $li 1]
3396 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3401 set x [lindex $cols [expr {$le - $row}]]
3402 set xp [lindex $cols [expr {$le - 1 - $row}]]
3403 set dir [expr {$xp - $x}]
3405 set ith [lindex $lines $i 2]
3406 set coords [$canv coords $ith]
3407 set ah [$canv itemcget $ith -arrow]
3408 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3409 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3410 if {$x2 ne {} && $x - $x2 == $dir} {
3411 set coords [lrange $coords 0 end-2]
3414 set coords [list [xc $le $x] [yc $le]]
3417 set itl [lindex $lines [expr {$i-1}] 2]
3418 set al [$canv itemcget $itl -arrow]
3419 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3420 } elseif {$arrowlow} {
3421 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3422 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3426 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3427 for {set y $le} {[incr y -1] > $row} {} {
3429 set xp [lindex $cols [expr {$y - 1 - $row}]]
3430 set ndir [expr {$xp - $x}]
3431 if {$dir != $ndir || $xp < 0} {
3432 lappend coords [xc $y $x] [yc $y]
3438 # join parent line to first child
3439 set ch [lindex $displayorder $row]
3440 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3442 puts "oops: drawlineseg: child $ch not on row $row"
3443 } elseif {$xc != $x} {
3444 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3445 set d [expr {int(0.5 * $linespc)}]
3448 set x2 [expr {$x1 - $d}]
3450 set x2 [expr {$x1 + $d}]
3453 set y1 [expr {$y2 + $d}]
3454 lappend coords $x1 $y1 $x2 $y2
3455 } elseif {$xc < $x - 1} {
3456 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3457 } elseif {$xc > $x + 1} {
3458 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3462 lappend coords [xc $row $x] [yc $row]
3464 set xn [xc $row $xp]
3466 lappend coords $xn $yn
3470 set t [$canv create line $coords -width [linewidth $id] \
3471 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3474 set lines [linsert $lines $i [list $row $le $t]]
3476 $canv coords $ith $coords
3477 if {$arrow ne $ah} {
3478 $canv itemconf $ith -arrow $arrow
3480 lset lines $i 0 $row
3483 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3484 set ndir [expr {$xo - $xp}]
3485 set clow [$canv coords $itl]
3486 if {$dir == $ndir} {
3487 set clow [lrange $clow 2 end]
3489 set coords [concat $coords $clow]
3491 lset lines [expr {$i-1}] 1 $le
3493 # coalesce two pieces
3495 set b [lindex $lines [expr {$i-1}] 0]
3496 set e [lindex $lines $i 1]
3497 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3499 $canv coords $itl $coords
3500 if {$arrow ne $al} {
3501 $canv itemconf $itl -arrow $arrow
3505 set linesegs($id) $lines
3509 proc drawparentlinks {id row} {
3510 global rowidlist canv colormap curview parentlist
3511 global idpos linespc
3513 set rowids [lindex $rowidlist $row]
3514 set col [lsearch -exact $rowids $id]
3515 if {$col < 0} return
3516 set olds [lindex $parentlist $row]
3517 set row2 [expr {$row + 1}]
3518 set x [xc $row $col]
3521 set d [expr {int(0.5 * $linespc)}]
3522 set ymid [expr {$y + $d}]
3523 set ids [lindex $rowidlist $row2]
3524 # rmx = right-most X coord used
3527 set i [lsearch -exact $ids $p]
3529 puts "oops, parent $p of $id not in list"
3532 set x2 [xc $row2 $i]
3536 set j [lsearch -exact $rowids $p]
3538 # drawlineseg will do this one for us
3542 # should handle duplicated parents here...
3543 set coords [list $x $y]
3545 # if attaching to a vertical segment, draw a smaller
3546 # slant for visual distinctness
3549 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3551 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3553 } elseif {$i < $col && $i < $j} {
3554 # segment slants towards us already
3555 lappend coords [xc $row $j] $y
3557 if {$i < $col - 1} {
3558 lappend coords [expr {$x2 + $linespc}] $y
3559 } elseif {$i > $col + 1} {
3560 lappend coords [expr {$x2 - $linespc}] $y
3562 lappend coords $x2 $y2
3565 lappend coords $x2 $y2
3567 set t [$canv create line $coords -width [linewidth $p] \
3568 -fill $colormap($p) -tags lines.$p]
3572 if {$rmx > [lindex $idpos($id) 1]} {
3573 lset idpos($id) 1 $rmx
3578 proc drawlines {id} {
3581 $canv itemconf lines.$id -width [linewidth $id]
3584 proc drawcmittext {id row col} {
3585 global linespc canv canv2 canv3 canvy0 fgcolor curview
3586 global commitlisted commitinfo rowidlist parentlist
3587 global rowtextx idpos idtags idheads idotherrefs
3588 global linehtag linentag linedtag selectedline
3589 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3591 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3592 set listed [lindex $commitlisted $row]
3593 if {$id eq $nullid} {
3595 } elseif {$id eq $nullid2} {
3598 set ofill [expr {$listed != 0? "blue": "white"}]
3600 set x [xc $row $col]
3602 set orad [expr {$linespc / 3}]
3604 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3605 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3606 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3607 } elseif {$listed == 2} {
3608 # triangle pointing left for left-side commits
3609 set t [$canv create polygon \
3610 [expr {$x - $orad}] $y \
3611 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3612 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3613 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3615 # triangle pointing right for right-side commits
3616 set t [$canv create polygon \
3617 [expr {$x + $orad - 1}] $y \
3618 [expr {$x - $orad}] [expr {$y - $orad}] \
3619 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3620 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3623 $canv bind $t <1> {selcanvline {} %x %y}
3624 set rmx [llength [lindex $rowidlist $row]]
3625 set olds [lindex $parentlist $row]
3627 set nextids [lindex $rowidlist [expr {$row + 1}]]
3629 set i [lsearch -exact $nextids $p]
3635 set xt [xc $row $rmx]
3636 set rowtextx($row) $xt
3637 set idpos($id) [list $x $xt $y]
3638 if {[info exists idtags($id)] || [info exists idheads($id)]
3639 || [info exists idotherrefs($id)]} {
3640 set xt [drawtags $id $x $xt $y]
3642 set headline [lindex $commitinfo($id) 0]
3643 set name [lindex $commitinfo($id) 1]
3644 set date [lindex $commitinfo($id) 2]
3645 set date [formatdate $date]
3648 set isbold [ishighlighted $row]
3650 lappend boldrows $row
3653 lappend boldnamerows $row
3657 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3658 -text $headline -font $font -tags text]
3659 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3660 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3661 -text $name -font $nfont -tags text]
3662 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3663 -text $date -font $mainfont -tags text]
3664 if {[info exists selectedline] && $selectedline == $row} {
3667 set xr [expr {$xt + [font measure $mainfont $headline]}]
3668 if {$xr > $canvxmax} {
3674 proc drawcmitrow {row} {
3675 global displayorder rowidlist nrows_drawn
3676 global iddrawn markingmatches
3677 global commitinfo parentlist numcommits
3678 global filehighlight fhighlights findstring nhighlights
3679 global hlview vhighlights
3680 global highlight_related rhighlights
3682 if {$row >= $numcommits} return
3684 set id [lindex $displayorder $row]
3685 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3686 askvhighlight $row $id
3688 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3689 askfilehighlight $row $id
3691 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3692 askfindhighlight $row $id
3694 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3695 askrelhighlight $row $id
3697 if {![info exists iddrawn($id)]} {
3698 set col [lsearch -exact [lindex $rowidlist $row] $id]
3700 puts "oops, row $row id $id not in list"
3703 if {![info exists commitinfo($id)]} {
3707 drawcmittext $id $row $col
3711 if {$markingmatches} {
3712 markrowmatches $row $id
3716 proc drawcommits {row {endrow {}}} {
3717 global numcommits iddrawn displayorder curview need_redisplay
3718 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3723 if {$endrow eq {}} {
3726 if {$endrow >= $numcommits} {
3727 set endrow [expr {$numcommits - 1}]
3730 set rl1 [expr {$row - $downarrowlen - 3}]
3734 set ro1 [expr {$row - 3}]
3738 set r2 [expr {$endrow + $uparrowlen + 3}]
3739 if {$r2 > $numcommits} {
3742 for {set r $rl1} {$r < $r2} {incr r} {
3743 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3747 set rl1 [expr {$r + 1}]
3753 optimize_rows $ro1 0 $r2
3754 if {$need_redisplay || $nrows_drawn > 2000} {
3759 # make the lines join to already-drawn rows either side
3760 set r [expr {$row - 1}]
3761 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3764 set er [expr {$endrow + 1}]
3765 if {$er >= $numcommits ||
3766 ![info exists iddrawn([lindex $displayorder $er])]} {
3769 for {} {$r <= $er} {incr r} {
3770 set id [lindex $displayorder $r]
3771 set wasdrawn [info exists iddrawn($id)]
3773 if {$r == $er} break
3774 set nextid [lindex $displayorder [expr {$r + 1}]]
3775 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3776 catch {unset prevlines}
3779 drawparentlinks $id $r
3781 if {[info exists lineends($r)]} {
3782 foreach lid $lineends($r) {
3783 unset prevlines($lid)
3786 set rowids [lindex $rowidlist $r]
3787 foreach lid $rowids {
3788 if {$lid eq {}} continue
3790 # see if this is the first child of any of its parents
3791 foreach p [lindex $parentlist $r] {
3792 if {[lsearch -exact $rowids $p] < 0} {
3793 # make this line extend up to the child
3794 set le [drawlineseg $p $r $er 0]
3795 lappend lineends($le) $p
3799 } elseif {![info exists prevlines($lid)]} {
3800 set le [drawlineseg $lid $r $er 1]
3801 lappend lineends($le) $lid
3802 set prevlines($lid) 1
3808 proc drawfrac {f0 f1} {
3811 set ymax [lindex [$canv cget -scrollregion] 3]
3812 if {$ymax eq {} || $ymax == 0} return
3813 set y0 [expr {int($f0 * $ymax)}]
3814 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3815 set y1 [expr {int($f1 * $ymax)}]
3816 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3817 drawcommits $row $endrow
3820 proc drawvisible {} {
3822 eval drawfrac [$canv yview]
3825 proc clear_display {} {
3826 global iddrawn linesegs need_redisplay nrows_drawn
3827 global vhighlights fhighlights nhighlights rhighlights
3830 catch {unset iddrawn}
3831 catch {unset linesegs}
3832 catch {unset vhighlights}
3833 catch {unset fhighlights}
3834 catch {unset nhighlights}
3835 catch {unset rhighlights}
3836 set need_redisplay 0
3840 proc findcrossings {id} {
3841 global rowidlist parentlist numcommits displayorder
3845 foreach {s e} [rowranges $id] {
3846 if {$e >= $numcommits} {
3847 set e [expr {$numcommits - 1}]
3849 if {$e <= $s} continue
3850 for {set row $e} {[incr row -1] >= $s} {} {
3851 set x [lsearch -exact [lindex $rowidlist $row] $id]
3853 set olds [lindex $parentlist $row]
3854 set kid [lindex $displayorder $row]
3855 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3856 if {$kidx < 0} continue
3857 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3859 set px [lsearch -exact $nextrow $p]
3860 if {$px < 0} continue
3861 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3862 if {[lsearch -exact $ccross $p] >= 0} continue
3863 if {$x == $px + ($kidx < $px? -1: 1)} {
3865 } elseif {[lsearch -exact $cross $p] < 0} {
3872 return [concat $ccross {{}} $cross]
3875 proc assigncolor {id} {
3876 global colormap colors nextcolor
3877 global commitrow parentlist children children curview
3879 if {[info exists colormap($id)]} return
3880 set ncolors [llength $colors]
3881 if {[info exists children($curview,$id)]} {
3882 set kids $children($curview,$id)
3886 if {[llength $kids] == 1} {
3887 set child [lindex $kids 0]
3888 if {[info exists colormap($child)]
3889 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3890 set colormap($id) $colormap($child)
3896 foreach x [findcrossings $id] {
3898 # delimiter between corner crossings and other crossings
3899 if {[llength $badcolors] >= $ncolors - 1} break
3900 set origbad $badcolors
3902 if {[info exists colormap($x)]
3903 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3904 lappend badcolors $colormap($x)
3907 if {[llength $badcolors] >= $ncolors} {
3908 set badcolors $origbad
3910 set origbad $badcolors
3911 if {[llength $badcolors] < $ncolors - 1} {
3912 foreach child $kids {
3913 if {[info exists colormap($child)]
3914 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3915 lappend badcolors $colormap($child)
3917 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3918 if {[info exists colormap($p)]
3919 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3920 lappend badcolors $colormap($p)
3924 if {[llength $badcolors] >= $ncolors} {
3925 set badcolors $origbad
3928 for {set i 0} {$i <= $ncolors} {incr i} {
3929 set c [lindex $colors $nextcolor]
3930 if {[incr nextcolor] >= $ncolors} {
3933 if {[lsearch -exact $badcolors $c]} break
3935 set colormap($id) $c
3938 proc bindline {t id} {
3941 $canv bind $t <Enter> "lineenter %x %y $id"
3942 $canv bind $t <Motion> "linemotion %x %y $id"
3943 $canv bind $t <Leave> "lineleave $id"
3944 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3947 proc drawtags {id x xt y1} {
3948 global idtags idheads idotherrefs mainhead
3949 global linespc lthickness
3950 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3955 if {[info exists idtags($id)]} {
3956 set marks $idtags($id)
3957 set ntags [llength $marks]
3959 if {[info exists idheads($id)]} {
3960 set marks [concat $marks $idheads($id)]
3961 set nheads [llength $idheads($id)]
3963 if {[info exists idotherrefs($id)]} {
3964 set marks [concat $marks $idotherrefs($id)]
3970 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3971 set yt [expr {$y1 - 0.5 * $linespc}]
3972 set yb [expr {$yt + $linespc - 1}]
3976 foreach tag $marks {
3978 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3979 set wid [font measure [concat $mainfont bold] $tag]
3981 set wid [font measure $mainfont $tag]
3985 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3987 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3988 -width $lthickness -fill black -tags tag.$id]
3990 foreach tag $marks x $xvals wid $wvals {
3991 set xl [expr {$x + $delta}]
3992 set xr [expr {$x + $delta + $wid + $lthickness}]
3994 if {[incr ntags -1] >= 0} {
3996 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3997 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3998 -width 1 -outline black -fill yellow -tags tag.$id]
3999 $canv bind $t <1> [list showtag $tag 1]
4000 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4002 # draw a head or other ref
4003 if {[incr nheads -1] >= 0} {
4005 if {$tag eq $mainhead} {
4011 set xl [expr {$xl - $delta/2}]
4012 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4013 -width 1 -outline black -fill $col -tags tag.$id
4014 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4015 set rwid [font measure $mainfont $remoteprefix]
4016 set xi [expr {$x + 1}]
4017 set yti [expr {$yt + 1}]
4018 set xri [expr {$x + $rwid}]
4019 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4020 -width 0 -fill "#ffddaa" -tags tag.$id
4023 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4024 -font $font -tags [list tag.$id text]]
4026 $canv bind $t <1> [list showtag $tag 1]
4027 } elseif {$nheads >= 0} {
4028 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4034 proc xcoord {i level ln} {
4035 global canvx0 xspc1 xspc2
4037 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4038 if {$i > 0 && $i == $level} {
4039 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4040 } elseif {$i > $level} {
4041 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4046 proc show_status {msg} {
4047 global canv mainfont fgcolor
4050 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
4051 -tags text -fill $fgcolor
4054 # Insert a new commit as the child of the commit on row $row.
4055 # The new commit will be displayed on row $row and the commits
4056 # on that row and below will move down one row.
4057 proc insertrow {row newcmit} {
4058 global displayorder parentlist commitlisted children
4059 global commitrow curview rowidlist rowisopt rowfinal numcommits
4061 global selectedline commitidx ordertok
4063 if {$row >= $numcommits} {
4064 puts "oops, inserting new row $row but only have $numcommits rows"
4067 set p [lindex $displayorder $row]
4068 set displayorder [linsert $displayorder $row $newcmit]
4069 set parentlist [linsert $parentlist $row $p]
4070 set kids $children($curview,$p)
4071 lappend kids $newcmit
4072 set children($curview,$p) $kids
4073 set children($curview,$newcmit) {}
4074 set commitlisted [linsert $commitlisted $row 1]
4075 set l [llength $displayorder]
4076 for {set r $row} {$r < $l} {incr r} {
4077 set id [lindex $displayorder $r]
4078 set commitrow($curview,$id) $r
4080 incr commitidx($curview)
4081 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4083 set idlist [lindex $rowidlist $row]
4084 if {[llength $kids] == 1} {
4085 set col [lsearch -exact $idlist $p]
4086 lset idlist $col $newcmit
4088 set col [llength $idlist]
4089 lappend idlist $newcmit
4091 set rowidlist [linsert $rowidlist $row $idlist]
4092 set rowisopt [linsert $rowisopt $row 0]
4093 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4097 if {[info exists selectedline] && $selectedline >= $row} {
4103 # Remove a commit that was inserted with insertrow on row $row.
4104 proc removerow {row} {
4105 global displayorder parentlist commitlisted children
4106 global commitrow curview rowidlist rowisopt rowfinal numcommits
4108 global linesegends selectedline commitidx
4110 if {$row >= $numcommits} {
4111 puts "oops, removing row $row but only have $numcommits rows"
4114 set rp1 [expr {$row + 1}]
4115 set id [lindex $displayorder $row]
4116 set p [lindex $parentlist $row]
4117 set displayorder [lreplace $displayorder $row $row]
4118 set parentlist [lreplace $parentlist $row $row]
4119 set commitlisted [lreplace $commitlisted $row $row]
4120 set kids $children($curview,$p)
4121 set i [lsearch -exact $kids $id]
4123 set kids [lreplace $kids $i $i]
4124 set children($curview,$p) $kids
4126 set l [llength $displayorder]
4127 for {set r $row} {$r < $l} {incr r} {
4128 set id [lindex $displayorder $r]
4129 set commitrow($curview,$id) $r
4131 incr commitidx($curview) -1
4133 set rowidlist [lreplace $rowidlist $row $row]
4134 set rowisopt [lreplace $rowisopt $row $row]
4135 set rowfinal [lreplace $rowfinal $row $row]
4139 if {[info exists selectedline] && $selectedline > $row} {
4140 incr selectedline -1
4145 # Don't change the text pane cursor if it is currently the hand cursor,
4146 # showing that we are over a sha1 ID link.
4147 proc settextcursor {c} {
4148 global ctext curtextcursor
4150 if {[$ctext cget -cursor] == $curtextcursor} {
4151 $ctext config -cursor $c
4153 set curtextcursor $c
4156 proc nowbusy {what} {
4159 if {[array names isbusy] eq {}} {
4160 . config -cursor watch
4166 proc notbusy {what} {
4167 global isbusy maincursor textcursor
4169 catch {unset isbusy($what)}
4170 if {[array names isbusy] eq {}} {
4171 . config -cursor $maincursor
4172 settextcursor $textcursor
4176 proc findmatches {f} {
4177 global findtype findstring
4178 if {$findtype == "Regexp"} {
4179 set matches [regexp -indices -all -inline $findstring $f]
4182 if {$findtype == "IgnCase"} {
4183 set f [string tolower $f]
4184 set fs [string tolower $fs]
4188 set l [string length $fs]
4189 while {[set j [string first $fs $f $i]] >= 0} {
4190 lappend matches [list $j [expr {$j+$l-1}]]
4191 set i [expr {$j + $l}]
4197 proc dofind {{rev 0}} {
4198 global findstring findstartline findcurline selectedline numcommits
4201 cancel_next_highlight
4203 if {$findstring eq {} || $numcommits == 0} return
4204 if {![info exists selectedline]} {
4205 set findstartline [lindex [visiblerows] $rev]
4207 set findstartline $selectedline
4209 set findcurline $findstartline
4214 if {$findcurline == 0} {
4215 set findcurline $numcommits
4222 proc findnext {restart} {
4224 if {![info exists findcurline]} {
4238 if {![info exists findcurline]} {
4247 global commitdata commitinfo numcommits findstring findpattern findloc
4248 global findstartline findcurline displayorder
4250 set fldtypes {Headline Author Date Committer CDate Comments}
4251 set l [expr {$findcurline + 1}]
4252 if {$l >= $numcommits} {
4255 if {$l <= $findstartline} {
4256 set lim [expr {$findstartline + 1}]
4260 if {$lim - $l > 500} {
4261 set lim [expr {$l + 500}]
4264 for {} {$l < $lim} {incr l} {
4265 set id [lindex $displayorder $l]
4266 # shouldn't happen unless git log doesn't give all the commits...
4267 if {![info exists commitdata($id)]} continue
4268 if {![doesmatch $commitdata($id)]} continue
4269 if {![info exists commitinfo($id)]} {
4272 set info $commitinfo($id)
4273 foreach f $info ty $fldtypes {
4274 if {($findloc eq "All fields" || $findloc eq $ty) &&
4282 if {$l == $findstartline + 1} {
4288 set findcurline [expr {$l - 1}]
4292 proc findmorerev {} {
4293 global commitdata commitinfo numcommits findstring findpattern findloc
4294 global findstartline findcurline displayorder
4296 set fldtypes {Headline Author Date Committer CDate Comments}
4302 if {$l >= $findstartline} {
4303 set lim [expr {$findstartline - 1}]
4307 if {$l - $lim > 500} {
4308 set lim [expr {$l - 500}]
4311 for {} {$l > $lim} {incr l -1} {
4312 set id [lindex $displayorder $l]
4313 if {![info exists commitdata($id)]} continue
4314 if {![doesmatch $commitdata($id)]} continue
4315 if {![info exists commitinfo($id)]} {
4318 set info $commitinfo($id)
4319 foreach f $info ty $fldtypes {
4320 if {($findloc eq "All fields" || $findloc eq $ty) &&
4334 set findcurline [expr {$l + 1}]
4338 proc findselectline {l} {
4339 global findloc commentend ctext findcurline markingmatches
4341 set markingmatches 1
4344 if {$findloc == "All fields" || $findloc == "Comments"} {
4345 # highlight the matches in the comments
4346 set f [$ctext get 1.0 $commentend]
4347 set matches [findmatches $f]
4348 foreach match $matches {
4349 set start [lindex $match 0]
4350 set end [expr {[lindex $match 1] + 1}]
4351 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4357 # mark the bits of a headline or author that match a find string
4358 proc markmatches {canv l str tag matches font row} {
4361 set bbox [$canv bbox $tag]
4362 set x0 [lindex $bbox 0]
4363 set y0 [lindex $bbox 1]
4364 set y1 [lindex $bbox 3]
4365 foreach match $matches {
4366 set start [lindex $match 0]
4367 set end [lindex $match 1]
4368 if {$start > $end} continue
4369 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4370 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4371 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4372 [expr {$x0+$xlen+2}] $y1 \
4373 -outline {} -tags [list match$l matches] -fill yellow]
4375 if {[info exists selectedline] && $row == $selectedline} {
4376 $canv raise $t secsel
4381 proc unmarkmatches {} {
4382 global findids markingmatches findcurline
4384 allcanvs delete matches
4385 catch {unset findids}
4386 set markingmatches 0
4387 catch {unset findcurline}
4390 proc selcanvline {w x y} {
4391 global canv canvy0 ctext linespc
4393 set ymax [lindex [$canv cget -scrollregion] 3]
4394 if {$ymax == {}} return
4395 set yfrac [lindex [$canv yview] 0]
4396 set y [expr {$y + $yfrac * $ymax}]
4397 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4402 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4408 proc commit_descriptor {p} {
4410 if {![info exists commitinfo($p)]} {
4414 if {[llength $commitinfo($p)] > 1} {
4415 set l [lindex $commitinfo($p) 0]
4420 # append some text to the ctext widget, and make any SHA1 ID
4421 # that we know about be a clickable link.
4422 proc appendwithlinks {text tags} {
4423 global ctext commitrow linknum curview pendinglinks
4425 set start [$ctext index "end - 1c"]
4426 $ctext insert end $text $tags
4427 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4431 set linkid [string range $text $s $e]
4433 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4434 setlink $linkid link$linknum
4439 proc setlink {id lk} {
4440 global curview commitrow ctext pendinglinks commitinterest
4442 if {[info exists commitrow($curview,$id)]} {
4443 $ctext tag conf $lk -foreground blue -underline 1
4444 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4445 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4446 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4448 lappend pendinglinks($id) $lk
4449 lappend commitinterest($id) {makelink %I}
4453 proc makelink {id} {
4456 if {![info exists pendinglinks($id)]} return
4457 foreach lk $pendinglinks($id) {
4460 unset pendinglinks($id)
4463 proc linkcursor {w inc} {
4464 global linkentercount curtextcursor
4466 if {[incr linkentercount $inc] > 0} {
4467 $w configure -cursor hand2
4469 $w configure -cursor $curtextcursor
4470 if {$linkentercount < 0} {
4471 set linkentercount 0
4476 proc viewnextline {dir} {
4480 set ymax [lindex [$canv cget -scrollregion] 3]
4481 set wnow [$canv yview]
4482 set wtop [expr {[lindex $wnow 0] * $ymax}]
4483 set newtop [expr {$wtop + $dir * $linespc}]
4486 } elseif {$newtop > $ymax} {
4489 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4492 # add a list of tag or branch names at position pos
4493 # returns the number of names inserted
4494 proc appendrefs {pos ids var} {
4495 global ctext commitrow linknum curview $var maxrefs
4497 if {[catch {$ctext index $pos}]} {
4500 $ctext conf -state normal
4501 $ctext delete $pos "$pos lineend"
4504 foreach tag [set $var\($id\)] {
4505 lappend tags [list $tag $id]
4508 if {[llength $tags] > $maxrefs} {
4509 $ctext insert $pos "many ([llength $tags])"
4511 set tags [lsort -index 0 -decreasing $tags]
4514 set id [lindex $ti 1]
4517 $ctext tag delete $lk
4518 $ctext insert $pos $sep
4519 $ctext insert $pos [lindex $ti 0] $lk
4524 $ctext conf -state disabled
4525 return [llength $tags]
4528 # called when we have finished computing the nearby tags
4529 proc dispneartags {delay} {
4530 global selectedline currentid showneartags tagphase
4532 if {![info exists selectedline] || !$showneartags} return
4533 after cancel dispnexttag
4535 after 200 dispnexttag
4538 after idle dispnexttag
4543 proc dispnexttag {} {
4544 global selectedline currentid showneartags tagphase ctext
4546 if {![info exists selectedline] || !$showneartags} return
4547 switch -- $tagphase {
4549 set dtags [desctags $currentid]
4551 appendrefs precedes $dtags idtags
4555 set atags [anctags $currentid]
4557 appendrefs follows $atags idtags
4561 set dheads [descheads $currentid]
4562 if {$dheads ne {}} {
4563 if {[appendrefs branch $dheads idheads] > 1
4564 && [$ctext get "branch -3c"] eq "h"} {
4565 # turn "Branch" into "Branches"
4566 $ctext conf -state normal
4567 $ctext insert "branch -2c" "es"
4568 $ctext conf -state disabled
4573 if {[incr tagphase] <= 2} {
4574 after idle dispnexttag
4578 proc make_secsel {l} {
4579 global linehtag linentag linedtag canv canv2 canv3
4581 if {![info exists linehtag($l)]} return
4583 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4584 -tags secsel -fill [$canv cget -selectbackground]]
4586 $canv2 delete secsel
4587 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4588 -tags secsel -fill [$canv2 cget -selectbackground]]
4590 $canv3 delete secsel
4591 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4592 -tags secsel -fill [$canv3 cget -selectbackground]]
4596 proc selectline {l isnew} {
4597 global canv ctext commitinfo selectedline
4599 global canvy0 linespc parentlist children curview
4600 global currentid sha1entry
4601 global commentend idtags linknum
4602 global mergemax numcommits pending_select
4603 global cmitmode showneartags allcommits
4605 catch {unset pending_select}
4608 cancel_next_highlight
4610 if {$l < 0 || $l >= $numcommits} return
4611 set y [expr {$canvy0 + $l * $linespc}]
4612 set ymax [lindex [$canv cget -scrollregion] 3]
4613 set ytop [expr {$y - $linespc - 1}]
4614 set ybot [expr {$y + $linespc + 1}]
4615 set wnow [$canv yview]
4616 set wtop [expr {[lindex $wnow 0] * $ymax}]
4617 set wbot [expr {[lindex $wnow 1] * $ymax}]
4618 set wh [expr {$wbot - $wtop}]
4620 if {$ytop < $wtop} {
4621 if {$ybot < $wtop} {
4622 set newtop [expr {$y - $wh / 2.0}]
4625 if {$newtop > $wtop - $linespc} {
4626 set newtop [expr {$wtop - $linespc}]
4629 } elseif {$ybot > $wbot} {
4630 if {$ytop > $wbot} {
4631 set newtop [expr {$y - $wh / 2.0}]
4633 set newtop [expr {$ybot - $wh}]
4634 if {$newtop < $wtop + $linespc} {
4635 set newtop [expr {$wtop + $linespc}]
4639 if {$newtop != $wtop} {
4643 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4650 addtohistory [list selectline $l 0]
4655 set id [lindex $displayorder $l]
4657 $sha1entry delete 0 end
4658 $sha1entry insert 0 $id
4659 $sha1entry selection from 0
4660 $sha1entry selection to end
4663 $ctext conf -state normal
4666 set info $commitinfo($id)
4667 set date [formatdate [lindex $info 2]]
4668 $ctext insert end "Author: [lindex $info 1] $date\n"
4669 set date [formatdate [lindex $info 4]]
4670 $ctext insert end "Committer: [lindex $info 3] $date\n"
4671 if {[info exists idtags($id)]} {
4672 $ctext insert end "Tags:"
4673 foreach tag $idtags($id) {
4674 $ctext insert end " $tag"
4676 $ctext insert end "\n"
4680 set olds [lindex $parentlist $l]
4681 if {[llength $olds] > 1} {
4684 if {$np >= $mergemax} {
4689 $ctext insert end "Parent: " $tag
4690 appendwithlinks [commit_descriptor $p] {}
4695 append headers "Parent: [commit_descriptor $p]"
4699 foreach c $children($curview,$id) {
4700 append headers "Child: [commit_descriptor $c]"
4703 # make anything that looks like a SHA1 ID be a clickable link
4704 appendwithlinks $headers {}
4705 if {$showneartags} {
4706 if {![info exists allcommits]} {
4709 $ctext insert end "Branch: "
4710 $ctext mark set branch "end -1c"
4711 $ctext mark gravity branch left
4712 $ctext insert end "\nFollows: "
4713 $ctext mark set follows "end -1c"
4714 $ctext mark gravity follows left
4715 $ctext insert end "\nPrecedes: "
4716 $ctext mark set precedes "end -1c"
4717 $ctext mark gravity precedes left
4718 $ctext insert end "\n"
4721 $ctext insert end "\n"
4722 set comment [lindex $info 5]
4723 if {[string first "\r" $comment] >= 0} {
4724 set comment [string map {"\r" "\n "} $comment]
4726 appendwithlinks $comment {comment}
4728 $ctext tag remove found 1.0 end
4729 $ctext conf -state disabled
4730 set commentend [$ctext index "end - 1c"]
4732 init_flist "Comments"
4733 if {$cmitmode eq "tree"} {
4735 } elseif {[llength $olds] <= 1} {
4742 proc selfirstline {} {
4747 proc sellastline {} {
4750 set l [expr {$numcommits - 1}]
4754 proc selnextline {dir} {
4757 if {![info exists selectedline]} return
4758 set l [expr {$selectedline + $dir}]
4763 proc selnextpage {dir} {
4764 global canv linespc selectedline numcommits
4766 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4770 allcanvs yview scroll [expr {$dir * $lpp}] units
4772 if {![info exists selectedline]} return
4773 set l [expr {$selectedline + $dir * $lpp}]
4776 } elseif {$l >= $numcommits} {
4777 set l [expr $numcommits - 1]
4783 proc unselectline {} {
4784 global selectedline currentid
4786 catch {unset selectedline}
4787 catch {unset currentid}
4788 allcanvs delete secsel
4790 cancel_next_highlight
4793 proc reselectline {} {
4796 if {[info exists selectedline]} {
4797 selectline $selectedline 0
4801 proc addtohistory {cmd} {
4802 global history historyindex curview
4804 set elt [list $curview $cmd]
4805 if {$historyindex > 0
4806 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4810 if {$historyindex < [llength $history]} {
4811 set history [lreplace $history $historyindex end $elt]
4813 lappend history $elt
4816 if {$historyindex > 1} {
4817 .tf.bar.leftbut conf -state normal
4819 .tf.bar.leftbut conf -state disabled
4821 .tf.bar.rightbut conf -state disabled
4827 set view [lindex $elt 0]
4828 set cmd [lindex $elt 1]
4829 if {$curview != $view} {
4836 global history historyindex
4839 if {$historyindex > 1} {
4840 incr historyindex -1
4841 godo [lindex $history [expr {$historyindex - 1}]]
4842 .tf.bar.rightbut conf -state normal
4844 if {$historyindex <= 1} {
4845 .tf.bar.leftbut conf -state disabled
4850 global history historyindex
4853 if {$historyindex < [llength $history]} {
4854 set cmd [lindex $history $historyindex]
4857 .tf.bar.leftbut conf -state normal
4859 if {$historyindex >= [llength $history]} {
4860 .tf.bar.rightbut conf -state disabled
4865 global treefilelist treeidlist diffids diffmergeid treepending
4866 global nullid nullid2
4869 catch {unset diffmergeid}
4870 if {![info exists treefilelist($id)]} {
4871 if {![info exists treepending]} {
4872 if {$id eq $nullid} {
4873 set cmd [list | git ls-files]
4874 } elseif {$id eq $nullid2} {
4875 set cmd [list | git ls-files --stage -t]
4877 set cmd [list | git ls-tree -r $id]
4879 if {[catch {set gtf [open $cmd r]}]} {
4883 set treefilelist($id) {}
4884 set treeidlist($id) {}
4885 fconfigure $gtf -blocking 0
4886 filerun $gtf [list gettreeline $gtf $id]
4893 proc gettreeline {gtf id} {
4894 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4897 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4898 if {$diffids eq $nullid} {
4901 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4902 set i [string first "\t" $line]
4903 if {$i < 0} continue
4904 set sha1 [lindex $line 2]
4905 set fname [string range $line [expr {$i+1}] end]
4906 if {[string index $fname 0] eq "\""} {
4907 set fname [lindex $fname 0]
4909 lappend treeidlist($id) $sha1
4911 lappend treefilelist($id) $fname
4914 return [expr {$nl >= 1000? 2: 1}]
4918 if {$cmitmode ne "tree"} {
4919 if {![info exists diffmergeid]} {
4920 gettreediffs $diffids
4922 } elseif {$id ne $diffids} {
4931 global treefilelist treeidlist diffids nullid nullid2
4932 global ctext commentend
4934 set i [lsearch -exact $treefilelist($diffids) $f]
4936 puts "oops, $f not in list for id $diffids"
4939 if {$diffids eq $nullid} {
4940 if {[catch {set bf [open $f r]} err]} {
4941 puts "oops, can't read $f: $err"
4945 set blob [lindex $treeidlist($diffids) $i]
4946 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4947 puts "oops, error reading blob $blob: $err"
4951 fconfigure $bf -blocking 0
4952 filerun $bf [list getblobline $bf $diffids]
4953 $ctext config -state normal
4954 clear_ctext $commentend
4955 $ctext insert end "\n"
4956 $ctext insert end "$f\n" filesep
4957 $ctext config -state disabled
4958 $ctext yview $commentend
4961 proc getblobline {bf id} {
4962 global diffids cmitmode ctext
4964 if {$id ne $diffids || $cmitmode ne "tree"} {
4968 $ctext config -state normal
4970 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4971 $ctext insert end "$line\n"
4974 # delete last newline
4975 $ctext delete "end - 2c" "end - 1c"
4979 $ctext config -state disabled
4980 return [expr {$nl >= 1000? 2: 1}]
4983 proc mergediff {id l} {
4984 global diffmergeid diffopts mdifffd
4990 # this doesn't seem to actually affect anything...
4991 set env(GIT_DIFF_OPTS) $diffopts
4992 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4993 if {[catch {set mdf [open $cmd r]} err]} {
4994 error_popup "Error getting merge diffs: $err"
4997 fconfigure $mdf -blocking 0
4998 set mdifffd($id) $mdf
4999 set np [llength [lindex $parentlist $l]]
5000 filerun $mdf [list getmergediffline $mdf $id $np]
5003 proc getmergediffline {mdf id np} {
5004 global diffmergeid ctext cflist mergemax
5005 global difffilestart mdifffd
5007 $ctext conf -state normal
5009 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5010 if {![info exists diffmergeid] || $id != $diffmergeid
5011 || $mdf != $mdifffd($id)} {
5015 if {[regexp {^diff --cc (.*)} $line match fname]} {
5016 # start of a new file
5017 $ctext insert end "\n"
5018 set here [$ctext index "end - 1c"]
5019 lappend difffilestart $here
5020 add_flist [list $fname]
5021 set l [expr {(78 - [string length $fname]) / 2}]
5022 set pad [string range "----------------------------------------" 1 $l]
5023 $ctext insert end "$pad $fname $pad\n" filesep
5024 } elseif {[regexp {^@@} $line]} {
5025 $ctext insert end "$line\n" hunksep
5026 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5029 # parse the prefix - one ' ', '-' or '+' for each parent
5034 for {set j 0} {$j < $np} {incr j} {
5035 set c [string range $line $j $j]
5038 } elseif {$c == "-"} {
5040 } elseif {$c == "+"} {
5049 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5050 # line doesn't appear in result, parents in $minuses have the line
5051 set num [lindex $minuses 0]
5052 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5053 # line appears in result, parents in $pluses don't have the line
5054 lappend tags mresult
5055 set num [lindex $spaces 0]
5058 if {$num >= $mergemax} {
5063 $ctext insert end "$line\n" $tags
5066 $ctext conf -state disabled
5071 return [expr {$nr >= 1000? 2: 1}]
5074 proc startdiff {ids} {
5075 global treediffs diffids treepending diffmergeid nullid nullid2
5078 catch {unset diffmergeid}
5079 if {![info exists treediffs($ids)] ||
5080 [lsearch -exact $ids $nullid] >= 0 ||
5081 [lsearch -exact $ids $nullid2] >= 0} {
5082 if {![info exists treepending]} {
5090 proc addtocflist {ids} {
5091 global treediffs cflist
5092 add_flist $treediffs($ids)
5096 proc diffcmd {ids flags} {
5097 global nullid nullid2
5099 set i [lsearch -exact $ids $nullid]
5100 set j [lsearch -exact $ids $nullid2]
5102 if {[llength $ids] > 1 && $j < 0} {
5103 # comparing working directory with some specific revision
5104 set cmd [concat | git diff-index $flags]
5106 lappend cmd -R [lindex $ids 1]
5108 lappend cmd [lindex $ids 0]
5111 # comparing working directory with index
5112 set cmd [concat | git diff-files $flags]
5117 } elseif {$j >= 0} {
5118 set cmd [concat | git diff-index --cached $flags]
5119 if {[llength $ids] > 1} {
5120 # comparing index with specific revision
5122 lappend cmd -R [lindex $ids 1]
5124 lappend cmd [lindex $ids 0]
5127 # comparing index with HEAD
5131 set cmd [concat | git diff-tree -r $flags $ids]
5136 proc gettreediffs {ids} {
5137 global treediff treepending
5139 set treepending $ids
5141 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5142 fconfigure $gdtf -blocking 0
5143 filerun $gdtf [list gettreediffline $gdtf $ids]
5146 proc gettreediffline {gdtf ids} {
5147 global treediff treediffs treepending diffids diffmergeid
5151 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5152 set i [string first "\t" $line]
5154 set file [string range $line [expr {$i+1}] end]
5155 if {[string index $file 0] eq "\""} {
5156 set file [lindex $file 0]
5158 lappend treediff $file
5162 return [expr {$nr >= 1000? 2: 1}]
5165 set treediffs($ids) $treediff
5167 if {$cmitmode eq "tree"} {
5169 } elseif {$ids != $diffids} {
5170 if {![info exists diffmergeid]} {
5171 gettreediffs $diffids
5179 # empty string or positive integer
5180 proc diffcontextvalidate {v} {
5181 return [regexp {^(|[1-9][0-9]*)$} $v]
5184 proc diffcontextchange {n1 n2 op} {
5185 global diffcontextstring diffcontext
5187 if {[string is integer -strict $diffcontextstring]} {
5188 if {$diffcontextstring > 0} {
5189 set diffcontext $diffcontextstring
5195 proc getblobdiffs {ids} {
5196 global diffopts blobdifffd diffids env
5197 global diffinhdr treediffs
5200 set env(GIT_DIFF_OPTS) $diffopts
5201 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5202 puts "error getting diffs: $err"
5206 fconfigure $bdf -blocking 0
5207 set blobdifffd($ids) $bdf
5208 filerun $bdf [list getblobdiffline $bdf $diffids]
5211 proc setinlist {var i val} {
5214 while {[llength [set $var]] < $i} {
5217 if {[llength [set $var]] == $i} {
5224 proc makediffhdr {fname ids} {
5225 global ctext curdiffstart treediffs
5227 set i [lsearch -exact $treediffs($ids) $fname]
5229 setinlist difffilestart $i $curdiffstart
5231 set l [expr {(78 - [string length $fname]) / 2}]
5232 set pad [string range "----------------------------------------" 1 $l]
5233 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5236 proc getblobdiffline {bdf ids} {
5237 global diffids blobdifffd ctext curdiffstart
5238 global diffnexthead diffnextnote difffilestart
5239 global diffinhdr treediffs
5242 $ctext conf -state normal
5243 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5244 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5248 if {![string compare -length 11 "diff --git " $line]} {
5249 # trim off "diff --git "
5250 set line [string range $line 11 end]
5252 # start of a new file
5253 $ctext insert end "\n"
5254 set curdiffstart [$ctext index "end - 1c"]
5255 $ctext insert end "\n" filesep
5256 # If the name hasn't changed the length will be odd,
5257 # the middle char will be a space, and the two bits either
5258 # side will be a/name and b/name, or "a/name" and "b/name".
5259 # If the name has changed we'll get "rename from" and
5260 # "rename to" or "copy from" and "copy to" lines following this,
5261 # and we'll use them to get the filenames.
5262 # This complexity is necessary because spaces in the filename(s)
5263 # don't get escaped.
5264 set l [string length $line]
5265 set i [expr {$l / 2}]
5266 if {!(($l & 1) && [string index $line $i] eq " " &&
5267 [string range $line 2 [expr {$i - 1}]] eq \
5268 [string range $line [expr {$i + 3}] end])} {
5271 # unescape if quoted and chop off the a/ from the front
5272 if {[string index $line 0] eq "\""} {
5273 set fname [string range [lindex $line 0] 2 end]
5275 set fname [string range $line 2 [expr {$i - 1}]]
5277 makediffhdr $fname $ids
5279 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5280 $line match f1l f1c f2l f2c rest]} {
5281 $ctext insert end "$line\n" hunksep
5284 } elseif {$diffinhdr} {
5285 if {![string compare -length 12 "rename from " $line] ||
5286 ![string compare -length 10 "copy from " $line]} {
5287 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5288 if {[string index $fname 0] eq "\""} {
5289 set fname [lindex $fname 0]
5291 set i [lsearch -exact $treediffs($ids) $fname]
5293 setinlist difffilestart $i $curdiffstart
5295 } elseif {![string compare -length 10 $line "rename to "] ||
5296 ![string compare -length 8 $line "copy to "]} {
5297 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5298 if {[string index $fname 0] eq "\""} {
5299 set fname [lindex $fname 0]
5301 makediffhdr $fname $ids
5302 } elseif {[string compare -length 3 $line "---"] == 0} {
5305 } elseif {[string compare -length 3 $line "+++"] == 0} {
5309 $ctext insert end "$line\n" filesep
5312 set x [string range $line 0 0]
5313 if {$x == "-" || $x == "+"} {
5314 set tag [expr {$x == "+"}]
5315 $ctext insert end "$line\n" d$tag
5316 } elseif {$x == " "} {
5317 $ctext insert end "$line\n"
5319 # "\ No newline at end of file",
5320 # or something else we don't recognize
5321 $ctext insert end "$line\n" hunksep
5325 $ctext conf -state disabled
5330 return [expr {$nr >= 1000? 2: 1}]
5333 proc changediffdisp {} {
5334 global ctext diffelide
5336 $ctext tag conf d0 -elide [lindex $diffelide 0]
5337 $ctext tag conf d1 -elide [lindex $diffelide 1]
5341 global difffilestart ctext
5342 set prev [lindex $difffilestart 0]
5343 set here [$ctext index @0,0]
5344 foreach loc $difffilestart {
5345 if {[$ctext compare $loc >= $here]} {
5355 global difffilestart ctext
5356 set here [$ctext index @0,0]
5357 foreach loc $difffilestart {
5358 if {[$ctext compare $loc > $here]} {
5365 proc clear_ctext {{first 1.0}} {
5366 global ctext smarktop smarkbot
5369 set l [lindex [split $first .] 0]
5370 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5373 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5376 $ctext delete $first end
5377 if {$first eq "1.0"} {
5378 catch {unset pendinglinks}
5382 proc incrsearch {name ix op} {
5383 global ctext searchstring searchdirn
5385 $ctext tag remove found 1.0 end
5386 if {[catch {$ctext index anchor}]} {
5387 # no anchor set, use start of selection, or of visible area
5388 set sel [$ctext tag ranges sel]
5390 $ctext mark set anchor [lindex $sel 0]
5391 } elseif {$searchdirn eq "-forwards"} {
5392 $ctext mark set anchor @0,0
5394 $ctext mark set anchor @0,[winfo height $ctext]
5397 if {$searchstring ne {}} {
5398 set here [$ctext search $searchdirn -- $searchstring anchor]
5407 global sstring ctext searchstring searchdirn
5410 $sstring icursor end
5411 set searchdirn -forwards
5412 if {$searchstring ne {}} {
5413 set sel [$ctext tag ranges sel]
5415 set start "[lindex $sel 0] + 1c"
5416 } elseif {[catch {set start [$ctext index anchor]}]} {
5419 set match [$ctext search -count mlen -- $searchstring $start]
5420 $ctext tag remove sel 1.0 end
5426 set mend "$match + $mlen c"
5427 $ctext tag add sel $match $mend
5428 $ctext mark unset anchor
5432 proc dosearchback {} {
5433 global sstring ctext searchstring searchdirn
5436 $sstring icursor end
5437 set searchdirn -backwards
5438 if {$searchstring ne {}} {
5439 set sel [$ctext tag ranges sel]
5441 set start [lindex $sel 0]
5442 } elseif {[catch {set start [$ctext index anchor]}]} {
5443 set start @0,[winfo height $ctext]
5445 set match [$ctext search -backwards -count ml -- $searchstring $start]
5446 $ctext tag remove sel 1.0 end
5452 set mend "$match + $ml c"
5453 $ctext tag add sel $match $mend
5454 $ctext mark unset anchor
5458 proc searchmark {first last} {
5459 global ctext searchstring
5463 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5464 if {$match eq {}} break
5465 set mend "$match + $mlen c"
5466 $ctext tag add found $match $mend
5470 proc searchmarkvisible {doall} {
5471 global ctext smarktop smarkbot
5473 set topline [lindex [split [$ctext index @0,0] .] 0]
5474 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5475 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5476 # no overlap with previous
5477 searchmark $topline $botline
5478 set smarktop $topline
5479 set smarkbot $botline
5481 if {$topline < $smarktop} {
5482 searchmark $topline [expr {$smarktop-1}]
5483 set smarktop $topline
5485 if {$botline > $smarkbot} {
5486 searchmark [expr {$smarkbot+1}] $botline
5487 set smarkbot $botline
5492 proc scrolltext {f0 f1} {
5495 .bleft.sb set $f0 $f1
5496 if {$searchstring ne {}} {
5502 global linespc charspc canvx0 canvy0 mainfont
5503 global xspc1 xspc2 lthickness
5505 set linespc [font metrics $mainfont -linespace]
5506 set charspc [font measure $mainfont "m"]
5507 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5508 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5509 set lthickness [expr {int($linespc / 9) + 1}]
5510 set xspc1(0) $linespc
5518 set ymax [lindex [$canv cget -scrollregion] 3]
5519 if {$ymax eq {} || $ymax == 0} return
5520 set span [$canv yview]
5523 allcanvs yview moveto [lindex $span 0]
5525 if {[info exists selectedline]} {
5526 selectline $selectedline 0
5527 allcanvs yview moveto [lindex $span 0]
5531 proc incrfont {inc} {
5532 global mainfont textfont ctext canv phase cflist showrefstop
5533 global charspc tabstop
5534 global stopped entries
5536 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5537 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5539 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5540 $cflist conf -font $textfont
5541 $ctext tag conf filesep -font [concat $textfont bold]
5542 foreach e $entries {
5543 $e conf -font $mainfont
5545 if {$phase eq "getcommits"} {
5546 $canv itemconf textitems -font $mainfont
5548 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5549 $showrefstop.list conf -font $mainfont
5555 global sha1entry sha1string
5556 if {[string length $sha1string] == 40} {
5557 $sha1entry delete 0 end
5561 proc sha1change {n1 n2 op} {
5562 global sha1string currentid sha1but
5563 if {$sha1string == {}
5564 || ([info exists currentid] && $sha1string == $currentid)} {
5569 if {[$sha1but cget -state] == $state} return
5570 if {$state == "normal"} {
5571 $sha1but conf -state normal -relief raised -text "Goto: "
5573 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5577 proc gotocommit {} {
5578 global sha1string currentid commitrow tagids headids
5579 global displayorder numcommits curview
5581 if {$sha1string == {}
5582 || ([info exists currentid] && $sha1string == $currentid)} return
5583 if {[info exists tagids($sha1string)]} {
5584 set id $tagids($sha1string)
5585 } elseif {[info exists headids($sha1string)]} {
5586 set id $headids($sha1string)
5588 set id [string tolower $sha1string]
5589 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5591 foreach i $displayorder {
5592 if {[string match $id* $i]} {
5596 if {$matches ne {}} {
5597 if {[llength $matches] > 1} {
5598 error_popup "Short SHA1 id $id is ambiguous"
5601 set id [lindex $matches 0]
5605 if {[info exists commitrow($curview,$id)]} {
5606 selectline $commitrow($curview,$id) 1
5609 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5614 error_popup "$type $sha1string is not known"
5617 proc lineenter {x y id} {
5618 global hoverx hovery hoverid hovertimer
5619 global commitinfo canv
5621 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5625 if {[info exists hovertimer]} {
5626 after cancel $hovertimer
5628 set hovertimer [after 500 linehover]
5632 proc linemotion {x y id} {
5633 global hoverx hovery hoverid hovertimer
5635 if {[info exists hoverid] && $id == $hoverid} {
5638 if {[info exists hovertimer]} {
5639 after cancel $hovertimer
5641 set hovertimer [after 500 linehover]
5645 proc lineleave {id} {
5646 global hoverid hovertimer canv
5648 if {[info exists hoverid] && $id == $hoverid} {
5650 if {[info exists hovertimer]} {
5651 after cancel $hovertimer
5659 global hoverx hovery hoverid hovertimer
5660 global canv linespc lthickness
5661 global commitinfo mainfont
5663 set text [lindex $commitinfo($hoverid) 0]
5664 set ymax [lindex [$canv cget -scrollregion] 3]
5665 if {$ymax == {}} return
5666 set yfrac [lindex [$canv yview] 0]
5667 set x [expr {$hoverx + 2 * $linespc}]
5668 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5669 set x0 [expr {$x - 2 * $lthickness}]
5670 set y0 [expr {$y - 2 * $lthickness}]
5671 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5672 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5673 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5674 -fill \#ffff80 -outline black -width 1 -tags hover]
5676 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5681 proc clickisonarrow {id y} {
5684 set ranges [rowranges $id]
5685 set thresh [expr {2 * $lthickness + 6}]
5686 set n [expr {[llength $ranges] - 1}]
5687 for {set i 1} {$i < $n} {incr i} {
5688 set row [lindex $ranges $i]
5689 if {abs([yc $row] - $y) < $thresh} {
5696 proc arrowjump {id n y} {
5699 # 1 <-> 2, 3 <-> 4, etc...
5700 set n [expr {(($n - 1) ^ 1) + 1}]
5701 set row [lindex [rowranges $id] $n]
5703 set ymax [lindex [$canv cget -scrollregion] 3]
5704 if {$ymax eq {} || $ymax <= 0} return
5705 set view [$canv yview]
5706 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5707 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5711 allcanvs yview moveto $yfrac
5714 proc lineclick {x y id isnew} {
5715 global ctext commitinfo children canv thickerline curview commitrow
5717 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5722 # draw this line thicker than normal
5726 set ymax [lindex [$canv cget -scrollregion] 3]
5727 if {$ymax eq {}} return
5728 set yfrac [lindex [$canv yview] 0]
5729 set y [expr {$y + $yfrac * $ymax}]
5731 set dirn [clickisonarrow $id $y]
5733 arrowjump $id $dirn $y
5738 addtohistory [list lineclick $x $y $id 0]
5740 # fill the details pane with info about this line
5741 $ctext conf -state normal
5743 $ctext insert end "Parent:\t"
5744 $ctext insert end $id link0
5746 set info $commitinfo($id)
5747 $ctext insert end "\n\t[lindex $info 0]\n"
5748 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5749 set date [formatdate [lindex $info 2]]
5750 $ctext insert end "\tDate:\t$date\n"
5751 set kids $children($curview,$id)
5753 $ctext insert end "\nChildren:"
5755 foreach child $kids {
5757 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5758 set info $commitinfo($child)
5759 $ctext insert end "\n\t"
5760 $ctext insert end $child link$i
5761 setlink $child link$i
5762 $ctext insert end "\n\t[lindex $info 0]"
5763 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5764 set date [formatdate [lindex $info 2]]
5765 $ctext insert end "\n\tDate:\t$date\n"
5768 $ctext conf -state disabled
5772 proc normalline {} {
5774 if {[info exists thickerline]} {
5782 global commitrow curview
5783 if {[info exists commitrow($curview,$id)]} {
5784 selectline $commitrow($curview,$id) 1
5790 if {![info exists startmstime]} {
5791 set startmstime [clock clicks -milliseconds]
5793 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5796 proc rowmenu {x y id} {
5797 global rowctxmenu commitrow selectedline rowmenuid curview
5798 global nullid nullid2 fakerowmenu mainhead
5801 if {![info exists selectedline]
5802 || $commitrow($curview,$id) eq $selectedline} {
5807 if {$id ne $nullid && $id ne $nullid2} {
5808 set menu $rowctxmenu
5809 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5811 set menu $fakerowmenu
5813 $menu entryconfigure "Diff this*" -state $state
5814 $menu entryconfigure "Diff selected*" -state $state
5815 $menu entryconfigure "Make patch" -state $state
5816 tk_popup $menu $x $y
5819 proc diffvssel {dirn} {
5820 global rowmenuid selectedline displayorder
5822 if {![info exists selectedline]} return
5824 set oldid [lindex $displayorder $selectedline]
5825 set newid $rowmenuid
5827 set oldid $rowmenuid
5828 set newid [lindex $displayorder $selectedline]
5830 addtohistory [list doseldiff $oldid $newid]
5831 doseldiff $oldid $newid
5834 proc doseldiff {oldid newid} {
5838 $ctext conf -state normal
5841 $ctext insert end "From "
5842 $ctext insert end $oldid link0
5843 setlink $oldid link0
5844 $ctext insert end "\n "
5845 $ctext insert end [lindex $commitinfo($oldid) 0]
5846 $ctext insert end "\n\nTo "
5847 $ctext insert end $newid link1
5848 setlink $newid link1
5849 $ctext insert end "\n "
5850 $ctext insert end [lindex $commitinfo($newid) 0]
5851 $ctext insert end "\n"
5852 $ctext conf -state disabled
5853 $ctext tag remove found 1.0 end
5854 startdiff [list $oldid $newid]
5858 global rowmenuid currentid commitinfo patchtop patchnum
5860 if {![info exists currentid]} return
5861 set oldid $currentid
5862 set oldhead [lindex $commitinfo($oldid) 0]
5863 set newid $rowmenuid
5864 set newhead [lindex $commitinfo($newid) 0]
5867 catch {destroy $top}
5869 label $top.title -text "Generate patch"
5870 grid $top.title - -pady 10
5871 label $top.from -text "From:"
5872 entry $top.fromsha1 -width 40 -relief flat
5873 $top.fromsha1 insert 0 $oldid
5874 $top.fromsha1 conf -state readonly
5875 grid $top.from $top.fromsha1 -sticky w
5876 entry $top.fromhead -width 60 -relief flat
5877 $top.fromhead insert 0 $oldhead
5878 $top.fromhead conf -state readonly
5879 grid x $top.fromhead -sticky w
5880 label $top.to -text "To:"
5881 entry $top.tosha1 -width 40 -relief flat
5882 $top.tosha1 insert 0 $newid
5883 $top.tosha1 conf -state readonly
5884 grid $top.to $top.tosha1 -sticky w
5885 entry $top.tohead -width 60 -relief flat
5886 $top.tohead insert 0 $newhead
5887 $top.tohead conf -state readonly
5888 grid x $top.tohead -sticky w
5889 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5890 grid $top.rev x -pady 10
5891 label $top.flab -text "Output file:"
5892 entry $top.fname -width 60
5893 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5895 grid $top.flab $top.fname -sticky w
5897 button $top.buts.gen -text "Generate" -command mkpatchgo
5898 button $top.buts.can -text "Cancel" -command mkpatchcan
5899 grid $top.buts.gen $top.buts.can
5900 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5901 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5902 grid $top.buts - -pady 10 -sticky ew
5906 proc mkpatchrev {} {
5909 set oldid [$patchtop.fromsha1 get]
5910 set oldhead [$patchtop.fromhead get]
5911 set newid [$patchtop.tosha1 get]
5912 set newhead [$patchtop.tohead get]
5913 foreach e [list fromsha1 fromhead tosha1 tohead] \
5914 v [list $newid $newhead $oldid $oldhead] {
5915 $patchtop.$e conf -state normal
5916 $patchtop.$e delete 0 end
5917 $patchtop.$e insert 0 $v
5918 $patchtop.$e conf -state readonly
5923 global patchtop nullid nullid2
5925 set oldid [$patchtop.fromsha1 get]
5926 set newid [$patchtop.tosha1 get]
5927 set fname [$patchtop.fname get]
5928 set cmd [diffcmd [list $oldid $newid] -p]
5929 lappend cmd >$fname &
5930 if {[catch {eval exec $cmd} err]} {
5931 error_popup "Error creating patch: $err"
5933 catch {destroy $patchtop}
5937 proc mkpatchcan {} {
5940 catch {destroy $patchtop}
5945 global rowmenuid mktagtop commitinfo
5949 catch {destroy $top}
5951 label $top.title -text "Create tag"
5952 grid $top.title - -pady 10
5953 label $top.id -text "ID:"
5954 entry $top.sha1 -width 40 -relief flat
5955 $top.sha1 insert 0 $rowmenuid
5956 $top.sha1 conf -state readonly
5957 grid $top.id $top.sha1 -sticky w
5958 entry $top.head -width 60 -relief flat
5959 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5960 $top.head conf -state readonly
5961 grid x $top.head -sticky w
5962 label $top.tlab -text "Tag name:"
5963 entry $top.tag -width 60
5964 grid $top.tlab $top.tag -sticky w
5966 button $top.buts.gen -text "Create" -command mktaggo
5967 button $top.buts.can -text "Cancel" -command mktagcan
5968 grid $top.buts.gen $top.buts.can
5969 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5970 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5971 grid $top.buts - -pady 10 -sticky ew
5976 global mktagtop env tagids idtags
5978 set id [$mktagtop.sha1 get]
5979 set tag [$mktagtop.tag get]
5981 error_popup "No tag name specified"
5984 if {[info exists tagids($tag)]} {
5985 error_popup "Tag \"$tag\" already exists"
5990 set fname [file join $dir "refs/tags" $tag]
5991 set f [open $fname w]
5995 error_popup "Error creating tag: $err"
5999 set tagids($tag) $id
6000 lappend idtags($id) $tag
6007 proc redrawtags {id} {
6008 global canv linehtag commitrow idpos selectedline curview
6009 global mainfont canvxmax iddrawn
6011 if {![info exists commitrow($curview,$id)]} return
6012 if {![info exists iddrawn($id)]} return
6013 drawcommits $commitrow($curview,$id)
6014 $canv delete tag.$id
6015 set xt [eval drawtags $id $idpos($id)]
6016 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6017 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6018 set xr [expr {$xt + [font measure $mainfont $text]}]
6019 if {$xr > $canvxmax} {
6023 if {[info exists selectedline]
6024 && $selectedline == $commitrow($curview,$id)} {
6025 selectline $selectedline 0
6032 catch {destroy $mktagtop}
6041 proc writecommit {} {
6042 global rowmenuid wrcomtop commitinfo wrcomcmd
6044 set top .writecommit
6046 catch {destroy $top}
6048 label $top.title -text "Write commit to file"
6049 grid $top.title - -pady 10
6050 label $top.id -text "ID:"
6051 entry $top.sha1 -width 40 -relief flat
6052 $top.sha1 insert 0 $rowmenuid
6053 $top.sha1 conf -state readonly
6054 grid $top.id $top.sha1 -sticky w
6055 entry $top.head -width 60 -relief flat
6056 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6057 $top.head conf -state readonly
6058 grid x $top.head -sticky w
6059 label $top.clab -text "Command:"
6060 entry $top.cmd -width 60 -textvariable wrcomcmd
6061 grid $top.clab $top.cmd -sticky w -pady 10
6062 label $top.flab -text "Output file:"
6063 entry $top.fname -width 60
6064 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6065 grid $top.flab $top.fname -sticky w
6067 button $top.buts.gen -text "Write" -command wrcomgo
6068 button $top.buts.can -text "Cancel" -command wrcomcan
6069 grid $top.buts.gen $top.buts.can
6070 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6071 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6072 grid $top.buts - -pady 10 -sticky ew
6079 set id [$wrcomtop.sha1 get]
6080 set cmd "echo $id | [$wrcomtop.cmd get]"
6081 set fname [$wrcomtop.fname get]
6082 if {[catch {exec sh -c $cmd >$fname &} err]} {
6083 error_popup "Error writing commit: $err"
6085 catch {destroy $wrcomtop}
6092 catch {destroy $wrcomtop}
6097 global rowmenuid mkbrtop
6100 catch {destroy $top}
6102 label $top.title -text "Create new branch"
6103 grid $top.title - -pady 10
6104 label $top.id -text "ID:"
6105 entry $top.sha1 -width 40 -relief flat
6106 $top.sha1 insert 0 $rowmenuid
6107 $top.sha1 conf -state readonly
6108 grid $top.id $top.sha1 -sticky w
6109 label $top.nlab -text "Name:"
6110 entry $top.name -width 40
6111 grid $top.nlab $top.name -sticky w
6113 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6114 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6115 grid $top.buts.go $top.buts.can
6116 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6117 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6118 grid $top.buts - -pady 10 -sticky ew
6123 global headids idheads
6125 set name [$top.name get]
6126 set id [$top.sha1 get]
6128 error_popup "Please specify a name for the new branch"
6131 catch {destroy $top}
6135 exec git branch $name $id
6140 set headids($name) $id
6141 lappend idheads($id) $name
6150 proc cherrypick {} {
6151 global rowmenuid curview commitrow
6154 set oldhead [exec git rev-parse HEAD]
6155 set dheads [descheads $rowmenuid]
6156 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6157 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6158 included in branch $mainhead -- really re-apply it?"]
6163 # Unfortunately git-cherry-pick writes stuff to stderr even when
6164 # no error occurs, and exec takes that as an indication of error...
6165 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6170 set newhead [exec git rev-parse HEAD]
6171 if {$newhead eq $oldhead} {
6173 error_popup "No changes committed"
6176 addnewchild $newhead $oldhead
6177 if {[info exists commitrow($curview,$oldhead)]} {
6178 insertrow $commitrow($curview,$oldhead) $newhead
6179 if {$mainhead ne {}} {
6180 movehead $newhead $mainhead
6181 movedhead $newhead $mainhead
6190 global mainheadid mainhead rowmenuid confirm_ok resettype
6191 global showlocalchanges
6194 set w ".confirmreset"
6197 wm title $w "Confirm reset"
6198 message $w.m -text \
6199 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6200 -justify center -aspect 1000
6201 pack $w.m -side top -fill x -padx 20 -pady 20
6202 frame $w.f -relief sunken -border 2
6203 message $w.f.rt -text "Reset type:" -aspect 1000
6204 grid $w.f.rt -sticky w
6206 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6207 -text "Soft: Leave working tree and index untouched"
6208 grid $w.f.soft -sticky w
6209 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6210 -text "Mixed: Leave working tree untouched, reset index"
6211 grid $w.f.mixed -sticky w
6212 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6213 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6214 grid $w.f.hard -sticky w
6215 pack $w.f -side top -fill x
6216 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6217 pack $w.ok -side left -fill x -padx 20 -pady 20
6218 button $w.cancel -text Cancel -command "destroy $w"
6219 pack $w.cancel -side right -fill x -padx 20 -pady 20
6220 bind $w <Visibility> "grab $w; focus $w"
6222 if {!$confirm_ok} return
6223 if {[catch {set fd [open \
6224 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6228 set w ".resetprogress"
6229 filerun $fd [list readresetstat $fd $w]
6232 wm title $w "Reset progress"
6233 message $w.m -text "Reset in progress, please wait..." \
6234 -justify center -aspect 1000
6235 pack $w.m -side top -fill x -padx 20 -pady 5
6236 canvas $w.c -width 150 -height 20 -bg white
6237 $w.c create rect 0 0 0 20 -fill green -tags rect
6238 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6243 proc readresetstat {fd w} {
6244 global mainhead mainheadid showlocalchanges
6246 if {[gets $fd line] >= 0} {
6247 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6248 set x [expr {($m * 150) / $n}]
6249 $w.c coords rect 0 0 $x 20
6255 if {[catch {close $fd} err]} {
6258 set oldhead $mainheadid
6259 set newhead [exec git rev-parse HEAD]
6260 if {$newhead ne $oldhead} {
6261 movehead $newhead $mainhead
6262 movedhead $newhead $mainhead
6263 set mainheadid $newhead
6267 if {$showlocalchanges} {
6273 # context menu for a head
6274 proc headmenu {x y id head} {
6275 global headmenuid headmenuhead headctxmenu mainhead
6278 set headmenuhead $head
6280 if {$head eq $mainhead} {
6283 $headctxmenu entryconfigure 0 -state $state
6284 $headctxmenu entryconfigure 1 -state $state
6285 tk_popup $headctxmenu $x $y
6289 global headmenuid headmenuhead mainhead headids
6290 global showlocalchanges mainheadid
6292 # check the tree is clean first??
6293 set oldmainhead $mainhead
6298 exec git checkout -q $headmenuhead
6304 set mainhead $headmenuhead
6305 set mainheadid $headmenuid
6306 if {[info exists headids($oldmainhead)]} {
6307 redrawtags $headids($oldmainhead)
6309 redrawtags $headmenuid
6311 if {$showlocalchanges} {
6317 global headmenuid headmenuhead mainhead
6320 set head $headmenuhead
6322 # this check shouldn't be needed any more...
6323 if {$head eq $mainhead} {
6324 error_popup "Cannot delete the currently checked-out branch"
6327 set dheads [descheads $id]
6328 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6329 # the stuff on this branch isn't on any other branch
6330 if {![confirm_popup "The commits on branch $head aren't on any other\
6331 branch.\nReally delete branch $head?"]} return
6335 if {[catch {exec git branch -D $head} err]} {
6340 removehead $id $head
6341 removedhead $id $head
6348 # Display a list of tags and heads
6350 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6351 global bglist fglist uifont reflistfilter reflist maincursor
6354 set showrefstop $top
6355 if {[winfo exists $top]} {
6361 wm title $top "Tags and heads: [file tail [pwd]]"
6362 text $top.list -background $bgcolor -foreground $fgcolor \
6363 -selectbackground $selectbgcolor -font $mainfont \
6364 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6365 -width 30 -height 20 -cursor $maincursor \
6366 -spacing1 1 -spacing3 1 -state disabled
6367 $top.list tag configure highlight -background $selectbgcolor
6368 lappend bglist $top.list
6369 lappend fglist $top.list
6370 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6371 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6372 grid $top.list $top.ysb -sticky nsew
6373 grid $top.xsb x -sticky ew
6375 label $top.f.l -text "Filter: " -font $uifont
6376 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6377 set reflistfilter "*"
6378 trace add variable reflistfilter write reflistfilter_change
6379 pack $top.f.e -side right -fill x -expand 1
6380 pack $top.f.l -side left
6381 grid $top.f - -sticky ew -pady 2
6382 button $top.close -command [list destroy $top] -text "Close" \
6385 grid columnconfigure $top 0 -weight 1
6386 grid rowconfigure $top 0 -weight 1
6387 bind $top.list <1> {break}
6388 bind $top.list <B1-Motion> {break}
6389 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6394 proc sel_reflist {w x y} {
6395 global showrefstop reflist headids tagids otherrefids
6397 if {![winfo exists $showrefstop]} return
6398 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6399 set ref [lindex $reflist [expr {$l-1}]]
6400 set n [lindex $ref 0]
6401 switch -- [lindex $ref 1] {
6402 "H" {selbyid $headids($n)}
6403 "T" {selbyid $tagids($n)}
6404 "o" {selbyid $otherrefids($n)}
6406 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6409 proc unsel_reflist {} {
6412 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6413 $showrefstop.list tag remove highlight 0.0 end
6416 proc reflistfilter_change {n1 n2 op} {
6417 global reflistfilter
6419 after cancel refill_reflist
6420 after 200 refill_reflist
6423 proc refill_reflist {} {
6424 global reflist reflistfilter showrefstop headids tagids otherrefids
6425 global commitrow curview commitinterest
6427 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6429 foreach n [array names headids] {
6430 if {[string match $reflistfilter $n]} {
6431 if {[info exists commitrow($curview,$headids($n))]} {
6432 lappend refs [list $n H]
6434 set commitinterest($headids($n)) {run refill_reflist}
6438 foreach n [array names tagids] {
6439 if {[string match $reflistfilter $n]} {
6440 if {[info exists commitrow($curview,$tagids($n))]} {
6441 lappend refs [list $n T]
6443 set commitinterest($tagids($n)) {run refill_reflist}
6447 foreach n [array names otherrefids] {
6448 if {[string match $reflistfilter $n]} {
6449 if {[info exists commitrow($curview,$otherrefids($n))]} {
6450 lappend refs [list $n o]
6452 set commitinterest($otherrefids($n)) {run refill_reflist}
6456 set refs [lsort -index 0 $refs]
6457 if {$refs eq $reflist} return
6459 # Update the contents of $showrefstop.list according to the
6460 # differences between $reflist (old) and $refs (new)
6461 $showrefstop.list conf -state normal
6462 $showrefstop.list insert end "\n"
6465 while {$i < [llength $reflist] || $j < [llength $refs]} {
6466 if {$i < [llength $reflist]} {
6467 if {$j < [llength $refs]} {
6468 set cmp [string compare [lindex $reflist $i 0] \
6469 [lindex $refs $j 0]]
6471 set cmp [string compare [lindex $reflist $i 1] \
6472 [lindex $refs $j 1]]
6482 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6490 set l [expr {$j + 1}]
6491 $showrefstop.list image create $l.0 -align baseline \
6492 -image reficon-[lindex $refs $j 1] -padx 2
6493 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6499 # delete last newline
6500 $showrefstop.list delete end-2c end-1c
6501 $showrefstop.list conf -state disabled
6504 # Stuff for finding nearby tags
6505 proc getallcommits {} {
6506 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6507 global idheads idtags idotherrefs allparents tagobjid
6509 if {![info exists allcommits]} {
6515 set allccache [file join [gitdir] "gitk.cache"]
6517 set f [open $allccache r]
6526 set cmd [list | git rev-list --parents]
6527 set allcupdate [expr {$seeds ne {}}]
6531 set refs [concat [array names idheads] [array names idtags] \
6532 [array names idotherrefs]]
6535 foreach name [array names tagobjid] {
6536 lappend tagobjs $tagobjid($name)
6538 foreach id [lsort -unique $refs] {
6539 if {![info exists allparents($id)] &&
6540 [lsearch -exact $tagobjs $id] < 0} {
6551 set fd [open [concat $cmd $ids] r]
6552 fconfigure $fd -blocking 0
6555 filerun $fd [list getallclines $fd]
6561 # Since most commits have 1 parent and 1 child, we group strings of
6562 # such commits into "arcs" joining branch/merge points (BMPs), which
6563 # are commits that either don't have 1 parent or don't have 1 child.
6565 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6566 # arcout(id) - outgoing arcs for BMP
6567 # arcids(a) - list of IDs on arc including end but not start
6568 # arcstart(a) - BMP ID at start of arc
6569 # arcend(a) - BMP ID at end of arc
6570 # growing(a) - arc a is still growing
6571 # arctags(a) - IDs out of arcids (excluding end) that have tags
6572 # archeads(a) - IDs out of arcids (excluding end) that have heads
6573 # The start of an arc is at the descendent end, so "incoming" means
6574 # coming from descendents, and "outgoing" means going towards ancestors.
6576 proc getallclines {fd} {
6577 global allparents allchildren idtags idheads nextarc
6578 global arcnos arcids arctags arcout arcend arcstart archeads growing
6579 global seeds allcommits cachedarcs allcupdate
6582 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6583 set id [lindex $line 0]
6584 if {[info exists allparents($id)]} {
6589 set olds [lrange $line 1 end]
6590 set allparents($id) $olds
6591 if {![info exists allchildren($id)]} {
6592 set allchildren($id) {}
6597 if {[llength $olds] == 1 && [llength $a] == 1} {
6598 lappend arcids($a) $id
6599 if {[info exists idtags($id)]} {
6600 lappend arctags($a) $id
6602 if {[info exists idheads($id)]} {
6603 lappend archeads($a) $id
6605 if {[info exists allparents($olds)]} {
6606 # seen parent already
6607 if {![info exists arcout($olds)]} {
6610 lappend arcids($a) $olds
6611 set arcend($a) $olds
6614 lappend allchildren($olds) $id
6615 lappend arcnos($olds) $a
6619 foreach a $arcnos($id) {
6620 lappend arcids($a) $id
6627 lappend allchildren($p) $id
6628 set a [incr nextarc]
6629 set arcstart($a) $id
6636 if {[info exists allparents($p)]} {
6637 # seen it already, may need to make a new branch
6638 if {![info exists arcout($p)]} {
6641 lappend arcids($a) $p
6645 lappend arcnos($p) $a
6650 global cached_dheads cached_dtags cached_atags
6651 catch {unset cached_dheads}
6652 catch {unset cached_dtags}
6653 catch {unset cached_atags}
6656 return [expr {$nid >= 1000? 2: 1}]
6660 fconfigure $fd -blocking 1
6663 # got an error reading the list of commits
6664 # if we were updating, try rereading the whole thing again
6670 error_popup "Error reading commit topology information;\
6671 branch and preceding/following tag information\
6672 will be incomplete.\n($err)"
6675 if {[incr allcommits -1] == 0} {
6685 proc recalcarc {a} {
6686 global arctags archeads arcids idtags idheads
6690 foreach id [lrange $arcids($a) 0 end-1] {
6691 if {[info exists idtags($id)]} {
6694 if {[info exists idheads($id)]} {
6699 set archeads($a) $ah
6703 global arcnos arcids nextarc arctags archeads idtags idheads
6704 global arcstart arcend arcout allparents growing
6707 if {[llength $a] != 1} {
6708 puts "oops splitarc called but [llength $a] arcs already"
6712 set i [lsearch -exact $arcids($a) $p]
6714 puts "oops splitarc $p not in arc $a"
6717 set na [incr nextarc]
6718 if {[info exists arcend($a)]} {
6719 set arcend($na) $arcend($a)
6721 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6722 set j [lsearch -exact $arcnos($l) $a]
6723 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6725 set tail [lrange $arcids($a) [expr {$i+1}] end]
6726 set arcids($a) [lrange $arcids($a) 0 $i]
6728 set arcstart($na) $p
6730 set arcids($na) $tail
6731 if {[info exists growing($a)]} {
6737 if {[llength $arcnos($id)] == 1} {
6740 set j [lsearch -exact $arcnos($id) $a]
6741 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6745 # reconstruct tags and heads lists
6746 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6751 set archeads($na) {}
6755 # Update things for a new commit added that is a child of one
6756 # existing commit. Used when cherry-picking.
6757 proc addnewchild {id p} {
6758 global allparents allchildren idtags nextarc
6759 global arcnos arcids arctags arcout arcend arcstart archeads growing
6760 global seeds allcommits
6762 if {![info exists allcommits]} return
6763 set allparents($id) [list $p]
6764 set allchildren($id) {}
6767 lappend allchildren($p) $id
6768 set a [incr nextarc]
6769 set arcstart($a) $id
6772 set arcids($a) [list $p]
6774 if {![info exists arcout($p)]} {
6777 lappend arcnos($p) $a
6778 set arcout($id) [list $a]
6781 # This implements a cache for the topology information.
6782 # The cache saves, for each arc, the start and end of the arc,
6783 # the ids on the arc, and the outgoing arcs from the end.
6784 proc readcache {f} {
6785 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6786 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6791 if {$lim - $a > 500} {
6792 set lim [expr {$a + 500}]
6796 # finish reading the cache and setting up arctags, etc.
6798 if {$line ne "1"} {error "bad final version"}
6800 foreach id [array names idtags] {
6801 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6802 [llength $allparents($id)] == 1} {
6803 set a [lindex $arcnos($id) 0]
6804 if {$arctags($a) eq {}} {
6809 foreach id [array names idheads] {
6810 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6811 [llength $allparents($id)] == 1} {
6812 set a [lindex $arcnos($id) 0]
6813 if {$archeads($a) eq {}} {
6818 foreach id [lsort -unique $possible_seeds] {
6819 if {$arcnos($id) eq {}} {
6825 while {[incr a] <= $lim} {
6827 if {[llength $line] != 3} {error "bad line"}
6828 set s [lindex $line 0]
6830 lappend arcout($s) $a
6831 if {![info exists arcnos($s)]} {
6832 lappend possible_seeds $s
6835 set e [lindex $line 1]
6840 if {![info exists arcout($e)]} {
6844 set arcids($a) [lindex $line 2]
6845 foreach id $arcids($a) {
6846 lappend allparents($s) $id
6848 lappend arcnos($id) $a
6850 if {![info exists allparents($s)]} {
6851 set allparents($s) {}
6856 set nextarc [expr {$a - 1}]
6869 global nextarc cachedarcs possible_seeds
6873 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
6874 # make sure it's an integer
6875 set cachedarcs [expr {int([lindex $line 1])}]
6876 if {$cachedarcs < 0} {error "bad number of arcs"}
6878 set possible_seeds {}
6886 proc dropcache {err} {
6887 global allcwait nextarc cachedarcs seeds
6889 #puts "dropping cache ($err)"
6890 foreach v {arcnos arcout arcids arcstart arcend growing \
6891 arctags archeads allparents allchildren} {
6902 proc writecache {f} {
6903 global cachearc cachedarcs allccache
6904 global arcstart arcend arcnos arcids arcout
6908 if {$lim - $a > 1000} {
6909 set lim [expr {$a + 1000}]
6912 while {[incr a] <= $lim} {
6913 if {[info exists arcend($a)]} {
6914 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
6916 puts $f [list $arcstart($a) {} $arcids($a)]
6921 catch {file delete $allccache}
6922 #puts "writing cache failed ($err)"
6925 set cachearc [expr {$a - 1}]
6926 if {$a > $cachedarcs} {
6935 global nextarc cachedarcs cachearc allccache
6937 if {$nextarc == $cachedarcs} return
6939 set cachedarcs $nextarc
6941 set f [open $allccache w]
6942 puts $f [list 1 $cachedarcs]
6947 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6948 # or 0 if neither is true.
6949 proc anc_or_desc {a b} {
6950 global arcout arcstart arcend arcnos cached_isanc
6952 if {$arcnos($a) eq $arcnos($b)} {
6953 # Both are on the same arc(s); either both are the same BMP,
6954 # or if one is not a BMP, the other is also not a BMP or is
6955 # the BMP at end of the arc (and it only has 1 incoming arc).
6956 # Or both can be BMPs with no incoming arcs.
6957 if {$a eq $b || $arcnos($a) eq {}} {
6960 # assert {[llength $arcnos($a)] == 1}
6961 set arc [lindex $arcnos($a) 0]
6962 set i [lsearch -exact $arcids($arc) $a]
6963 set j [lsearch -exact $arcids($arc) $b]
6964 if {$i < 0 || $i > $j} {
6971 if {![info exists arcout($a)]} {
6972 set arc [lindex $arcnos($a) 0]
6973 if {[info exists arcend($arc)]} {
6974 set aend $arcend($arc)
6978 set a $arcstart($arc)
6982 if {![info exists arcout($b)]} {
6983 set arc [lindex $arcnos($b) 0]
6984 if {[info exists arcend($arc)]} {
6985 set bend $arcend($arc)
6989 set b $arcstart($arc)
6999 if {[info exists cached_isanc($a,$bend)]} {
7000 if {$cached_isanc($a,$bend)} {
7004 if {[info exists cached_isanc($b,$aend)]} {
7005 if {$cached_isanc($b,$aend)} {
7008 if {[info exists cached_isanc($a,$bend)]} {
7013 set todo [list $a $b]
7016 for {set i 0} {$i < [llength $todo]} {incr i} {
7017 set x [lindex $todo $i]
7018 if {$anc($x) eq {}} {
7021 foreach arc $arcnos($x) {
7022 set xd $arcstart($arc)
7024 set cached_isanc($a,$bend) 1
7025 set cached_isanc($b,$aend) 0
7027 } elseif {$xd eq $aend} {
7028 set cached_isanc($b,$aend) 1
7029 set cached_isanc($a,$bend) 0
7032 if {![info exists anc($xd)]} {
7033 set anc($xd) $anc($x)
7035 } elseif {$anc($xd) ne $anc($x)} {
7040 set cached_isanc($a,$bend) 0
7041 set cached_isanc($b,$aend) 0
7045 # This identifies whether $desc has an ancestor that is
7046 # a growing tip of the graph and which is not an ancestor of $anc
7047 # and returns 0 if so and 1 if not.
7048 # If we subsequently discover a tag on such a growing tip, and that
7049 # turns out to be a descendent of $anc (which it could, since we
7050 # don't necessarily see children before parents), then $desc
7051 # isn't a good choice to display as a descendent tag of
7052 # $anc (since it is the descendent of another tag which is
7053 # a descendent of $anc). Similarly, $anc isn't a good choice to
7054 # display as a ancestor tag of $desc.
7056 proc is_certain {desc anc} {
7057 global arcnos arcout arcstart arcend growing problems
7060 if {[llength $arcnos($anc)] == 1} {
7061 # tags on the same arc are certain
7062 if {$arcnos($desc) eq $arcnos($anc)} {
7065 if {![info exists arcout($anc)]} {
7066 # if $anc is partway along an arc, use the start of the arc instead
7067 set a [lindex $arcnos($anc) 0]
7068 set anc $arcstart($a)
7071 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7074 set a [lindex $arcnos($desc) 0]
7080 set anclist [list $x]
7084 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7085 set x [lindex $anclist $i]
7090 foreach a $arcout($x) {
7091 if {[info exists growing($a)]} {
7092 if {![info exists growanc($x)] && $dl($x)} {
7098 if {[info exists dl($y)]} {
7102 if {![info exists done($y)]} {
7105 if {[info exists growanc($x)]} {
7109 for {set k 0} {$k < [llength $xl]} {incr k} {
7110 set z [lindex $xl $k]
7111 foreach c $arcout($z) {
7112 if {[info exists arcend($c)]} {
7114 if {[info exists dl($v)] && $dl($v)} {
7116 if {![info exists done($v)]} {
7119 if {[info exists growanc($v)]} {
7129 } elseif {$y eq $anc || !$dl($x)} {
7140 foreach x [array names growanc] {
7149 proc validate_arctags {a} {
7150 global arctags idtags
7154 foreach id $arctags($a) {
7156 if {![info exists idtags($id)]} {
7157 set na [lreplace $na $i $i]
7164 proc validate_archeads {a} {
7165 global archeads idheads
7168 set na $archeads($a)
7169 foreach id $archeads($a) {
7171 if {![info exists idheads($id)]} {
7172 set na [lreplace $na $i $i]
7176 set archeads($a) $na
7179 # Return the list of IDs that have tags that are descendents of id,
7180 # ignoring IDs that are descendents of IDs already reported.
7181 proc desctags {id} {
7182 global arcnos arcstart arcids arctags idtags allparents
7183 global growing cached_dtags
7185 if {![info exists allparents($id)]} {
7188 set t1 [clock clicks -milliseconds]
7190 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7191 # part-way along an arc; check that arc first
7192 set a [lindex $arcnos($id) 0]
7193 if {$arctags($a) ne {}} {
7195 set i [lsearch -exact $arcids($a) $id]
7197 foreach t $arctags($a) {
7198 set j [lsearch -exact $arcids($a) $t]
7206 set id $arcstart($a)
7207 if {[info exists idtags($id)]} {
7211 if {[info exists cached_dtags($id)]} {
7212 return $cached_dtags($id)
7219 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7220 set id [lindex $todo $i]
7222 set ta [info exists hastaggedancestor($id)]
7226 # ignore tags on starting node
7227 if {!$ta && $i > 0} {
7228 if {[info exists idtags($id)]} {
7231 } elseif {[info exists cached_dtags($id)]} {
7232 set tagloc($id) $cached_dtags($id)
7236 foreach a $arcnos($id) {
7238 if {!$ta && $arctags($a) ne {}} {
7240 if {$arctags($a) ne {}} {
7241 lappend tagloc($id) [lindex $arctags($a) end]
7244 if {$ta || $arctags($a) ne {}} {
7245 set tomark [list $d]
7246 for {set j 0} {$j < [llength $tomark]} {incr j} {
7247 set dd [lindex $tomark $j]
7248 if {![info exists hastaggedancestor($dd)]} {
7249 if {[info exists done($dd)]} {
7250 foreach b $arcnos($dd) {
7251 lappend tomark $arcstart($b)
7253 if {[info exists tagloc($dd)]} {
7256 } elseif {[info exists queued($dd)]} {
7259 set hastaggedancestor($dd) 1
7263 if {![info exists queued($d)]} {
7266 if {![info exists hastaggedancestor($d)]} {
7273 foreach id [array names tagloc] {
7274 if {![info exists hastaggedancestor($id)]} {
7275 foreach t $tagloc($id) {
7276 if {[lsearch -exact $tags $t] < 0} {
7282 set t2 [clock clicks -milliseconds]
7285 # remove tags that are descendents of other tags
7286 for {set i 0} {$i < [llength $tags]} {incr i} {
7287 set a [lindex $tags $i]
7288 for {set j 0} {$j < $i} {incr j} {
7289 set b [lindex $tags $j]
7290 set r [anc_or_desc $a $b]
7292 set tags [lreplace $tags $j $j]
7295 } elseif {$r == -1} {
7296 set tags [lreplace $tags $i $i]
7303 if {[array names growing] ne {}} {
7304 # graph isn't finished, need to check if any tag could get
7305 # eclipsed by another tag coming later. Simply ignore any
7306 # tags that could later get eclipsed.
7309 if {[is_certain $t $origid]} {
7313 if {$tags eq $ctags} {
7314 set cached_dtags($origid) $tags
7319 set cached_dtags($origid) $tags
7321 set t3 [clock clicks -milliseconds]
7322 if {0 && $t3 - $t1 >= 100} {
7323 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7324 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7330 global arcnos arcids arcout arcend arctags idtags allparents
7331 global growing cached_atags
7333 if {![info exists allparents($id)]} {
7336 set t1 [clock clicks -milliseconds]
7338 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7339 # part-way along an arc; check that arc first
7340 set a [lindex $arcnos($id) 0]
7341 if {$arctags($a) ne {}} {
7343 set i [lsearch -exact $arcids($a) $id]
7344 foreach t $arctags($a) {
7345 set j [lsearch -exact $arcids($a) $t]
7351 if {![info exists arcend($a)]} {
7355 if {[info exists idtags($id)]} {
7359 if {[info exists cached_atags($id)]} {
7360 return $cached_atags($id)
7368 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7369 set id [lindex $todo $i]
7371 set td [info exists hastaggeddescendent($id)]
7375 # ignore tags on starting node
7376 if {!$td && $i > 0} {
7377 if {[info exists idtags($id)]} {
7380 } elseif {[info exists cached_atags($id)]} {
7381 set tagloc($id) $cached_atags($id)
7385 foreach a $arcout($id) {
7386 if {!$td && $arctags($a) ne {}} {
7388 if {$arctags($a) ne {}} {
7389 lappend tagloc($id) [lindex $arctags($a) 0]
7392 if {![info exists arcend($a)]} continue
7394 if {$td || $arctags($a) ne {}} {
7395 set tomark [list $d]
7396 for {set j 0} {$j < [llength $tomark]} {incr j} {
7397 set dd [lindex $tomark $j]
7398 if {![info exists hastaggeddescendent($dd)]} {
7399 if {[info exists done($dd)]} {
7400 foreach b $arcout($dd) {
7401 if {[info exists arcend($b)]} {
7402 lappend tomark $arcend($b)
7405 if {[info exists tagloc($dd)]} {
7408 } elseif {[info exists queued($dd)]} {
7411 set hastaggeddescendent($dd) 1
7415 if {![info exists queued($d)]} {
7418 if {![info exists hastaggeddescendent($d)]} {
7424 set t2 [clock clicks -milliseconds]
7427 foreach id [array names tagloc] {
7428 if {![info exists hastaggeddescendent($id)]} {
7429 foreach t $tagloc($id) {
7430 if {[lsearch -exact $tags $t] < 0} {
7437 # remove tags that are ancestors of other tags
7438 for {set i 0} {$i < [llength $tags]} {incr i} {
7439 set a [lindex $tags $i]
7440 for {set j 0} {$j < $i} {incr j} {
7441 set b [lindex $tags $j]
7442 set r [anc_or_desc $a $b]
7444 set tags [lreplace $tags $j $j]
7447 } elseif {$r == 1} {
7448 set tags [lreplace $tags $i $i]
7455 if {[array names growing] ne {}} {
7456 # graph isn't finished, need to check if any tag could get
7457 # eclipsed by another tag coming later. Simply ignore any
7458 # tags that could later get eclipsed.
7461 if {[is_certain $origid $t]} {
7465 if {$tags eq $ctags} {
7466 set cached_atags($origid) $tags
7471 set cached_atags($origid) $tags
7473 set t3 [clock clicks -milliseconds]
7474 if {0 && $t3 - $t1 >= 100} {
7475 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7476 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7481 # Return the list of IDs that have heads that are descendents of id,
7482 # including id itself if it has a head.
7483 proc descheads {id} {
7484 global arcnos arcstart arcids archeads idheads cached_dheads
7487 if {![info exists allparents($id)]} {
7491 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7492 # part-way along an arc; check it first
7493 set a [lindex $arcnos($id) 0]
7494 if {$archeads($a) ne {}} {
7495 validate_archeads $a
7496 set i [lsearch -exact $arcids($a) $id]
7497 foreach t $archeads($a) {
7498 set j [lsearch -exact $arcids($a) $t]
7503 set id $arcstart($a)
7509 for {set i 0} {$i < [llength $todo]} {incr i} {
7510 set id [lindex $todo $i]
7511 if {[info exists cached_dheads($id)]} {
7512 set ret [concat $ret $cached_dheads($id)]
7514 if {[info exists idheads($id)]} {
7517 foreach a $arcnos($id) {
7518 if {$archeads($a) ne {}} {
7519 validate_archeads $a
7520 if {$archeads($a) ne {}} {
7521 set ret [concat $ret $archeads($a)]
7525 if {![info exists seen($d)]} {
7532 set ret [lsort -unique $ret]
7533 set cached_dheads($origid) $ret
7534 return [concat $ret $aret]
7537 proc addedtag {id} {
7538 global arcnos arcout cached_dtags cached_atags
7540 if {![info exists arcnos($id)]} return
7541 if {![info exists arcout($id)]} {
7542 recalcarc [lindex $arcnos($id) 0]
7544 catch {unset cached_dtags}
7545 catch {unset cached_atags}
7548 proc addedhead {hid head} {
7549 global arcnos arcout cached_dheads
7551 if {![info exists arcnos($hid)]} return
7552 if {![info exists arcout($hid)]} {
7553 recalcarc [lindex $arcnos($hid) 0]
7555 catch {unset cached_dheads}
7558 proc removedhead {hid head} {
7559 global cached_dheads
7561 catch {unset cached_dheads}
7564 proc movedhead {hid head} {
7565 global arcnos arcout cached_dheads
7567 if {![info exists arcnos($hid)]} return
7568 if {![info exists arcout($hid)]} {
7569 recalcarc [lindex $arcnos($hid) 0]
7571 catch {unset cached_dheads}
7574 proc changedrefs {} {
7575 global cached_dheads cached_dtags cached_atags
7576 global arctags archeads arcnos arcout idheads idtags
7578 foreach id [concat [array names idheads] [array names idtags]] {
7579 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7580 set a [lindex $arcnos($id) 0]
7581 if {![info exists donearc($a)]} {
7587 catch {unset cached_dtags}
7588 catch {unset cached_atags}
7589 catch {unset cached_dheads}
7592 proc rereadrefs {} {
7593 global idtags idheads idotherrefs mainhead
7595 set refids [concat [array names idtags] \
7596 [array names idheads] [array names idotherrefs]]
7597 foreach id $refids {
7598 if {![info exists ref($id)]} {
7599 set ref($id) [listrefs $id]
7602 set oldmainhead $mainhead
7605 set refids [lsort -unique [concat $refids [array names idtags] \
7606 [array names idheads] [array names idotherrefs]]]
7607 foreach id $refids {
7608 set v [listrefs $id]
7609 if {![info exists ref($id)] || $ref($id) != $v ||
7610 ($id eq $oldmainhead && $id ne $mainhead) ||
7611 ($id eq $mainhead && $id ne $oldmainhead)} {
7618 proc listrefs {id} {
7619 global idtags idheads idotherrefs
7622 if {[info exists idtags($id)]} {
7626 if {[info exists idheads($id)]} {
7630 if {[info exists idotherrefs($id)]} {
7631 set z $idotherrefs($id)
7633 return [list $x $y $z]
7636 proc showtag {tag isnew} {
7637 global ctext tagcontents tagids linknum tagobjid
7640 addtohistory [list showtag $tag 0]
7642 $ctext conf -state normal
7645 if {![info exists tagcontents($tag)]} {
7647 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7650 if {[info exists tagcontents($tag)]} {
7651 set text $tagcontents($tag)
7653 set text "Tag: $tag\nId: $tagids($tag)"
7655 appendwithlinks $text {}
7656 $ctext conf -state disabled
7668 global maxwidth maxgraphpct diffopts
7669 global oldprefs prefstop showneartags showlocalchanges
7670 global bgcolor fgcolor ctext diffcolors selectbgcolor
7671 global uifont tabstop
7675 if {[winfo exists $top]} {
7679 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7680 set oldprefs($v) [set $v]
7683 wm title $top "Gitk preferences"
7684 label $top.ldisp -text "Commit list display options"
7685 $top.ldisp configure -font $uifont
7686 grid $top.ldisp - -sticky w -pady 10
7687 label $top.spacer -text " "
7688 label $top.maxwidthl -text "Maximum graph width (lines)" \
7690 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7691 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7692 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7694 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7695 grid x $top.maxpctl $top.maxpct -sticky w
7696 frame $top.showlocal
7697 label $top.showlocal.l -text "Show local changes" -font optionfont
7698 checkbutton $top.showlocal.b -variable showlocalchanges
7699 pack $top.showlocal.b $top.showlocal.l -side left
7700 grid x $top.showlocal -sticky w
7702 label $top.ddisp -text "Diff display options"
7703 $top.ddisp configure -font $uifont
7704 grid $top.ddisp - -sticky w -pady 10
7705 label $top.diffoptl -text "Options for diff program" \
7707 entry $top.diffopt -width 20 -textvariable diffopts
7708 grid x $top.diffoptl $top.diffopt -sticky w
7710 label $top.ntag.l -text "Display nearby tags" -font optionfont
7711 checkbutton $top.ntag.b -variable showneartags
7712 pack $top.ntag.b $top.ntag.l -side left
7713 grid x $top.ntag -sticky w
7714 label $top.tabstopl -text "tabstop" -font optionfont
7715 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7716 grid x $top.tabstopl $top.tabstop -sticky w
7718 label $top.cdisp -text "Colors: press to choose"
7719 $top.cdisp configure -font $uifont
7720 grid $top.cdisp - -sticky w -pady 10
7721 label $top.bg -padx 40 -relief sunk -background $bgcolor
7722 button $top.bgbut -text "Background" -font optionfont \
7723 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7724 grid x $top.bgbut $top.bg -sticky w
7725 label $top.fg -padx 40 -relief sunk -background $fgcolor
7726 button $top.fgbut -text "Foreground" -font optionfont \
7727 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7728 grid x $top.fgbut $top.fg -sticky w
7729 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7730 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7731 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7732 [list $ctext tag conf d0 -foreground]]
7733 grid x $top.diffoldbut $top.diffold -sticky w
7734 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7735 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7736 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7737 [list $ctext tag conf d1 -foreground]]
7738 grid x $top.diffnewbut $top.diffnew -sticky w
7739 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7740 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7741 -command [list choosecolor diffcolors 2 $top.hunksep \
7742 "diff hunk header" \
7743 [list $ctext tag conf hunksep -foreground]]
7744 grid x $top.hunksepbut $top.hunksep -sticky w
7745 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7746 button $top.selbgbut -text "Select bg" -font optionfont \
7747 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7748 grid x $top.selbgbut $top.selbgsep -sticky w
7751 button $top.buts.ok -text "OK" -command prefsok -default active
7752 $top.buts.ok configure -font $uifont
7753 button $top.buts.can -text "Cancel" -command prefscan -default normal
7754 $top.buts.can configure -font $uifont
7755 grid $top.buts.ok $top.buts.can
7756 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7757 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7758 grid $top.buts - - -pady 10 -sticky ew
7759 bind $top <Visibility> "focus $top.buts.ok"
7762 proc choosecolor {v vi w x cmd} {
7765 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7766 -title "Gitk: choose color for $x"]
7767 if {$c eq {}} return
7768 $w conf -background $c
7774 global bglist cflist
7776 $w configure -selectbackground $c
7778 $cflist tag configure highlight \
7779 -background [$cflist cget -selectbackground]
7780 allcanvs itemconf secsel -fill $c
7787 $w conf -background $c
7795 $w conf -foreground $c
7797 allcanvs itemconf text -fill $c
7798 $canv itemconf circle -outline $c
7802 global maxwidth maxgraphpct diffopts
7803 global oldprefs prefstop showneartags showlocalchanges
7805 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7806 set $v $oldprefs($v)
7808 catch {destroy $prefstop}
7813 global maxwidth maxgraphpct
7814 global oldprefs prefstop showneartags showlocalchanges
7815 global charspc ctext tabstop
7817 catch {destroy $prefstop}
7819 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7820 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7821 if {$showlocalchanges} {
7827 if {$maxwidth != $oldprefs(maxwidth)
7828 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7830 } elseif {$showneartags != $oldprefs(showneartags)} {
7835 proc formatdate {d} {
7836 global datetimeformat
7838 set d [clock format $d -format $datetimeformat]
7843 # This list of encoding names and aliases is distilled from
7844 # http://www.iana.org/assignments/character-sets.
7845 # Not all of them are supported by Tcl.
7846 set encoding_aliases {
7847 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7848 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7849 { ISO-10646-UTF-1 csISO10646UTF1 }
7850 { ISO_646.basic:1983 ref csISO646basic1983 }
7851 { INVARIANT csINVARIANT }
7852 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7853 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7854 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7855 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7856 { NATS-DANO iso-ir-9-1 csNATSDANO }
7857 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7858 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7859 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7860 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7861 { ISO-2022-KR csISO2022KR }
7863 { ISO-2022-JP csISO2022JP }
7864 { ISO-2022-JP-2 csISO2022JP2 }
7865 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7867 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7868 { IT iso-ir-15 ISO646-IT csISO15Italian }
7869 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7870 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7871 { greek7-old iso-ir-18 csISO18Greek7Old }
7872 { latin-greek iso-ir-19 csISO19LatinGreek }
7873 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7874 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7875 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7876 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7877 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7878 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7879 { INIS iso-ir-49 csISO49INIS }
7880 { INIS-8 iso-ir-50 csISO50INIS8 }
7881 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7882 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7883 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7884 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7885 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7886 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7888 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7889 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7890 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7891 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7892 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7893 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7894 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7895 { greek7 iso-ir-88 csISO88Greek7 }
7896 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7897 { iso-ir-90 csISO90 }
7898 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7899 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7900 csISO92JISC62991984b }
7901 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7902 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7903 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7904 csISO95JIS62291984handadd }
7905 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7906 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7907 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7908 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7910 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7911 { T.61-7bit iso-ir-102 csISO102T617bit }
7912 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7913 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7914 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7915 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7916 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7917 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7918 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7919 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7920 arabic csISOLatinArabic }
7921 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7922 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7923 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7924 greek greek8 csISOLatinGreek }
7925 { T.101-G2 iso-ir-128 csISO128T101G2 }
7926 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7928 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7929 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7930 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7931 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7932 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7933 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7934 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7935 csISOLatinCyrillic }
7936 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7937 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7938 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7939 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7940 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7941 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7942 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7943 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7944 { ISO_10367-box iso-ir-155 csISO10367Box }
7945 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7946 { latin-lap lap iso-ir-158 csISO158Lap }
7947 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7948 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7951 { JIS_X0201 X0201 csHalfWidthKatakana }
7952 { KSC5636 ISO646-KR csKSC5636 }
7953 { ISO-10646-UCS-2 csUnicode }
7954 { ISO-10646-UCS-4 csUCS4 }
7955 { DEC-MCS dec csDECMCS }
7956 { hp-roman8 roman8 r8 csHPRoman8 }
7957 { macintosh mac csMacintosh }
7958 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7960 { IBM038 EBCDIC-INT cp038 csIBM038 }
7961 { IBM273 CP273 csIBM273 }
7962 { IBM274 EBCDIC-BE CP274 csIBM274 }
7963 { IBM275 EBCDIC-BR cp275 csIBM275 }
7964 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7965 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7966 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7967 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7968 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7969 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7970 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7971 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7972 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7973 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7974 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7975 { IBM437 cp437 437 csPC8CodePage437 }
7976 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7977 { IBM775 cp775 csPC775Baltic }
7978 { IBM850 cp850 850 csPC850Multilingual }
7979 { IBM851 cp851 851 csIBM851 }
7980 { IBM852 cp852 852 csPCp852 }
7981 { IBM855 cp855 855 csIBM855 }
7982 { IBM857 cp857 857 csIBM857 }
7983 { IBM860 cp860 860 csIBM860 }
7984 { IBM861 cp861 861 cp-is csIBM861 }
7985 { IBM862 cp862 862 csPC862LatinHebrew }
7986 { IBM863 cp863 863 csIBM863 }
7987 { IBM864 cp864 csIBM864 }
7988 { IBM865 cp865 865 csIBM865 }
7989 { IBM866 cp866 866 csIBM866 }
7990 { IBM868 CP868 cp-ar csIBM868 }
7991 { IBM869 cp869 869 cp-gr csIBM869 }
7992 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7993 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7994 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7995 { IBM891 cp891 csIBM891 }
7996 { IBM903 cp903 csIBM903 }
7997 { IBM904 cp904 904 csIBBM904 }
7998 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7999 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8000 { IBM1026 CP1026 csIBM1026 }
8001 { EBCDIC-AT-DE csIBMEBCDICATDE }
8002 { EBCDIC-AT-DE-A csEBCDICATDEA }
8003 { EBCDIC-CA-FR csEBCDICCAFR }
8004 { EBCDIC-DK-NO csEBCDICDKNO }
8005 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8006 { EBCDIC-FI-SE csEBCDICFISE }
8007 { EBCDIC-FI-SE-A csEBCDICFISEA }
8008 { EBCDIC-FR csEBCDICFR }
8009 { EBCDIC-IT csEBCDICIT }
8010 { EBCDIC-PT csEBCDICPT }
8011 { EBCDIC-ES csEBCDICES }
8012 { EBCDIC-ES-A csEBCDICESA }
8013 { EBCDIC-ES-S csEBCDICESS }
8014 { EBCDIC-UK csEBCDICUK }
8015 { EBCDIC-US csEBCDICUS }
8016 { UNKNOWN-8BIT csUnknown8BiT }
8017 { MNEMONIC csMnemonic }
8022 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8023 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8024 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8025 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8026 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8027 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8028 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8029 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8030 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8031 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8032 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8033 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8034 { IBM1047 IBM-1047 }
8035 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8036 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8037 { UNICODE-1-1 csUnicode11 }
8040 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8041 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8043 { ISO-8859-15 ISO_8859-15 Latin-9 }
8044 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8045 { GBK CP936 MS936 windows-936 }
8046 { JIS_Encoding csJISEncoding }
8047 { Shift_JIS MS_Kanji csShiftJIS }
8048 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8050 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8051 { ISO-10646-UCS-Basic csUnicodeASCII }
8052 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8053 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8054 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8055 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8056 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8057 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8058 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8059 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8060 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8061 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8062 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8063 { Ventura-US csVenturaUS }
8064 { Ventura-International csVenturaInternational }
8065 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8066 { PC8-Turkish csPC8Turkish }
8067 { IBM-Symbols csIBMSymbols }
8068 { IBM-Thai csIBMThai }
8069 { HP-Legal csHPLegal }
8070 { HP-Pi-font csHPPiFont }
8071 { HP-Math8 csHPMath8 }
8072 { Adobe-Symbol-Encoding csHPPSMath }
8073 { HP-DeskTop csHPDesktop }
8074 { Ventura-Math csVenturaMath }
8075 { Microsoft-Publishing csMicrosoftPublishing }
8076 { Windows-31J csWindows31J }
8081 proc tcl_encoding {enc} {
8082 global encoding_aliases
8083 set names [encoding names]
8084 set lcnames [string tolower $names]
8085 set enc [string tolower $enc]
8086 set i [lsearch -exact $lcnames $enc]
8088 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8089 if {[regsub {^iso[-_]} $enc iso encx]} {
8090 set i [lsearch -exact $lcnames $encx]
8094 foreach l $encoding_aliases {
8095 set ll [string tolower $l]
8096 if {[lsearch -exact $ll $enc] < 0} continue
8097 # look through the aliases for one that tcl knows about
8099 set i [lsearch -exact $lcnames $e]
8101 if {[regsub {^iso[-_]} $e iso ex]} {
8102 set i [lsearch -exact $lcnames $ex]
8111 return [lindex $names $i]
8118 set diffopts "-U 5 -p"
8119 set wrcomcmd "git diff-tree --stdin -p --pretty"
8123 set gitencoding [exec git config --get i18n.commitencoding]
8125 if {$gitencoding == ""} {
8126 set gitencoding "utf-8"
8128 set tclencoding [tcl_encoding $gitencoding]
8129 if {$tclencoding == {}} {
8130 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8133 set mainfont {Helvetica 9}
8134 set textfont {Courier 9}
8135 set uifont {Helvetica 9 bold}
8137 set findmergefiles 0
8145 set cmitmode "patch"
8146 set wrapcomment "none"
8150 set showlocalchanges 1
8151 set datetimeformat "%Y-%m-%d %H:%M:%S"
8153 set colors {green red blue magenta darkgrey brown orange}
8156 set diffcolors {red "#00a000" blue}
8158 set selectbgcolor gray85
8160 catch {source ~/.gitk}
8162 font create optionfont -family sans-serif -size -12
8164 # check that we can find a .git directory somewhere...
8165 if {[catch {set gitdir [gitdir]}]} {
8166 show_error {} . "Cannot find a git repository here."
8169 if {![file isdirectory $gitdir]} {
8170 show_error {} . "Cannot find the git directory \"$gitdir\"."
8175 set cmdline_files {}
8180 "-d" { set datemode 1 }
8182 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8186 lappend revtreeargs $arg
8192 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8193 # no -- on command line, but some arguments (other than -d)
8195 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8196 set cmdline_files [split $f "\n"]
8197 set n [llength $cmdline_files]
8198 set revtreeargs [lrange $revtreeargs 0 end-$n]
8199 # Unfortunately git rev-parse doesn't produce an error when
8200 # something is both a revision and a filename. To be consistent
8201 # with git log and git rev-list, check revtreeargs for filenames.
8202 foreach arg $revtreeargs {
8203 if {[file exists $arg]} {
8204 show_error {} . "Ambiguous argument '$arg': both revision\
8210 # unfortunately we get both stdout and stderr in $err,
8211 # so look for "fatal:".
8212 set i [string first "fatal:" $err]
8214 set err [string range $err [expr {$i + 6}] end]
8216 show_error {} . "Bad arguments to gitk:\n$err"
8221 set nullid "0000000000000000000000000000000000000000"
8222 set nullid2 "0000000000000000000000000000000000000001"
8230 set highlight_paths {}
8231 set searchdirn -forwards
8235 set markingmatches 0
8236 set linkentercount 0
8237 set need_redisplay 0
8243 set selectedhlview None
8252 set lookingforhead 0
8258 # wait for the window to become visible
8260 wm title . "[file tail $argv0]: [file tail [pwd]]"
8263 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8264 # create a view for the files/dirs specified on the command line
8268 set viewname(1) "Command line"
8269 set viewfiles(1) $cmdline_files
8270 set viewargs(1) $revtreeargs
8273 .bar.view entryconf Edit* -state normal
8274 .bar.view entryconf Delete* -state normal
8277 if {[info exists permviews]} {
8278 foreach v $permviews {
8281 set viewname($n) [lindex $v 0]
8282 set viewfiles($n) [lindex $v 1]
8283 set viewargs($n) [lindex $v 2]