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 vnextroot
86 global lookingforhead showlocalchanges
88 set startmsecs [clock clicks -milliseconds]
89 set commitidx($view) 0
90 set vnextroot($view) 0
91 set order "--topo-order"
93 set order "--date-order"
96 set fd [open [concat | git log -z --pretty=raw $order --parents \
97 --boundary $viewargs($view) "--" $viewfiles($view)] r]
99 error_popup "Error executing git rev-list: $err"
102 set commfd($view) $fd
103 set leftover($view) {}
104 set lookingforhead $showlocalchanges
105 fconfigure $fd -blocking 0 -translation lf -eofchar {}
106 if {$tclencoding != {}} {
107 fconfigure $fd -encoding $tclencoding
109 filerun $fd [list getcommitlines $fd $view]
113 proc stop_rev_list {} {
114 global commfd curview
116 if {![info exists commfd($curview)]} return
117 set fd $commfd($curview)
123 unset commfd($curview)
127 global phase canv mainfont curview
131 start_rev_list $curview
132 show_status "Reading commits..."
135 # This makes a string representation of a positive integer which
136 # sorts as a string in numerical order
139 return [format "%x" $n]
140 } elseif {$n < 256} {
141 return [format "x%.2x" $n]
142 } elseif {$n < 65536} {
143 return [format "y%.4x" $n]
145 return [format "z%.8x" $n]
148 proc getcommitlines {fd view} {
150 global leftover commfd
151 global displayorder commitidx commitrow commitdata
152 global parentlist children curview hlview
153 global vparentlist vdisporder vcmitlisted
154 global ordertok vnextroot idpending
156 set stuff [read $fd 500000]
157 # git log doesn't terminate the last commit with a null...
158 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
165 # Check if we have seen any ids listed as parents that haven't
166 # appeared in the list
167 foreach vid [array names idpending "$view,*"] {
168 # should only get here if git log is buggy
169 set id [lindex [split $vid ","] 1]
170 set commitrow($vid) $commitidx($view)
171 incr commitidx($view)
172 if {$view == $curview} {
173 lappend parentlist {}
174 lappend displayorder $id
175 lappend commitlisted 0
177 lappend vparentlist($view) {}
178 lappend vdisporder($view) $id
179 lappend vcmitlisted($view) 0
185 # set it blocking so we wait for the process to terminate
186 fconfigure $fd -blocking 1
187 if {[catch {close $fd} err]} {
189 if {$view != $curview} {
190 set fv " for the \"$viewname($view)\" view"
192 if {[string range $err 0 4] == "usage"} {
193 set err "Gitk: error reading commits$fv:\
194 bad arguments to git rev-list."
195 if {$viewname($view) eq "Command line"} {
197 " (Note: arguments to gitk are passed to git rev-list\
198 to allow selection of commits to be displayed.)"
201 set err "Error reading commits$fv: $err"
205 if {$view == $curview} {
206 run chewcommits $view
213 set i [string first "\0" $stuff $start]
215 append leftover($view) [string range $stuff $start end]
219 set cmit $leftover($view)
220 append cmit [string range $stuff 0 [expr {$i - 1}]]
221 set leftover($view) {}
223 set cmit [string range $stuff $start [expr {$i - 1}]]
225 set start [expr {$i + 1}]
226 set j [string first "\n" $cmit]
229 if {$j >= 0 && [string match "commit *" $cmit]} {
230 set ids [string range $cmit 7 [expr {$j - 1}]]
231 if {[string match {[-<>]*} $ids]} {
232 switch -- [string index $ids 0] {
237 set ids [string range $ids 1 end]
241 if {[string length $id] != 40} {
249 if {[string length $shortcmit] > 80} {
250 set shortcmit "[string range $shortcmit 0 80]..."
252 error_popup "Can't parse git log output: {$shortcmit}"
255 set id [lindex $ids 0]
256 if {![info exists ordertok($view,$id)]} {
257 set otok "o[strrep $vnextroot($view)]"
258 incr vnextroot($view)
259 set ordertok($view,$id) $otok
261 set otok $ordertok($view,$id)
262 unset idpending($view,$id)
265 set olds [lrange $ids 1 end]
266 if {[llength $olds] == 1} {
267 set p [lindex $olds 0]
268 lappend children($view,$p) $id
269 if {![info exists ordertok($view,$p)]} {
270 set ordertok($view,$p) $ordertok($view,$id)
271 set idpending($view,$p) 1
276 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
277 lappend children($view,$p) $id
279 if {![info exists ordertok($view,$p)]} {
280 set ordertok($view,$p) "$otok[strrep $i]]"
281 set idpending($view,$p) 1
289 if {![info exists children($view,$id)]} {
290 set children($view,$id) {}
292 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
293 set commitrow($view,$id) $commitidx($view)
294 incr commitidx($view)
295 if {$view == $curview} {
296 lappend parentlist $olds
297 lappend displayorder $id
298 lappend commitlisted $listed
300 lappend vparentlist($view) $olds
301 lappend vdisporder($view) $id
302 lappend vcmitlisted($view) $listed
307 run chewcommits $view
312 proc chewcommits {view} {
313 global curview hlview commfd
314 global selectedline pending_select
317 if {$view == $curview} {
318 set allread [expr {![info exists commfd($view)]}]
319 set tlimit [expr {[clock clicks -milliseconds] + 50}]
320 set more [layoutmore $tlimit $allread]
321 if {$allread && !$more} {
322 global displayorder commitidx phase
323 global numcommits startmsecs
325 if {[info exists pending_select]} {
326 set row [first_real_row]
329 if {$commitidx($curview) > 0} {
330 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
331 #puts "overall $ms ms for $numcommits commits"
333 show_status "No commits selected"
339 if {[info exists hlview] && $view == $hlview} {
345 proc readcommit {id} {
346 if {[catch {set contents [exec git cat-file commit $id]}]} return
347 parsecommit $id $contents 0
350 proc updatecommits {} {
351 global viewdata curview phase displayorder ordertok idpending
352 global children commitrow selectedline thickerline showneartags
359 foreach id $displayorder {
360 catch {unset children($n,$id)}
361 catch {unset commitrow($n,$id)}
362 catch {unset ordertok($n,$id)}
364 foreach vid [array names idpending "$n,*"] {
365 unset idpending($vid)
368 catch {unset selectedline}
369 catch {unset thickerline}
370 catch {unset viewdata($n)}
379 proc parsecommit {id contents listed} {
380 global commitinfo cdate
389 set hdrend [string first "\n\n" $contents]
391 # should never happen...
392 set hdrend [string length $contents]
394 set header [string range $contents 0 [expr {$hdrend - 1}]]
395 set comment [string range $contents [expr {$hdrend + 2}] end]
396 foreach line [split $header "\n"] {
397 set tag [lindex $line 0]
398 if {$tag == "author"} {
399 set audate [lindex $line end-1]
400 set auname [lrange $line 1 end-2]
401 } elseif {$tag == "committer"} {
402 set comdate [lindex $line end-1]
403 set comname [lrange $line 1 end-2]
407 # take the first non-blank line of the comment as the headline
408 set headline [string trimleft $comment]
409 set i [string first "\n" $headline]
411 set headline [string range $headline 0 $i]
413 set headline [string trimright $headline]
414 set i [string first "\r" $headline]
416 set headline [string trimright [string range $headline 0 $i]]
419 # git rev-list indents the comment by 4 spaces;
420 # if we got this via git cat-file, add the indentation
422 foreach line [split $comment "\n"] {
423 append newcomment " "
424 append newcomment $line
425 append newcomment "\n"
427 set comment $newcomment
429 if {$comdate != {}} {
430 set cdate($id) $comdate
432 set commitinfo($id) [list $headline $auname $audate \
433 $comname $comdate $comment]
436 proc getcommit {id} {
437 global commitdata commitinfo
439 if {[info exists commitdata($id)]} {
440 parsecommit $id $commitdata($id) 1
443 if {![info exists commitinfo($id)]} {
444 set commitinfo($id) {"No commit information available"}
451 global tagids idtags headids idheads tagobjid
452 global otherrefids idotherrefs mainhead mainheadid
454 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
457 set refd [open [list | git show-ref -d] r]
458 while {[gets $refd line] >= 0} {
459 if {[string index $line 40] ne " "} continue
460 set id [string range $line 0 39]
461 set ref [string range $line 41 end]
462 if {![string match "refs/*" $ref]} continue
463 set name [string range $ref 5 end]
464 if {[string match "remotes/*" $name]} {
465 if {![string match "*/HEAD" $name]} {
466 set headids($name) $id
467 lappend idheads($id) $name
469 } elseif {[string match "heads/*" $name]} {
470 set name [string range $name 6 end]
471 set headids($name) $id
472 lappend idheads($id) $name
473 } elseif {[string match "tags/*" $name]} {
474 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
475 # which is what we want since the former is the commit ID
476 set name [string range $name 5 end]
477 if {[string match "*^{}" $name]} {
478 set name [string range $name 0 end-3]
480 set tagobjid($name) $id
482 set tagids($name) $id
483 lappend idtags($id) $name
485 set otherrefids($name) $id
486 lappend idotherrefs($id) $name
493 set thehead [exec git symbolic-ref HEAD]
494 if {[string match "refs/heads/*" $thehead]} {
495 set mainhead [string range $thehead 11 end]
496 if {[info exists headids($mainhead)]} {
497 set mainheadid $headids($mainhead)
503 # skip over fake commits
504 proc first_real_row {} {
505 global nullid nullid2 displayorder numcommits
507 for {set row 0} {$row < $numcommits} {incr row} {
508 set id [lindex $displayorder $row]
509 if {$id ne $nullid && $id ne $nullid2} {
516 # update things for a head moved to a child of its previous location
517 proc movehead {id name} {
518 global headids idheads
520 removehead $headids($name) $name
521 set headids($name) $id
522 lappend idheads($id) $name
525 # update things when a head has been removed
526 proc removehead {id name} {
527 global headids idheads
529 if {$idheads($id) eq $name} {
532 set i [lsearch -exact $idheads($id) $name]
534 set idheads($id) [lreplace $idheads($id) $i $i]
540 proc show_error {w top msg} {
541 message $w.m -text $msg -justify center -aspect 400
542 pack $w.m -side top -fill x -padx 20 -pady 20
543 button $w.ok -text OK -command "destroy $top"
544 pack $w.ok -side bottom -fill x
545 bind $top <Visibility> "grab $top; focus $top"
546 bind $top <Key-Return> "destroy $top"
550 proc error_popup msg {
554 show_error $w $w $msg
557 proc confirm_popup msg {
563 message $w.m -text $msg -justify center -aspect 400
564 pack $w.m -side top -fill x -padx 20 -pady 20
565 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
566 pack $w.ok -side left -fill x
567 button $w.cancel -text Cancel -command "destroy $w"
568 pack $w.cancel -side right -fill x
569 bind $w <Visibility> "grab $w; focus $w"
575 global canv canv2 canv3 linespc charspc ctext cflist
576 global textfont mainfont uifont tabstop
577 global findtype findtypemenu findloc findstring fstring geometry
578 global entries sha1entry sha1string sha1but
579 global diffcontextstring diffcontext
580 global maincursor textcursor curtextcursor
581 global rowctxmenu fakerowmenu mergemax wrapcomment
582 global highlight_files gdttype
583 global searchstring sstring
584 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
588 .bar add cascade -label "File" -menu .bar.file
589 .bar configure -font $uifont
591 .bar.file add command -label "Update" -command updatecommits
592 .bar.file add command -label "Reread references" -command rereadrefs
593 .bar.file add command -label "List references" -command showrefs
594 .bar.file add command -label "Quit" -command doquit
595 .bar.file configure -font $uifont
597 .bar add cascade -label "Edit" -menu .bar.edit
598 .bar.edit add command -label "Preferences" -command doprefs
599 .bar.edit configure -font $uifont
601 menu .bar.view -font $uifont
602 .bar add cascade -label "View" -menu .bar.view
603 .bar.view add command -label "New view..." -command {newview 0}
604 .bar.view add command -label "Edit view..." -command editview \
606 .bar.view add command -label "Delete view" -command delview -state disabled
607 .bar.view add separator
608 .bar.view add radiobutton -label "All files" -command {showview 0} \
609 -variable selectedview -value 0
612 .bar add cascade -label "Help" -menu .bar.help
613 .bar.help add command -label "About gitk" -command about
614 .bar.help add command -label "Key bindings" -command keys
615 .bar.help configure -font $uifont
616 . configure -menu .bar
618 # the gui has upper and lower half, parts of a paned window.
619 panedwindow .ctop -orient vertical
621 # possibly use assumed geometry
622 if {![info exists geometry(pwsash0)]} {
623 set geometry(topheight) [expr {15 * $linespc}]
624 set geometry(topwidth) [expr {80 * $charspc}]
625 set geometry(botheight) [expr {15 * $linespc}]
626 set geometry(botwidth) [expr {50 * $charspc}]
627 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
628 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
631 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
632 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
634 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
636 # create three canvases
637 set cscroll .tf.histframe.csb
638 set canv .tf.histframe.pwclist.canv
640 -selectbackground $selectbgcolor \
641 -background $bgcolor -bd 0 \
642 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
643 .tf.histframe.pwclist add $canv
644 set canv2 .tf.histframe.pwclist.canv2
646 -selectbackground $selectbgcolor \
647 -background $bgcolor -bd 0 -yscrollincr $linespc
648 .tf.histframe.pwclist add $canv2
649 set canv3 .tf.histframe.pwclist.canv3
651 -selectbackground $selectbgcolor \
652 -background $bgcolor -bd 0 -yscrollincr $linespc
653 .tf.histframe.pwclist add $canv3
654 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
655 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
657 # a scroll bar to rule them
658 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
659 pack $cscroll -side right -fill y
660 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
661 lappend bglist $canv $canv2 $canv3
662 pack .tf.histframe.pwclist -fill both -expand 1 -side left
664 # we have two button bars at bottom of top frame. Bar 1
666 frame .tf.lbar -height 15
668 set sha1entry .tf.bar.sha1
669 set entries $sha1entry
670 set sha1but .tf.bar.sha1label
671 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
672 -command gotocommit -width 8 -font $uifont
673 $sha1but conf -disabledforeground [$sha1but cget -foreground]
674 pack .tf.bar.sha1label -side left
675 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
676 trace add variable sha1string write sha1change
677 pack $sha1entry -side left -pady 2
679 image create bitmap bm-left -data {
680 #define left_width 16
681 #define left_height 16
682 static unsigned char left_bits[] = {
683 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
684 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
685 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
687 image create bitmap bm-right -data {
688 #define right_width 16
689 #define right_height 16
690 static unsigned char right_bits[] = {
691 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
692 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
693 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
695 button .tf.bar.leftbut -image bm-left -command goback \
696 -state disabled -width 26
697 pack .tf.bar.leftbut -side left -fill y
698 button .tf.bar.rightbut -image bm-right -command goforw \
699 -state disabled -width 26
700 pack .tf.bar.rightbut -side left -fill y
702 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
703 pack .tf.bar.findbut -side left
705 set fstring .tf.bar.findstring
706 lappend entries $fstring
707 entry $fstring -width 30 -font $textfont -textvariable findstring
708 trace add variable findstring write find_change
709 pack $fstring -side left -expand 1 -fill x -in .tf.bar
711 set findtypemenu [tk_optionMenu .tf.bar.findtype \
712 findtype Exact IgnCase Regexp]
713 trace add variable findtype write find_change
714 .tf.bar.findtype configure -font $uifont
715 .tf.bar.findtype.menu configure -font $uifont
716 set findloc "All fields"
717 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
718 Comments Author Committer
719 trace add variable findloc write find_change
720 .tf.bar.findloc configure -font $uifont
721 .tf.bar.findloc.menu configure -font $uifont
722 pack .tf.bar.findloc -side right
723 pack .tf.bar.findtype -side right
725 # build up the bottom bar of upper window
726 label .tf.lbar.flabel -text "Highlight: Commits " \
728 pack .tf.lbar.flabel -side left -fill y
729 set gdttype "touching paths:"
730 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
731 "adding/removing string:"]
732 trace add variable gdttype write hfiles_change
733 $gm conf -font $uifont
734 .tf.lbar.gdttype conf -font $uifont
735 pack .tf.lbar.gdttype -side left -fill y
736 entry .tf.lbar.fent -width 25 -font $textfont \
737 -textvariable highlight_files
738 trace add variable highlight_files write hfiles_change
739 lappend entries .tf.lbar.fent
740 pack .tf.lbar.fent -side left -fill x -expand 1
741 label .tf.lbar.vlabel -text " OR in view" -font $uifont
742 pack .tf.lbar.vlabel -side left -fill y
743 global viewhlmenu selectedhlview
744 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
745 $viewhlmenu entryconf None -command delvhighlight
746 $viewhlmenu conf -font $uifont
747 .tf.lbar.vhl conf -font $uifont
748 pack .tf.lbar.vhl -side left -fill y
749 label .tf.lbar.rlabel -text " OR " -font $uifont
750 pack .tf.lbar.rlabel -side left -fill y
751 global highlight_related
752 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
753 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
754 $m conf -font $uifont
755 .tf.lbar.relm conf -font $uifont
756 trace add variable highlight_related write vrel_change
757 pack .tf.lbar.relm -side left -fill y
759 # Finish putting the upper half of the viewer together
760 pack .tf.lbar -in .tf -side bottom -fill x
761 pack .tf.bar -in .tf -side bottom -fill x
762 pack .tf.histframe -fill both -side top -expand 1
764 .ctop paneconfigure .tf -height $geometry(topheight)
765 .ctop paneconfigure .tf -width $geometry(topwidth)
767 # now build up the bottom
768 panedwindow .pwbottom -orient horizontal
770 # lower left, a text box over search bar, scroll bar to the right
771 # if we know window height, then that will set the lower text height, otherwise
772 # we set lower text height which will drive window height
773 if {[info exists geometry(main)]} {
774 frame .bleft -width $geometry(botwidth)
776 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
781 button .bleft.top.search -text "Search" -command dosearch \
783 pack .bleft.top.search -side left -padx 5
784 set sstring .bleft.top.sstring
785 entry $sstring -width 20 -font $textfont -textvariable searchstring
786 lappend entries $sstring
787 trace add variable searchstring write incrsearch
788 pack $sstring -side left -expand 1 -fill x
789 radiobutton .bleft.mid.diff -text "Diff" \
790 -command changediffdisp -variable diffelide -value {0 0}
791 radiobutton .bleft.mid.old -text "Old version" \
792 -command changediffdisp -variable diffelide -value {0 1}
793 radiobutton .bleft.mid.new -text "New version" \
794 -command changediffdisp -variable diffelide -value {1 0}
795 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
797 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
798 spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
799 -from 1 -increment 1 -to 10000000 \
800 -validate all -validatecommand "diffcontextvalidate %P" \
801 -textvariable diffcontextstring
802 .bleft.mid.diffcontext set $diffcontext
803 trace add variable diffcontextstring write diffcontextchange
804 lappend entries .bleft.mid.diffcontext
805 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
806 set ctext .bleft.ctext
807 text $ctext -background $bgcolor -foreground $fgcolor \
808 -tabs "[expr {$tabstop * $charspc}]" \
809 -state disabled -font $textfont \
810 -yscrollcommand scrolltext -wrap none
811 scrollbar .bleft.sb -command "$ctext yview"
812 pack .bleft.top -side top -fill x
813 pack .bleft.mid -side top -fill x
814 pack .bleft.sb -side right -fill y
815 pack $ctext -side left -fill both -expand 1
816 lappend bglist $ctext
817 lappend fglist $ctext
819 $ctext tag conf comment -wrap $wrapcomment
820 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
821 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
822 $ctext tag conf d0 -fore [lindex $diffcolors 0]
823 $ctext tag conf d1 -fore [lindex $diffcolors 1]
824 $ctext tag conf m0 -fore red
825 $ctext tag conf m1 -fore blue
826 $ctext tag conf m2 -fore green
827 $ctext tag conf m3 -fore purple
828 $ctext tag conf m4 -fore brown
829 $ctext tag conf m5 -fore "#009090"
830 $ctext tag conf m6 -fore magenta
831 $ctext tag conf m7 -fore "#808000"
832 $ctext tag conf m8 -fore "#009000"
833 $ctext tag conf m9 -fore "#ff0080"
834 $ctext tag conf m10 -fore cyan
835 $ctext tag conf m11 -fore "#b07070"
836 $ctext tag conf m12 -fore "#70b0f0"
837 $ctext tag conf m13 -fore "#70f0b0"
838 $ctext tag conf m14 -fore "#f0b070"
839 $ctext tag conf m15 -fore "#ff70b0"
840 $ctext tag conf mmax -fore darkgrey
842 $ctext tag conf mresult -font [concat $textfont bold]
843 $ctext tag conf msep -font [concat $textfont bold]
844 $ctext tag conf found -back yellow
847 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
852 radiobutton .bright.mode.patch -text "Patch" \
853 -command reselectline -variable cmitmode -value "patch"
854 .bright.mode.patch configure -font $uifont
855 radiobutton .bright.mode.tree -text "Tree" \
856 -command reselectline -variable cmitmode -value "tree"
857 .bright.mode.tree configure -font $uifont
858 grid .bright.mode.patch .bright.mode.tree -sticky ew
859 pack .bright.mode -side top -fill x
860 set cflist .bright.cfiles
861 set indent [font measure $mainfont "nn"]
863 -selectbackground $selectbgcolor \
864 -background $bgcolor -foreground $fgcolor \
866 -tabs [list $indent [expr {2 * $indent}]] \
867 -yscrollcommand ".bright.sb set" \
868 -cursor [. cget -cursor] \
869 -spacing1 1 -spacing3 1
870 lappend bglist $cflist
871 lappend fglist $cflist
872 scrollbar .bright.sb -command "$cflist yview"
873 pack .bright.sb -side right -fill y
874 pack $cflist -side left -fill both -expand 1
875 $cflist tag configure highlight \
876 -background [$cflist cget -selectbackground]
877 $cflist tag configure bold -font [concat $mainfont bold]
879 .pwbottom add .bright
882 # restore window position if known
883 if {[info exists geometry(main)]} {
884 wm geometry . "$geometry(main)"
887 if {[tk windowingsystem] eq {aqua}} {
893 bind .pwbottom <Configure> {resizecdetpanes %W %w}
894 pack .ctop -fill both -expand 1
895 bindall <1> {selcanvline %W %x %y}
896 #bindall <B1-Motion> {selcanvline %W %x %y}
897 if {[tk windowingsystem] == "win32"} {
898 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
899 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
901 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
902 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
904 bindall <2> "canvscan mark %W %x %y"
905 bindall <B2-Motion> "canvscan dragto %W %x %y"
906 bindkey <Home> selfirstline
907 bindkey <End> sellastline
908 bind . <Key-Up> "selnextline -1"
909 bind . <Key-Down> "selnextline 1"
910 bind . <Shift-Key-Up> "next_highlight -1"
911 bind . <Shift-Key-Down> "next_highlight 1"
912 bindkey <Key-Right> "goforw"
913 bindkey <Key-Left> "goback"
914 bind . <Key-Prior> "selnextpage -1"
915 bind . <Key-Next> "selnextpage 1"
916 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
917 bind . <$M1B-End> "allcanvs yview moveto 1.0"
918 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
919 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
920 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
921 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
922 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
923 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
924 bindkey <Key-space> "$ctext yview scroll 1 pages"
925 bindkey p "selnextline -1"
926 bindkey n "selnextline 1"
929 bindkey i "selnextline -1"
930 bindkey k "selnextline 1"
933 bindkey b "$ctext yview scroll -1 pages"
934 bindkey d "$ctext yview scroll 18 units"
935 bindkey u "$ctext yview scroll -18 units"
936 bindkey / {findnext 1}
937 bindkey <Key-Return> {findnext 0}
940 bindkey <F5> updatecommits
941 bind . <$M1B-q> doquit
942 bind . <$M1B-f> dofind
943 bind . <$M1B-g> {findnext 0}
944 bind . <$M1B-r> dosearchback
945 bind . <$M1B-s> dosearch
946 bind . <$M1B-equal> {incrfont 1}
947 bind . <$M1B-KP_Add> {incrfont 1}
948 bind . <$M1B-minus> {incrfont -1}
949 bind . <$M1B-KP_Subtract> {incrfont -1}
950 wm protocol . WM_DELETE_WINDOW doquit
951 bind . <Button-1> "click %W"
952 bind $fstring <Key-Return> dofind
953 bind $sha1entry <Key-Return> gotocommit
954 bind $sha1entry <<PasteSelection>> clearsha1
955 bind $cflist <1> {sel_flist %W %x %y; break}
956 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
957 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
958 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
960 set maincursor [. cget -cursor]
961 set textcursor [$ctext cget -cursor]
962 set curtextcursor $textcursor
964 set rowctxmenu .rowctxmenu
965 menu $rowctxmenu -tearoff 0
966 $rowctxmenu add command -label "Diff this -> selected" \
967 -command {diffvssel 0}
968 $rowctxmenu add command -label "Diff selected -> this" \
969 -command {diffvssel 1}
970 $rowctxmenu add command -label "Make patch" -command mkpatch
971 $rowctxmenu add command -label "Create tag" -command mktag
972 $rowctxmenu add command -label "Write commit to file" -command writecommit
973 $rowctxmenu add command -label "Create new branch" -command mkbranch
974 $rowctxmenu add command -label "Cherry-pick this commit" \
976 $rowctxmenu add command -label "Reset HEAD branch to here" \
979 set fakerowmenu .fakerowmenu
980 menu $fakerowmenu -tearoff 0
981 $fakerowmenu add command -label "Diff this -> selected" \
982 -command {diffvssel 0}
983 $fakerowmenu add command -label "Diff selected -> this" \
984 -command {diffvssel 1}
985 $fakerowmenu add command -label "Make patch" -command mkpatch
986 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
987 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
988 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
990 set headctxmenu .headctxmenu
991 menu $headctxmenu -tearoff 0
992 $headctxmenu add command -label "Check out this branch" \
994 $headctxmenu add command -label "Remove this branch" \
998 set flist_menu .flistctxmenu
999 menu $flist_menu -tearoff 0
1000 $flist_menu add command -label "Highlight this too" \
1001 -command {flist_hl 0}
1002 $flist_menu add command -label "Highlight this only" \
1003 -command {flist_hl 1}
1006 # Windows sends all mouse wheel events to the current focused window, not
1007 # the one where the mouse hovers, so bind those events here and redirect
1008 # to the correct window
1009 proc windows_mousewheel_redirector {W X Y D} {
1010 global canv canv2 canv3
1011 set w [winfo containing -displayof $W $X $Y]
1013 set u [expr {$D < 0 ? 5 : -5}]
1014 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1015 allcanvs yview scroll $u units
1018 $w yview scroll $u units
1024 # mouse-2 makes all windows scan vertically, but only the one
1025 # the cursor is in scans horizontally
1026 proc canvscan {op w x y} {
1027 global canv canv2 canv3
1028 foreach c [list $canv $canv2 $canv3] {
1037 proc scrollcanv {cscroll f0 f1} {
1038 $cscroll set $f0 $f1
1043 # when we make a key binding for the toplevel, make sure
1044 # it doesn't get triggered when that key is pressed in the
1045 # find string entry widget.
1046 proc bindkey {ev script} {
1049 set escript [bind Entry $ev]
1050 if {$escript == {}} {
1051 set escript [bind Entry <Key>]
1053 foreach e $entries {
1054 bind $e $ev "$escript; break"
1058 # set the focus back to the toplevel for any click outside
1061 global ctext entries
1062 foreach e [concat $entries $ctext] {
1063 if {$w == $e} return
1068 proc savestuff {w} {
1069 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1070 global stuffsaved findmergefiles maxgraphpct
1071 global maxwidth showneartags showlocalchanges
1072 global viewname viewfiles viewargs viewperm nextviewnum
1073 global cmitmode wrapcomment datetimeformat
1074 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1076 if {$stuffsaved} return
1077 if {![winfo viewable .]} return
1079 set f [open "~/.gitk-new" w]
1080 puts $f [list set mainfont $mainfont]
1081 puts $f [list set textfont $textfont]
1082 puts $f [list set uifont $uifont]
1083 puts $f [list set tabstop $tabstop]
1084 puts $f [list set findmergefiles $findmergefiles]
1085 puts $f [list set maxgraphpct $maxgraphpct]
1086 puts $f [list set maxwidth $maxwidth]
1087 puts $f [list set cmitmode $cmitmode]
1088 puts $f [list set wrapcomment $wrapcomment]
1089 puts $f [list set showneartags $showneartags]
1090 puts $f [list set showlocalchanges $showlocalchanges]
1091 puts $f [list set datetimeformat $datetimeformat]
1092 puts $f [list set bgcolor $bgcolor]
1093 puts $f [list set fgcolor $fgcolor]
1094 puts $f [list set colors $colors]
1095 puts $f [list set diffcolors $diffcolors]
1096 puts $f [list set diffcontext $diffcontext]
1097 puts $f [list set selectbgcolor $selectbgcolor]
1099 puts $f "set geometry(main) [wm geometry .]"
1100 puts $f "set geometry(topwidth) [winfo width .tf]"
1101 puts $f "set geometry(topheight) [winfo height .tf]"
1102 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1103 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1104 puts $f "set geometry(botwidth) [winfo width .bleft]"
1105 puts $f "set geometry(botheight) [winfo height .bleft]"
1107 puts -nonewline $f "set permviews {"
1108 for {set v 0} {$v < $nextviewnum} {incr v} {
1109 if {$viewperm($v)} {
1110 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1115 file rename -force "~/.gitk-new" "~/.gitk"
1120 proc resizeclistpanes {win w} {
1122 if {[info exists oldwidth($win)]} {
1123 set s0 [$win sash coord 0]
1124 set s1 [$win sash coord 1]
1126 set sash0 [expr {int($w/2 - 2)}]
1127 set sash1 [expr {int($w*5/6 - 2)}]
1129 set factor [expr {1.0 * $w / $oldwidth($win)}]
1130 set sash0 [expr {int($factor * [lindex $s0 0])}]
1131 set sash1 [expr {int($factor * [lindex $s1 0])}]
1135 if {$sash1 < $sash0 + 20} {
1136 set sash1 [expr {$sash0 + 20}]
1138 if {$sash1 > $w - 10} {
1139 set sash1 [expr {$w - 10}]
1140 if {$sash0 > $sash1 - 20} {
1141 set sash0 [expr {$sash1 - 20}]
1145 $win sash place 0 $sash0 [lindex $s0 1]
1146 $win sash place 1 $sash1 [lindex $s1 1]
1148 set oldwidth($win) $w
1151 proc resizecdetpanes {win w} {
1153 if {[info exists oldwidth($win)]} {
1154 set s0 [$win sash coord 0]
1156 set sash0 [expr {int($w*3/4 - 2)}]
1158 set factor [expr {1.0 * $w / $oldwidth($win)}]
1159 set sash0 [expr {int($factor * [lindex $s0 0])}]
1163 if {$sash0 > $w - 15} {
1164 set sash0 [expr {$w - 15}]
1167 $win sash place 0 $sash0 [lindex $s0 1]
1169 set oldwidth($win) $w
1172 proc allcanvs args {
1173 global canv canv2 canv3
1179 proc bindall {event action} {
1180 global canv canv2 canv3
1181 bind $canv $event $action
1182 bind $canv2 $event $action
1183 bind $canv3 $event $action
1189 if {[winfo exists $w]} {
1194 wm title $w "About gitk"
1195 message $w.m -text {
1196 Gitk - a commit viewer for git
1198 Copyright © 2005-2006 Paul Mackerras
1200 Use and redistribute under the terms of the GNU General Public License} \
1201 -justify center -aspect 400 -border 2 -bg white -relief groove
1202 pack $w.m -side top -fill x -padx 2 -pady 2
1203 $w.m configure -font $uifont
1204 button $w.ok -text Close -command "destroy $w" -default active
1205 pack $w.ok -side bottom
1206 $w.ok configure -font $uifont
1207 bind $w <Visibility> "focus $w.ok"
1208 bind $w <Key-Escape> "destroy $w"
1209 bind $w <Key-Return> "destroy $w"
1215 if {[winfo exists $w]} {
1219 if {[tk windowingsystem] eq {aqua}} {
1225 wm title $w "Gitk key bindings"
1226 message $w.m -text "
1230 <Home> Move to first commit
1231 <End> Move to last commit
1232 <Up>, p, i Move up one commit
1233 <Down>, n, k Move down one commit
1234 <Left>, z, j Go back in history list
1235 <Right>, x, l Go forward in history list
1236 <PageUp> Move up one page in commit list
1237 <PageDown> Move down one page in commit list
1238 <$M1T-Home> Scroll to top of commit list
1239 <$M1T-End> Scroll to bottom of commit list
1240 <$M1T-Up> Scroll commit list up one line
1241 <$M1T-Down> Scroll commit list down one line
1242 <$M1T-PageUp> Scroll commit list up one page
1243 <$M1T-PageDown> Scroll commit list down one page
1244 <Shift-Up> Move to previous highlighted line
1245 <Shift-Down> Move to next highlighted line
1246 <Delete>, b Scroll diff view up one page
1247 <Backspace> Scroll diff view up one page
1248 <Space> Scroll diff view down one page
1249 u Scroll diff view up 18 lines
1250 d Scroll diff view down 18 lines
1252 <$M1T-G> Move to next find hit
1253 <Return> Move to next find hit
1254 / Move to next find hit, or redo find
1255 ? Move to previous find hit
1256 f Scroll diff view to next file
1257 <$M1T-S> Search for next hit in diff view
1258 <$M1T-R> Search for previous hit in diff view
1259 <$M1T-KP+> Increase font size
1260 <$M1T-plus> Increase font size
1261 <$M1T-KP-> Decrease font size
1262 <$M1T-minus> Decrease font size
1265 -justify left -bg white -border 2 -relief groove
1266 pack $w.m -side top -fill both -padx 2 -pady 2
1267 $w.m configure -font $uifont
1268 button $w.ok -text Close -command "destroy $w" -default active
1269 pack $w.ok -side bottom
1270 $w.ok configure -font $uifont
1271 bind $w <Visibility> "focus $w.ok"
1272 bind $w <Key-Escape> "destroy $w"
1273 bind $w <Key-Return> "destroy $w"
1276 # Procedures for manipulating the file list window at the
1277 # bottom right of the overall window.
1279 proc treeview {w l openlevs} {
1280 global treecontents treediropen treeheight treeparent treeindex
1290 set treecontents() {}
1291 $w conf -state normal
1293 while {[string range $f 0 $prefixend] ne $prefix} {
1294 if {$lev <= $openlevs} {
1295 $w mark set e:$treeindex($prefix) "end -1c"
1296 $w mark gravity e:$treeindex($prefix) left
1298 set treeheight($prefix) $ht
1299 incr ht [lindex $htstack end]
1300 set htstack [lreplace $htstack end end]
1301 set prefixend [lindex $prefendstack end]
1302 set prefendstack [lreplace $prefendstack end end]
1303 set prefix [string range $prefix 0 $prefixend]
1306 set tail [string range $f [expr {$prefixend+1}] end]
1307 while {[set slash [string first "/" $tail]] >= 0} {
1310 lappend prefendstack $prefixend
1311 incr prefixend [expr {$slash + 1}]
1312 set d [string range $tail 0 $slash]
1313 lappend treecontents($prefix) $d
1314 set oldprefix $prefix
1316 set treecontents($prefix) {}
1317 set treeindex($prefix) [incr ix]
1318 set treeparent($prefix) $oldprefix
1319 set tail [string range $tail [expr {$slash+1}] end]
1320 if {$lev <= $openlevs} {
1322 set treediropen($prefix) [expr {$lev < $openlevs}]
1323 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1324 $w mark set d:$ix "end -1c"
1325 $w mark gravity d:$ix left
1327 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1329 $w image create end -align center -image $bm -padx 1 \
1331 $w insert end $d [highlight_tag $prefix]
1332 $w mark set s:$ix "end -1c"
1333 $w mark gravity s:$ix left
1338 if {$lev <= $openlevs} {
1341 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1343 $w insert end $tail [highlight_tag $f]
1345 lappend treecontents($prefix) $tail
1348 while {$htstack ne {}} {
1349 set treeheight($prefix) $ht
1350 incr ht [lindex $htstack end]
1351 set htstack [lreplace $htstack end end]
1352 set prefixend [lindex $prefendstack end]
1353 set prefendstack [lreplace $prefendstack end end]
1354 set prefix [string range $prefix 0 $prefixend]
1356 $w conf -state disabled
1359 proc linetoelt {l} {
1360 global treeheight treecontents
1365 foreach e $treecontents($prefix) {
1370 if {[string index $e end] eq "/"} {
1371 set n $treeheight($prefix$e)
1383 proc highlight_tree {y prefix} {
1384 global treeheight treecontents cflist
1386 foreach e $treecontents($prefix) {
1388 if {[highlight_tag $path] ne {}} {
1389 $cflist tag add bold $y.0 "$y.0 lineend"
1392 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1393 set y [highlight_tree $y $path]
1399 proc treeclosedir {w dir} {
1400 global treediropen treeheight treeparent treeindex
1402 set ix $treeindex($dir)
1403 $w conf -state normal
1404 $w delete s:$ix e:$ix
1405 set treediropen($dir) 0
1406 $w image configure a:$ix -image tri-rt
1407 $w conf -state disabled
1408 set n [expr {1 - $treeheight($dir)}]
1409 while {$dir ne {}} {
1410 incr treeheight($dir) $n
1411 set dir $treeparent($dir)
1415 proc treeopendir {w dir} {
1416 global treediropen treeheight treeparent treecontents treeindex
1418 set ix $treeindex($dir)
1419 $w conf -state normal
1420 $w image configure a:$ix -image tri-dn
1421 $w mark set e:$ix s:$ix
1422 $w mark gravity e:$ix right
1425 set n [llength $treecontents($dir)]
1426 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1429 incr treeheight($x) $n
1431 foreach e $treecontents($dir) {
1433 if {[string index $e end] eq "/"} {
1434 set iy $treeindex($de)
1435 $w mark set d:$iy e:$ix
1436 $w mark gravity d:$iy left
1437 $w insert e:$ix $str
1438 set treediropen($de) 0
1439 $w image create e:$ix -align center -image tri-rt -padx 1 \
1441 $w insert e:$ix $e [highlight_tag $de]
1442 $w mark set s:$iy e:$ix
1443 $w mark gravity s:$iy left
1444 set treeheight($de) 1
1446 $w insert e:$ix $str
1447 $w insert e:$ix $e [highlight_tag $de]
1450 $w mark gravity e:$ix left
1451 $w conf -state disabled
1452 set treediropen($dir) 1
1453 set top [lindex [split [$w index @0,0] .] 0]
1454 set ht [$w cget -height]
1455 set l [lindex [split [$w index s:$ix] .] 0]
1458 } elseif {$l + $n + 1 > $top + $ht} {
1459 set top [expr {$l + $n + 2 - $ht}]
1467 proc treeclick {w x y} {
1468 global treediropen cmitmode ctext cflist cflist_top
1470 if {$cmitmode ne "tree"} return
1471 if {![info exists cflist_top]} return
1472 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1473 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1474 $cflist tag add highlight $l.0 "$l.0 lineend"
1480 set e [linetoelt $l]
1481 if {[string index $e end] ne "/"} {
1483 } elseif {$treediropen($e)} {
1490 proc setfilelist {id} {
1491 global treefilelist cflist
1493 treeview $cflist $treefilelist($id) 0
1496 image create bitmap tri-rt -background black -foreground blue -data {
1497 #define tri-rt_width 13
1498 #define tri-rt_height 13
1499 static unsigned char tri-rt_bits[] = {
1500 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1501 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1504 #define tri-rt-mask_width 13
1505 #define tri-rt-mask_height 13
1506 static unsigned char tri-rt-mask_bits[] = {
1507 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1508 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1511 image create bitmap tri-dn -background black -foreground blue -data {
1512 #define tri-dn_width 13
1513 #define tri-dn_height 13
1514 static unsigned char tri-dn_bits[] = {
1515 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1516 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1519 #define tri-dn-mask_width 13
1520 #define tri-dn-mask_height 13
1521 static unsigned char tri-dn-mask_bits[] = {
1522 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1523 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1527 image create bitmap reficon-T -background black -foreground yellow -data {
1528 #define tagicon_width 13
1529 #define tagicon_height 9
1530 static unsigned char tagicon_bits[] = {
1531 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1532 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1534 #define tagicon-mask_width 13
1535 #define tagicon-mask_height 9
1536 static unsigned char tagicon-mask_bits[] = {
1537 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1538 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1541 #define headicon_width 13
1542 #define headicon_height 9
1543 static unsigned char headicon_bits[] = {
1544 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1545 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1548 #define headicon-mask_width 13
1549 #define headicon-mask_height 9
1550 static unsigned char headicon-mask_bits[] = {
1551 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1552 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1554 image create bitmap reficon-H -background black -foreground green \
1555 -data $rectdata -maskdata $rectmask
1556 image create bitmap reficon-o -background black -foreground "#ddddff" \
1557 -data $rectdata -maskdata $rectmask
1559 proc init_flist {first} {
1560 global cflist cflist_top selectedline difffilestart
1562 $cflist conf -state normal
1563 $cflist delete 0.0 end
1565 $cflist insert end $first
1567 $cflist tag add highlight 1.0 "1.0 lineend"
1569 catch {unset cflist_top}
1571 $cflist conf -state disabled
1572 set difffilestart {}
1575 proc highlight_tag {f} {
1576 global highlight_paths
1578 foreach p $highlight_paths {
1579 if {[string match $p $f]} {
1586 proc highlight_filelist {} {
1587 global cmitmode cflist
1589 $cflist conf -state normal
1590 if {$cmitmode ne "tree"} {
1591 set end [lindex [split [$cflist index end] .] 0]
1592 for {set l 2} {$l < $end} {incr l} {
1593 set line [$cflist get $l.0 "$l.0 lineend"]
1594 if {[highlight_tag $line] ne {}} {
1595 $cflist tag add bold $l.0 "$l.0 lineend"
1601 $cflist conf -state disabled
1604 proc unhighlight_filelist {} {
1607 $cflist conf -state normal
1608 $cflist tag remove bold 1.0 end
1609 $cflist conf -state disabled
1612 proc add_flist {fl} {
1615 $cflist conf -state normal
1617 $cflist insert end "\n"
1618 $cflist insert end $f [highlight_tag $f]
1620 $cflist conf -state disabled
1623 proc sel_flist {w x y} {
1624 global ctext difffilestart cflist cflist_top cmitmode
1626 if {$cmitmode eq "tree"} return
1627 if {![info exists cflist_top]} return
1628 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1629 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1630 $cflist tag add highlight $l.0 "$l.0 lineend"
1635 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1639 proc pop_flist_menu {w X Y x y} {
1640 global ctext cflist cmitmode flist_menu flist_menu_file
1641 global treediffs diffids
1643 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1645 if {$cmitmode eq "tree"} {
1646 set e [linetoelt $l]
1647 if {[string index $e end] eq "/"} return
1649 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1651 set flist_menu_file $e
1652 tk_popup $flist_menu $X $Y
1655 proc flist_hl {only} {
1656 global flist_menu_file highlight_files
1658 set x [shellquote $flist_menu_file]
1659 if {$only || $highlight_files eq {}} {
1660 set highlight_files $x
1662 append highlight_files " " $x
1666 # Functions for adding and removing shell-type quoting
1668 proc shellquote {str} {
1669 if {![string match "*\['\"\\ \t]*" $str]} {
1672 if {![string match "*\['\"\\]*" $str]} {
1675 if {![string match "*'*" $str]} {
1678 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1681 proc shellarglist {l} {
1687 append str [shellquote $a]
1692 proc shelldequote {str} {
1697 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1698 append ret [string range $str $used end]
1699 set used [string length $str]
1702 set first [lindex $first 0]
1703 set ch [string index $str $first]
1704 if {$first > $used} {
1705 append ret [string range $str $used [expr {$first - 1}]]
1708 if {$ch eq " " || $ch eq "\t"} break
1711 set first [string first "'" $str $used]
1713 error "unmatched single-quote"
1715 append ret [string range $str $used [expr {$first - 1}]]
1720 if {$used >= [string length $str]} {
1721 error "trailing backslash"
1723 append ret [string index $str $used]
1728 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1729 error "unmatched double-quote"
1731 set first [lindex $first 0]
1732 set ch [string index $str $first]
1733 if {$first > $used} {
1734 append ret [string range $str $used [expr {$first - 1}]]
1737 if {$ch eq "\""} break
1739 append ret [string index $str $used]
1743 return [list $used $ret]
1746 proc shellsplit {str} {
1749 set str [string trimleft $str]
1750 if {$str eq {}} break
1751 set dq [shelldequote $str]
1752 set n [lindex $dq 0]
1753 set word [lindex $dq 1]
1754 set str [string range $str $n end]
1760 # Code to implement multiple views
1762 proc newview {ishighlight} {
1763 global nextviewnum newviewname newviewperm uifont newishighlight
1764 global newviewargs revtreeargs
1766 set newishighlight $ishighlight
1768 if {[winfo exists $top]} {
1772 set newviewname($nextviewnum) "View $nextviewnum"
1773 set newviewperm($nextviewnum) 0
1774 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1775 vieweditor $top $nextviewnum "Gitk view definition"
1780 global viewname viewperm newviewname newviewperm
1781 global viewargs newviewargs
1783 set top .gitkvedit-$curview
1784 if {[winfo exists $top]} {
1788 set newviewname($curview) $viewname($curview)
1789 set newviewperm($curview) $viewperm($curview)
1790 set newviewargs($curview) [shellarglist $viewargs($curview)]
1791 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1794 proc vieweditor {top n title} {
1795 global newviewname newviewperm viewfiles
1799 wm title $top $title
1800 label $top.nl -text "Name" -font $uifont
1801 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1802 grid $top.nl $top.name -sticky w -pady 5
1803 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1805 grid $top.perm - -pady 5 -sticky w
1806 message $top.al -aspect 1000 -font $uifont \
1807 -text "Commits to include (arguments to git rev-list):"
1808 grid $top.al - -sticky w -pady 5
1809 entry $top.args -width 50 -textvariable newviewargs($n) \
1810 -background white -font $uifont
1811 grid $top.args - -sticky ew -padx 5
1812 message $top.l -aspect 1000 -font $uifont \
1813 -text "Enter files and directories to include, one per line:"
1814 grid $top.l - -sticky w
1815 text $top.t -width 40 -height 10 -background white -font $uifont
1816 if {[info exists viewfiles($n)]} {
1817 foreach f $viewfiles($n) {
1818 $top.t insert end $f
1819 $top.t insert end "\n"
1821 $top.t delete {end - 1c} end
1822 $top.t mark set insert 0.0
1824 grid $top.t - -sticky ew -padx 5
1826 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1828 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1830 grid $top.buts.ok $top.buts.can
1831 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1832 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1833 grid $top.buts - -pady 10 -sticky ew
1837 proc doviewmenu {m first cmd op argv} {
1838 set nmenu [$m index end]
1839 for {set i $first} {$i <= $nmenu} {incr i} {
1840 if {[$m entrycget $i -command] eq $cmd} {
1841 eval $m $op $i $argv
1847 proc allviewmenus {n op args} {
1850 doviewmenu .bar.view 5 [list showview $n] $op $args
1851 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1854 proc newviewok {top n} {
1855 global nextviewnum newviewperm newviewname newishighlight
1856 global viewname viewfiles viewperm selectedview curview
1857 global viewargs newviewargs viewhlmenu
1860 set newargs [shellsplit $newviewargs($n)]
1862 error_popup "Error in commit selection arguments: $err"
1868 foreach f [split [$top.t get 0.0 end] "\n"] {
1869 set ft [string trim $f]
1874 if {![info exists viewfiles($n)]} {
1875 # creating a new view
1877 set viewname($n) $newviewname($n)
1878 set viewperm($n) $newviewperm($n)
1879 set viewfiles($n) $files
1880 set viewargs($n) $newargs
1882 if {!$newishighlight} {
1885 run addvhighlight $n
1888 # editing an existing view
1889 set viewperm($n) $newviewperm($n)
1890 if {$newviewname($n) ne $viewname($n)} {
1891 set viewname($n) $newviewname($n)
1892 doviewmenu .bar.view 5 [list showview $n] \
1893 entryconf [list -label $viewname($n)]
1894 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1895 entryconf [list -label $viewname($n) -value $viewname($n)]
1897 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1898 set viewfiles($n) $files
1899 set viewargs($n) $newargs
1900 if {$curview == $n} {
1905 catch {destroy $top}
1909 global curview viewdata viewperm hlview selectedhlview
1911 if {$curview == 0} return
1912 if {[info exists hlview] && $hlview == $curview} {
1913 set selectedhlview None
1916 allviewmenus $curview delete
1917 set viewdata($curview) {}
1918 set viewperm($curview) 0
1922 proc addviewmenu {n} {
1923 global viewname viewhlmenu
1925 .bar.view add radiobutton -label $viewname($n) \
1926 -command [list showview $n] -variable selectedview -value $n
1927 $viewhlmenu add radiobutton -label $viewname($n) \
1928 -command [list addvhighlight $n] -variable selectedhlview
1931 proc flatten {var} {
1935 foreach i [array names $var] {
1936 lappend ret $i [set $var\($i\)]
1941 proc unflatten {var l} {
1951 global curview viewdata viewfiles
1952 global displayorder parentlist rowidlist
1953 global colormap rowtextx commitrow nextcolor canvxmax
1954 global numcommits commitlisted
1955 global selectedline currentid canv canvy0
1957 global pending_select phase
1958 global commitidx rowlaidout rowoptim
1960 global selectedview selectfirst
1961 global vparentlist vdisporder vcmitlisted
1962 global hlview selectedhlview commitinterest
1964 if {$n == $curview} return
1966 if {[info exists selectedline]} {
1967 set selid $currentid
1968 set y [yc $selectedline]
1969 set ymax [lindex [$canv cget -scrollregion] 3]
1970 set span [$canv yview]
1971 set ytop [expr {[lindex $span 0] * $ymax}]
1972 set ybot [expr {[lindex $span 1] * $ymax}]
1973 if {$ytop < $y && $y < $ybot} {
1974 set yscreen [expr {$y - $ytop}]
1976 set yscreen [expr {($ybot - $ytop) / 2}]
1978 } elseif {[info exists pending_select]} {
1979 set selid $pending_select
1980 unset pending_select
1984 if {$curview >= 0} {
1985 set vparentlist($curview) $parentlist
1986 set vdisporder($curview) $displayorder
1987 set vcmitlisted($curview) $commitlisted
1989 set viewdata($curview) \
1990 [list $phase $rowidlist $rowlaidout $rowoptim $numcommits]
1991 } elseif {![info exists viewdata($curview)]
1992 || [lindex $viewdata($curview) 0] ne {}} {
1993 set viewdata($curview) \
1994 [list {} $rowidlist]
1997 catch {unset treediffs}
1999 if {[info exists hlview] && $hlview == $n} {
2001 set selectedhlview None
2003 catch {unset commitinterest}
2007 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2008 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2010 if {![info exists viewdata($n)]} {
2012 set pending_select $selid
2019 set phase [lindex $v 0]
2020 set displayorder $vdisporder($n)
2021 set parentlist $vparentlist($n)
2022 set commitlisted $vcmitlisted($n)
2023 set rowidlist [lindex $v 1]
2025 set numcommits [llength $displayorder]
2027 set rowlaidout [lindex $v 2]
2028 set rowoptim [lindex $v 3]
2029 set numcommits [lindex $v 4]
2032 catch {unset colormap}
2033 catch {unset rowtextx}
2035 set canvxmax [$canv cget -width]
2042 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2043 set row $commitrow($n,$selid)
2044 # try to get the selected row in the same position on the screen
2045 set ymax [lindex [$canv cget -scrollregion] 3]
2046 set ytop [expr {[yc $row] - $yscreen}]
2050 set yf [expr {$ytop * 1.0 / $ymax}]
2052 allcanvs yview moveto $yf
2056 } elseif {$selid ne {}} {
2057 set pending_select $selid
2059 set row [first_real_row]
2060 if {$row < $numcommits} {
2067 if {$phase eq "getcommits"} {
2068 show_status "Reading commits..."
2071 } elseif {$numcommits == 0} {
2072 show_status "No commits selected"
2077 # Stuff relating to the highlighting facility
2079 proc ishighlighted {row} {
2080 global vhighlights fhighlights nhighlights rhighlights
2082 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2083 return $nhighlights($row)
2085 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2086 return $vhighlights($row)
2088 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2089 return $fhighlights($row)
2091 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2092 return $rhighlights($row)
2097 proc bolden {row font} {
2098 global canv linehtag selectedline boldrows
2100 lappend boldrows $row
2101 $canv itemconf $linehtag($row) -font $font
2102 if {[info exists selectedline] && $row == $selectedline} {
2104 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2105 -outline {{}} -tags secsel \
2106 -fill [$canv cget -selectbackground]]
2111 proc bolden_name {row font} {
2112 global canv2 linentag selectedline boldnamerows
2114 lappend boldnamerows $row
2115 $canv2 itemconf $linentag($row) -font $font
2116 if {[info exists selectedline] && $row == $selectedline} {
2117 $canv2 delete secsel
2118 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2119 -outline {{}} -tags secsel \
2120 -fill [$canv2 cget -selectbackground]]
2126 global mainfont boldrows
2129 foreach row $boldrows {
2130 if {![ishighlighted $row]} {
2131 bolden $row $mainfont
2133 lappend stillbold $row
2136 set boldrows $stillbold
2139 proc addvhighlight {n} {
2140 global hlview curview viewdata vhl_done vhighlights commitidx
2142 if {[info exists hlview]} {
2146 if {$n != $curview && ![info exists viewdata($n)]} {
2147 set viewdata($n) [list getcommits {{}} 0 0 0]
2148 set vparentlist($n) {}
2149 set vdisporder($n) {}
2150 set vcmitlisted($n) {}
2153 set vhl_done $commitidx($hlview)
2154 if {$vhl_done > 0} {
2159 proc delvhighlight {} {
2160 global hlview vhighlights
2162 if {![info exists hlview]} return
2164 catch {unset vhighlights}
2168 proc vhighlightmore {} {
2169 global hlview vhl_done commitidx vhighlights
2170 global displayorder vdisporder curview mainfont
2172 set font [concat $mainfont bold]
2173 set max $commitidx($hlview)
2174 if {$hlview == $curview} {
2175 set disp $displayorder
2177 set disp $vdisporder($hlview)
2179 set vr [visiblerows]
2180 set r0 [lindex $vr 0]
2181 set r1 [lindex $vr 1]
2182 for {set i $vhl_done} {$i < $max} {incr i} {
2183 set id [lindex $disp $i]
2184 if {[info exists commitrow($curview,$id)]} {
2185 set row $commitrow($curview,$id)
2186 if {$r0 <= $row && $row <= $r1} {
2187 if {![highlighted $row]} {
2190 set vhighlights($row) 1
2197 proc askvhighlight {row id} {
2198 global hlview vhighlights commitrow iddrawn mainfont
2200 if {[info exists commitrow($hlview,$id)]} {
2201 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2202 bolden $row [concat $mainfont bold]
2204 set vhighlights($row) 1
2206 set vhighlights($row) 0
2210 proc hfiles_change {name ix op} {
2211 global highlight_files filehighlight fhighlights fh_serial
2212 global mainfont highlight_paths
2214 if {[info exists filehighlight]} {
2215 # delete previous highlights
2216 catch {close $filehighlight}
2218 catch {unset fhighlights}
2220 unhighlight_filelist
2222 set highlight_paths {}
2223 after cancel do_file_hl $fh_serial
2225 if {$highlight_files ne {}} {
2226 after 300 do_file_hl $fh_serial
2230 proc makepatterns {l} {
2233 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2234 if {[string index $ee end] eq "/"} {
2244 proc do_file_hl {serial} {
2245 global highlight_files filehighlight highlight_paths gdttype fhl_list
2247 if {$gdttype eq "touching paths:"} {
2248 if {[catch {set paths [shellsplit $highlight_files]}]} return
2249 set highlight_paths [makepatterns $paths]
2251 set gdtargs [concat -- $paths]
2253 set gdtargs [list "-S$highlight_files"]
2255 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2256 set filehighlight [open $cmd r+]
2257 fconfigure $filehighlight -blocking 0
2258 filerun $filehighlight readfhighlight
2264 proc flushhighlights {} {
2265 global filehighlight fhl_list
2267 if {[info exists filehighlight]} {
2269 puts $filehighlight ""
2270 flush $filehighlight
2274 proc askfilehighlight {row id} {
2275 global filehighlight fhighlights fhl_list
2277 lappend fhl_list $id
2278 set fhighlights($row) -1
2279 puts $filehighlight $id
2282 proc readfhighlight {} {
2283 global filehighlight fhighlights commitrow curview mainfont iddrawn
2286 if {![info exists filehighlight]} {
2290 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2291 set line [string trim $line]
2292 set i [lsearch -exact $fhl_list $line]
2293 if {$i < 0} continue
2294 for {set j 0} {$j < $i} {incr j} {
2295 set id [lindex $fhl_list $j]
2296 if {[info exists commitrow($curview,$id)]} {
2297 set fhighlights($commitrow($curview,$id)) 0
2300 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2301 if {$line eq {}} continue
2302 if {![info exists commitrow($curview,$line)]} continue
2303 set row $commitrow($curview,$line)
2304 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2305 bolden $row [concat $mainfont bold]
2307 set fhighlights($row) 1
2309 if {[eof $filehighlight]} {
2311 puts "oops, git diff-tree died"
2312 catch {close $filehighlight}
2320 proc find_change {name ix op} {
2321 global nhighlights mainfont boldnamerows
2322 global findstring findpattern findtype
2324 # delete previous highlights, if any
2325 foreach row $boldnamerows {
2326 bolden_name $row $mainfont
2329 catch {unset nhighlights}
2332 if {$findtype ne "Regexp"} {
2333 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2335 set findpattern "*$e*"
2340 proc doesmatch {f} {
2341 global findtype findstring findpattern
2343 if {$findtype eq "Regexp"} {
2344 return [regexp $findstring $f]
2345 } elseif {$findtype eq "IgnCase"} {
2346 return [string match -nocase $findpattern $f]
2348 return [string match $findpattern $f]
2352 proc askfindhighlight {row id} {
2353 global nhighlights commitinfo iddrawn mainfont
2355 global markingmatches
2357 if {![info exists commitinfo($id)]} {
2360 set info $commitinfo($id)
2362 set fldtypes {Headline Author Date Committer CDate Comments}
2363 foreach f $info ty $fldtypes {
2364 if {($findloc eq "All fields" || $findloc eq $ty) &&
2366 if {$ty eq "Author"} {
2373 if {$isbold && [info exists iddrawn($id)]} {
2374 set f [concat $mainfont bold]
2375 if {![ishighlighted $row]} {
2381 if {$markingmatches} {
2382 markrowmatches $row $id
2385 set nhighlights($row) $isbold
2388 proc markrowmatches {row id} {
2389 global canv canv2 linehtag linentag commitinfo findloc
2391 set headline [lindex $commitinfo($id) 0]
2392 set author [lindex $commitinfo($id) 1]
2393 $canv delete match$row
2394 $canv2 delete match$row
2395 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2396 set m [findmatches $headline]
2398 markmatches $canv $row $headline $linehtag($row) $m \
2399 [$canv itemcget $linehtag($row) -font] $row
2402 if {$findloc eq "All fields" || $findloc eq "Author"} {
2403 set m [findmatches $author]
2405 markmatches $canv2 $row $author $linentag($row) $m \
2406 [$canv2 itemcget $linentag($row) -font] $row
2411 proc vrel_change {name ix op} {
2412 global highlight_related
2415 if {$highlight_related ne "None"} {
2420 # prepare for testing whether commits are descendents or ancestors of a
2421 proc rhighlight_sel {a} {
2422 global descendent desc_todo ancestor anc_todo
2423 global highlight_related rhighlights
2425 catch {unset descendent}
2426 set desc_todo [list $a]
2427 catch {unset ancestor}
2428 set anc_todo [list $a]
2429 if {$highlight_related ne "None"} {
2435 proc rhighlight_none {} {
2438 catch {unset rhighlights}
2442 proc is_descendent {a} {
2443 global curview children commitrow descendent desc_todo
2446 set la $commitrow($v,$a)
2450 for {set i 0} {$i < [llength $todo]} {incr i} {
2451 set do [lindex $todo $i]
2452 if {$commitrow($v,$do) < $la} {
2453 lappend leftover $do
2456 foreach nk $children($v,$do) {
2457 if {![info exists descendent($nk)]} {
2458 set descendent($nk) 1
2466 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2470 set descendent($a) 0
2471 set desc_todo $leftover
2474 proc is_ancestor {a} {
2475 global curview parentlist commitrow ancestor anc_todo
2478 set la $commitrow($v,$a)
2482 for {set i 0} {$i < [llength $todo]} {incr i} {
2483 set do [lindex $todo $i]
2484 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2485 lappend leftover $do
2488 foreach np [lindex $parentlist $commitrow($v,$do)] {
2489 if {![info exists ancestor($np)]} {
2498 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2503 set anc_todo $leftover
2506 proc askrelhighlight {row id} {
2507 global descendent highlight_related iddrawn mainfont rhighlights
2508 global selectedline ancestor
2510 if {![info exists selectedline]} return
2512 if {$highlight_related eq "Descendent" ||
2513 $highlight_related eq "Not descendent"} {
2514 if {![info exists descendent($id)]} {
2517 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2520 } elseif {$highlight_related eq "Ancestor" ||
2521 $highlight_related eq "Not ancestor"} {
2522 if {![info exists ancestor($id)]} {
2525 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2529 if {[info exists iddrawn($id)]} {
2530 if {$isbold && ![ishighlighted $row]} {
2531 bolden $row [concat $mainfont bold]
2534 set rhighlights($row) $isbold
2537 proc next_hlcont {} {
2538 global fhl_row fhl_dirn displayorder numcommits
2539 global vhighlights fhighlights nhighlights rhighlights
2540 global hlview filehighlight findstring highlight_related
2542 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2545 if {$row < 0 || $row >= $numcommits} {
2550 set id [lindex $displayorder $row]
2551 if {[info exists hlview]} {
2552 if {![info exists vhighlights($row)]} {
2553 askvhighlight $row $id
2555 if {$vhighlights($row) > 0} break
2557 if {$findstring ne {}} {
2558 if {![info exists nhighlights($row)]} {
2559 askfindhighlight $row $id
2561 if {$nhighlights($row) > 0} break
2563 if {$highlight_related ne "None"} {
2564 if {![info exists rhighlights($row)]} {
2565 askrelhighlight $row $id
2567 if {$rhighlights($row) > 0} break
2569 if {[info exists filehighlight]} {
2570 if {![info exists fhighlights($row)]} {
2571 # ask for a few more while we're at it...
2573 for {set n 0} {$n < 100} {incr n} {
2574 if {![info exists fhighlights($r)]} {
2575 askfilehighlight $r [lindex $displayorder $r]
2578 if {$r < 0 || $r >= $numcommits} break
2582 if {$fhighlights($row) < 0} {
2586 if {$fhighlights($row) > 0} break
2594 proc next_highlight {dirn} {
2595 global selectedline fhl_row fhl_dirn
2596 global hlview filehighlight findstring highlight_related
2598 if {![info exists selectedline]} return
2599 if {!([info exists hlview] || $findstring ne {} ||
2600 $highlight_related ne "None" || [info exists filehighlight])} return
2601 set fhl_row [expr {$selectedline + $dirn}]
2606 proc cancel_next_highlight {} {
2612 # Graph layout functions
2614 proc shortids {ids} {
2617 if {[llength $id] > 1} {
2618 lappend res [shortids $id]
2619 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2620 lappend res [string range $id 0 7]
2628 proc incrange {l x o} {
2631 set e [lindex $l $x]
2633 lset l $x [expr {$e + $o}]
2642 for {} {$n > 0} {incr n -1} {
2648 proc usedinrange {id l1 l2} {
2649 global children commitrow curview
2651 if {[info exists commitrow($curview,$id)]} {
2652 set r $commitrow($curview,$id)
2653 if {$l1 <= $r && $r <= $l2} {
2654 return [expr {$r - $l1 + 1}]
2657 set kids $children($curview,$id)
2659 if {[info exists commitrow($curview,$c)]} {
2660 set r $commitrow($curview,$c)
2661 if {$l1 <= $r && $r <= $l2} {
2662 return [expr {$r - $l1 + 1}]
2669 # Work out where id should go in idlist so that order-token
2670 # values increase from left to right
2671 proc idcol {idlist id {i 0}} {
2672 global ordertok curview
2674 set t $ordertok($curview,$id)
2675 if {$i >= [llength $idlist] ||
2676 $t < $ordertok($curview,[lindex $idlist $i])} {
2677 if {$i > [llength $idlist]} {
2678 set i [llength $idlist]
2680 while {[incr i -1] >= 0 &&
2681 $t < $ordertok($curview,[lindex $idlist $i])} {}
2684 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2685 while {[incr i] < [llength $idlist] &&
2686 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2692 proc makeuparrow {oid y x} {
2693 global rowidlist uparrowlen displayorder
2695 for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {
2697 set idl [lindex $rowidlist $y]
2698 set x [idcol $idl $oid $x]
2699 lset rowidlist $y [linsert $idl $x $oid]
2703 proc initlayout {} {
2704 global rowidlist displayorder commitlisted
2705 global rowlaidout rowoptim
2706 global numcommits canvxmax canv
2709 global colormap rowtextx
2720 set canvxmax [$canv cget -width]
2721 catch {unset colormap}
2722 catch {unset rowtextx}
2726 proc setcanvscroll {} {
2727 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2729 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2730 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2731 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2732 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2735 proc visiblerows {} {
2736 global canv numcommits linespc
2738 set ymax [lindex [$canv cget -scrollregion] 3]
2739 if {$ymax eq {} || $ymax == 0} return
2741 set y0 [expr {int([lindex $f 0] * $ymax)}]
2742 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2746 set y1 [expr {int([lindex $f 1] * $ymax)}]
2747 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2748 if {$r1 >= $numcommits} {
2749 set r1 [expr {$numcommits - 1}]
2751 return [list $r0 $r1]
2754 proc layoutmore {tmax allread} {
2755 global rowlaidout rowoptim commitidx numcommits optim_delay
2756 global uparrowlen curview rowidlist
2759 set showdelay $optim_delay
2760 set optdelay [expr {$uparrowlen + 1}]
2762 if {$rowoptim - $showdelay > $numcommits} {
2763 showstuff [expr {$rowoptim - $showdelay}] $showlast
2764 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2765 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2769 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2771 } elseif {$commitidx($curview) > $rowlaidout} {
2772 set nr [expr {$commitidx($curview) - $rowlaidout}]
2773 # may need to increase this threshold if uparrowlen or
2774 # mingaplen are increased...
2779 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2780 if {$rowlaidout == $row} {
2783 } elseif {$allread} {
2785 set nrows $commitidx($curview)
2786 if {[lindex $rowidlist $nrows] ne {}} {
2788 set rowlaidout $commitidx($curview)
2789 } elseif {$rowoptim == $nrows} {
2792 if {$numcommits == $nrows} {
2799 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2805 proc showstuff {canshow last} {
2806 global numcommits commitrow pending_select selectedline curview
2807 global lookingforhead mainheadid displayorder selectfirst
2808 global lastscrollset commitinterest
2810 if {$numcommits == 0} {
2812 set phase "incrdraw"
2815 for {set l $numcommits} {$l < $canshow} {incr l} {
2816 set id [lindex $displayorder $l]
2817 if {[info exists commitinterest($id)]} {
2818 foreach script $commitinterest($id) {
2819 eval [string map [list "%I" $id] $script]
2821 unset commitinterest($id)
2825 set prev $numcommits
2826 set numcommits $canshow
2827 set t [clock clicks -milliseconds]
2828 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2829 set lastscrollset $t
2832 set rows [visiblerows]
2833 set r1 [lindex $rows 1]
2834 if {$r1 >= $canshow} {
2835 set r1 [expr {$canshow - 1}]
2840 if {[info exists pending_select] &&
2841 [info exists commitrow($curview,$pending_select)] &&
2842 $commitrow($curview,$pending_select) < $numcommits} {
2843 selectline $commitrow($curview,$pending_select) 1
2846 if {[info exists selectedline] || [info exists pending_select]} {
2849 set l [first_real_row]
2854 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2855 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2856 set lookingforhead 0
2861 proc doshowlocalchanges {} {
2862 global lookingforhead curview mainheadid phase commitrow
2864 if {[info exists commitrow($curview,$mainheadid)] &&
2865 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2867 } elseif {$phase ne {}} {
2868 set lookingforhead 1
2872 proc dohidelocalchanges {} {
2873 global lookingforhead localfrow localirow lserial
2875 set lookingforhead 0
2876 if {$localfrow >= 0} {
2877 removerow $localfrow
2879 if {$localirow > 0} {
2883 if {$localirow >= 0} {
2884 removerow $localirow
2890 # spawn off a process to do git diff-index --cached HEAD
2891 proc dodiffindex {} {
2892 global localirow localfrow lserial
2897 set fd [open "|git diff-index --cached HEAD" r]
2898 fconfigure $fd -blocking 0
2899 filerun $fd [list readdiffindex $fd $lserial]
2902 proc readdiffindex {fd serial} {
2903 global localirow commitrow mainheadid nullid2 curview
2904 global commitinfo commitdata lserial
2907 if {[gets $fd line] < 0} {
2913 # we only need to see one line and we don't really care what it says...
2916 # now see if there are any local changes not checked in to the index
2917 if {$serial == $lserial} {
2918 set fd [open "|git diff-files" r]
2919 fconfigure $fd -blocking 0
2920 filerun $fd [list readdifffiles $fd $serial]
2923 if {$isdiff && $serial == $lserial && $localirow == -1} {
2924 # add the line for the changes in the index to the graph
2925 set localirow $commitrow($curview,$mainheadid)
2926 set hl "Local changes checked in to index but not committed"
2927 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2928 set commitdata($nullid2) "\n $hl\n"
2929 insertrow $localirow $nullid2
2934 proc readdifffiles {fd serial} {
2935 global localirow localfrow commitrow mainheadid nullid curview
2936 global commitinfo commitdata lserial
2939 if {[gets $fd line] < 0} {
2945 # we only need to see one line and we don't really care what it says...
2948 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2949 # add the line for the local diff to the graph
2950 if {$localirow >= 0} {
2951 set localfrow $localirow
2954 set localfrow $commitrow($curview,$mainheadid)
2956 set hl "Local uncommitted changes, not checked in to index"
2957 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2958 set commitdata($nullid) "\n $hl\n"
2959 insertrow $localfrow $nullid
2964 proc nextuse {id row} {
2965 global commitrow curview children
2967 if {[info exists children($curview,$id)]} {
2968 foreach kid $children($curview,$id) {
2969 if {[info exists commitrow($curview,$kid)] &&
2970 $commitrow($curview,$kid) > $row} {
2971 return $commitrow($curview,$kid)
2975 if {[info exists commitrow($curview,$id)]} {
2976 return $commitrow($curview,$id)
2981 proc layoutrows {row endrow last} {
2982 global rowidlist displayorder
2983 global uparrowlen downarrowlen maxwidth mingaplen
2984 global children parentlist
2985 global commitidx curview
2987 set idlist [lindex $rowidlist $row]
2988 if {!$last && $endrow + $uparrowlen + $mingaplen > $commitidx($curview)} {
2989 set endrow [expr {$commitidx($curview) - $uparrowlen - $mingaplen}]
2991 while {$row < $endrow} {
2992 set id [lindex $displayorder $row]
2993 if {$row > $downarrowlen} {
2994 set termrow [expr {$row - $downarrowlen - 1}]
2995 foreach p [lindex $parentlist $termrow] {
2996 set i [lsearch -exact $idlist $p]
2997 if {$i < 0} continue
2998 set nr [nextuse $p $termrow]
2999 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3000 set idlist [lreplace $idlist $i $i]
3003 lset rowidlist $row $idlist
3007 foreach p [lindex $parentlist $row] {
3008 # is id the first child of this parent?
3009 if {$id eq [lindex $children($curview,$p) 0]} {
3011 } elseif {[lsearch -exact $idlist $p] < 0} {
3015 set col [lsearch -exact $idlist $id]
3017 set col [idcol $idlist $id]
3018 set idlist [linsert $idlist $col $id]
3019 lset rowidlist $row $idlist
3020 if {$children($curview,$id) ne {}} {
3021 makeuparrow $id $row $col
3025 set idlist [lreplace $idlist $col $col]
3027 foreach i $newolds {
3028 set x [idcol $idlist $i $x]
3029 set idlist [linsert $idlist $x $i]
3031 foreach oid $oldolds {
3032 set x [idcol $idlist $oid $x]
3033 set idlist [linsert $idlist $x $oid]
3034 makeuparrow $oid $row $x
3036 lappend rowidlist $idlist
3041 proc addextraid {id row} {
3042 global displayorder commitrow commitinfo
3043 global commitidx commitlisted
3044 global parentlist children curview
3046 incr commitidx($curview)
3047 lappend displayorder $id
3048 lappend commitlisted 0
3049 lappend parentlist {}
3050 set commitrow($curview,$id) $row
3052 if {![info exists commitinfo($id)]} {
3053 set commitinfo($id) {"No commit information available"}
3055 if {![info exists children($curview,$id)]} {
3056 set children($curview,$id) {}
3060 proc layouttail {} {
3061 global rowidlist commitidx curview
3063 set row $commitidx($curview)
3064 set idlist [lindex $rowidlist $row]
3065 while {$idlist ne {}} {
3066 set col [expr {[llength $idlist] - 1}]
3067 set id [lindex $idlist $col]
3070 set idlist [lreplace $idlist $col $col]
3071 lappend rowidlist $idlist
3075 proc insert_pad {row col npad} {
3078 set pad [ntimes $npad {}]
3079 set idlist [lindex $rowidlist $row]
3080 set bef [lrange $idlist 0 [expr {$col - 1}]]
3081 set aft [lrange $idlist $col end]
3082 set i [lsearch -exact $aft {}]
3084 set aft [lreplace $aft $i $i]
3086 lset rowidlist $row [concat $bef $pad $aft]
3089 proc optimize_rows {row col endrow} {
3090 global rowidlist displayorder curview children
3095 set idlist [lindex $rowidlist [expr {$row - 1}]]
3097 set previdlist [lindex $rowidlist [expr {$row - 2}]]
3101 for {} {$row < $endrow} {incr row} {
3102 set pprevidlist $previdlist
3103 set previdlist $idlist
3104 set idlist [lindex $rowidlist $row]
3106 set y0 [expr {$row - 1}]
3107 set ym [expr {$row - 2}]
3110 for {} {$col < [llength $idlist]} {incr col} {
3111 set id [lindex $idlist $col]
3112 if {[lindex $previdlist $col] eq $id} continue
3117 set x0 [lsearch -exact $previdlist $id]
3118 if {$x0 < 0} continue
3119 set z [expr {$x0 - $col}]
3123 set xm [lsearch -exact $pprevidlist $id]
3125 set z0 [expr {$xm - $x0}]
3129 # if row y0 is the first child of $id then it's not an arrow
3130 if {[lindex $children($curview,$id) 0] ne
3131 [lindex $displayorder $y0]} {
3135 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3136 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3139 # Looking at lines from this row to the previous row,
3140 # make them go straight up if they end in an arrow on
3141 # the previous row; otherwise make them go straight up
3143 if {$z < -1 || ($z < 0 && $isarrow)} {
3144 # Line currently goes left too much;
3145 # insert pads in the previous row, then optimize it
3146 set npad [expr {-1 - $z + $isarrow}]
3147 insert_pad $y0 $x0 $npad
3149 optimize_rows $y0 $x0 $row
3151 set previdlist [lindex $rowidlist $y0]
3152 set x0 [lsearch -exact $previdlist $id]
3153 set z [expr {$x0 - $col}]
3155 set pprevidlist [lindex $rowidlist $ym]
3156 set xm [lsearch -exact $pprevidlist $id]
3157 set z0 [expr {$xm - $x0}]
3159 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3160 # Line currently goes right too much;
3161 # insert pads in this line
3162 set npad [expr {$z - 1 + $isarrow}]
3163 insert_pad $row $col $npad
3164 set idlist [lindex $rowidlist $row]
3166 set z [expr {$x0 - $col}]
3169 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3170 # this line links to its first child on row $row-2
3171 set id [lindex $displayorder $ym]
3172 set xc [lsearch -exact $pprevidlist $id]
3174 set z0 [expr {$xc - $x0}]
3177 # avoid lines jigging left then immediately right
3178 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3179 insert_pad $y0 $x0 1
3181 optimize_rows $y0 $x0 $row
3182 set previdlist [lindex $rowidlist $y0]
3183 set pprevidlist [lindex $rowidlist $ym]
3187 # Find the first column that doesn't have a line going right
3188 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3189 set id [lindex $idlist $col]
3190 if {$id eq {}} break
3191 set x0 [lsearch -exact $previdlist $id]
3193 # check if this is the link to the first child
3194 set kid [lindex $displayorder $y0]
3195 if {[lindex $children($curview,$id) 0] eq $kid} {
3196 # it is, work out offset to child
3197 set x0 [lsearch -exact $previdlist $kid]
3200 if {$x0 <= $col} break
3202 # Insert a pad at that column as long as it has a line and
3203 # isn't the last column
3204 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3205 set idlist [linsert $idlist $col {}]
3208 lset rowidlist $row $idlist
3214 global canvx0 linespc
3215 return [expr {$canvx0 + $col * $linespc}]
3219 global canvy0 linespc
3220 return [expr {$canvy0 + $row * $linespc}]
3223 proc linewidth {id} {
3224 global thickerline lthickness
3227 if {[info exists thickerline] && $id eq $thickerline} {
3228 set wid [expr {2 * $lthickness}]
3233 proc rowranges {id} {
3234 global commitrow curview children uparrowlen downarrowlen
3237 set kids $children($curview,$id)
3243 foreach child $kids {
3244 if {![info exists commitrow($curview,$child)]} break
3245 set row $commitrow($curview,$child)
3246 if {![info exists prev]} {
3247 lappend ret [expr {$row + 1}]
3249 if {$row <= $prevrow} {
3250 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3252 # see if the line extends the whole way from prevrow to row
3253 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3254 [lsearch -exact [lindex $rowidlist \
3255 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3256 # it doesn't, see where it ends
3257 set r [expr {$prevrow + $downarrowlen}]
3258 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3259 while {[incr r -1] > $prevrow &&
3260 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3262 while {[incr r] <= $row &&
3263 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3267 # see where it starts up again
3268 set r [expr {$row - $uparrowlen}]
3269 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3270 while {[incr r] < $row &&
3271 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3273 while {[incr r -1] >= $prevrow &&
3274 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3280 if {$child eq $id} {
3289 proc drawlineseg {id row endrow arrowlow} {
3290 global rowidlist displayorder iddrawn linesegs
3291 global canv colormap linespc curview maxlinelen parentlist
3293 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3294 set le [expr {$row + 1}]
3297 set c [lsearch -exact [lindex $rowidlist $le] $id]
3303 set x [lindex $displayorder $le]
3308 if {[info exists iddrawn($x)] || $le == $endrow} {
3309 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3325 if {[info exists linesegs($id)]} {
3326 set lines $linesegs($id)
3328 set r0 [lindex $li 0]
3330 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3340 set li [lindex $lines [expr {$i-1}]]
3341 set r1 [lindex $li 1]
3342 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3347 set x [lindex $cols [expr {$le - $row}]]
3348 set xp [lindex $cols [expr {$le - 1 - $row}]]
3349 set dir [expr {$xp - $x}]
3351 set ith [lindex $lines $i 2]
3352 set coords [$canv coords $ith]
3353 set ah [$canv itemcget $ith -arrow]
3354 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3355 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3356 if {$x2 ne {} && $x - $x2 == $dir} {
3357 set coords [lrange $coords 0 end-2]
3360 set coords [list [xc $le $x] [yc $le]]
3363 set itl [lindex $lines [expr {$i-1}] 2]
3364 set al [$canv itemcget $itl -arrow]
3365 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3366 } elseif {$arrowlow} {
3367 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3368 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3372 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3373 for {set y $le} {[incr y -1] > $row} {} {
3375 set xp [lindex $cols [expr {$y - 1 - $row}]]
3376 set ndir [expr {$xp - $x}]
3377 if {$dir != $ndir || $xp < 0} {
3378 lappend coords [xc $y $x] [yc $y]
3384 # join parent line to first child
3385 set ch [lindex $displayorder $row]
3386 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3388 puts "oops: drawlineseg: child $ch not on row $row"
3389 } elseif {$xc != $x} {
3390 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3391 set d [expr {int(0.5 * $linespc)}]
3394 set x2 [expr {$x1 - $d}]
3396 set x2 [expr {$x1 + $d}]
3399 set y1 [expr {$y2 + $d}]
3400 lappend coords $x1 $y1 $x2 $y2
3401 } elseif {$xc < $x - 1} {
3402 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3403 } elseif {$xc > $x + 1} {
3404 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3408 lappend coords [xc $row $x] [yc $row]
3410 set xn [xc $row $xp]
3412 lappend coords $xn $yn
3416 set t [$canv create line $coords -width [linewidth $id] \
3417 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3420 set lines [linsert $lines $i [list $row $le $t]]
3422 $canv coords $ith $coords
3423 if {$arrow ne $ah} {
3424 $canv itemconf $ith -arrow $arrow
3426 lset lines $i 0 $row
3429 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3430 set ndir [expr {$xo - $xp}]
3431 set clow [$canv coords $itl]
3432 if {$dir == $ndir} {
3433 set clow [lrange $clow 2 end]
3435 set coords [concat $coords $clow]
3437 lset lines [expr {$i-1}] 1 $le
3439 # coalesce two pieces
3441 set b [lindex $lines [expr {$i-1}] 0]
3442 set e [lindex $lines $i 1]
3443 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3445 $canv coords $itl $coords
3446 if {$arrow ne $al} {
3447 $canv itemconf $itl -arrow $arrow
3451 set linesegs($id) $lines
3455 proc drawparentlinks {id row} {
3456 global rowidlist canv colormap curview parentlist
3457 global idpos linespc
3459 set rowids [lindex $rowidlist $row]
3460 set col [lsearch -exact $rowids $id]
3461 if {$col < 0} return
3462 set olds [lindex $parentlist $row]
3463 set row2 [expr {$row + 1}]
3464 set x [xc $row $col]
3467 set d [expr {int(0.5 * $linespc)}]
3468 set ymid [expr {$y + $d}]
3469 set ids [lindex $rowidlist $row2]
3470 # rmx = right-most X coord used
3473 set i [lsearch -exact $ids $p]
3475 puts "oops, parent $p of $id not in list"
3478 set x2 [xc $row2 $i]
3482 set j [lsearch -exact $rowids $p]
3484 # drawlineseg will do this one for us
3488 # should handle duplicated parents here...
3489 set coords [list $x $y]
3491 # if attaching to a vertical segment, draw a smaller
3492 # slant for visual distinctness
3495 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3497 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3499 } elseif {$i < $col && $i < $j} {
3500 # segment slants towards us already
3501 lappend coords [xc $row $j] $y
3503 if {$i < $col - 1} {
3504 lappend coords [expr {$x2 + $linespc}] $y
3505 } elseif {$i > $col + 1} {
3506 lappend coords [expr {$x2 - $linespc}] $y
3508 lappend coords $x2 $y2
3511 lappend coords $x2 $y2
3513 set t [$canv create line $coords -width [linewidth $p] \
3514 -fill $colormap($p) -tags lines.$p]
3518 if {$rmx > [lindex $idpos($id) 1]} {
3519 lset idpos($id) 1 $rmx
3524 proc drawlines {id} {
3527 $canv itemconf lines.$id -width [linewidth $id]
3530 proc drawcmittext {id row col} {
3531 global linespc canv canv2 canv3 canvy0 fgcolor curview
3532 global commitlisted commitinfo rowidlist parentlist
3533 global rowtextx idpos idtags idheads idotherrefs
3534 global linehtag linentag linedtag
3535 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3537 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3538 set listed [lindex $commitlisted $row]
3539 if {$id eq $nullid} {
3541 } elseif {$id eq $nullid2} {
3544 set ofill [expr {$listed != 0? "blue": "white"}]
3546 set x [xc $row $col]
3548 set orad [expr {$linespc / 3}]
3550 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3551 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3552 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3553 } elseif {$listed == 2} {
3554 # triangle pointing left for left-side commits
3555 set t [$canv create polygon \
3556 [expr {$x - $orad}] $y \
3557 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3558 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3559 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3561 # triangle pointing right for right-side commits
3562 set t [$canv create polygon \
3563 [expr {$x + $orad - 1}] $y \
3564 [expr {$x - $orad}] [expr {$y - $orad}] \
3565 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3566 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3569 $canv bind $t <1> {selcanvline {} %x %y}
3570 set rmx [llength [lindex $rowidlist $row]]
3571 set olds [lindex $parentlist $row]
3573 set nextids [lindex $rowidlist [expr {$row + 1}]]
3575 set i [lsearch -exact $nextids $p]
3581 set xt [xc $row $rmx]
3582 set rowtextx($row) $xt
3583 set idpos($id) [list $x $xt $y]
3584 if {[info exists idtags($id)] || [info exists idheads($id)]
3585 || [info exists idotherrefs($id)]} {
3586 set xt [drawtags $id $x $xt $y]
3588 set headline [lindex $commitinfo($id) 0]
3589 set name [lindex $commitinfo($id) 1]
3590 set date [lindex $commitinfo($id) 2]
3591 set date [formatdate $date]
3594 set isbold [ishighlighted $row]
3596 lappend boldrows $row
3599 lappend boldnamerows $row
3603 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3604 -text $headline -font $font -tags text]
3605 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3606 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3607 -text $name -font $nfont -tags text]
3608 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3609 -text $date -font $mainfont -tags text]
3610 set xr [expr {$xt + [font measure $mainfont $headline]}]
3611 if {$xr > $canvxmax} {
3617 proc drawcmitrow {row} {
3618 global displayorder rowidlist
3619 global iddrawn markingmatches
3620 global commitinfo parentlist numcommits
3621 global filehighlight fhighlights findstring nhighlights
3622 global hlview vhighlights
3623 global highlight_related rhighlights
3625 if {$row >= $numcommits} return
3627 set id [lindex $displayorder $row]
3628 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3629 askvhighlight $row $id
3631 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3632 askfilehighlight $row $id
3634 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3635 askfindhighlight $row $id
3637 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3638 askrelhighlight $row $id
3640 if {![info exists iddrawn($id)]} {
3641 set col [lsearch -exact [lindex $rowidlist $row] $id]
3643 puts "oops, row $row id $id not in list"
3646 if {![info exists commitinfo($id)]} {
3650 drawcmittext $id $row $col
3653 if {$markingmatches} {
3654 markrowmatches $row $id
3658 proc drawcommits {row {endrow {}}} {
3659 global numcommits iddrawn displayorder curview
3660 global parentlist rowidlist
3665 if {$endrow eq {}} {
3668 if {$endrow >= $numcommits} {
3669 set endrow [expr {$numcommits - 1}]
3672 # make the lines join to already-drawn rows either side
3673 set r [expr {$row - 1}]
3674 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3677 set er [expr {$endrow + 1}]
3678 if {$er >= $numcommits ||
3679 ![info exists iddrawn([lindex $displayorder $er])]} {
3682 for {} {$r <= $er} {incr r} {
3683 set id [lindex $displayorder $r]
3684 set wasdrawn [info exists iddrawn($id)]
3686 if {$r == $er} break
3687 set nextid [lindex $displayorder [expr {$r + 1}]]
3688 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3689 catch {unset prevlines}
3692 drawparentlinks $id $r
3694 if {[info exists lineends($r)]} {
3695 foreach lid $lineends($r) {
3696 unset prevlines($lid)
3699 set rowids [lindex $rowidlist $r]
3700 foreach lid $rowids {
3701 if {$lid eq {}} continue
3703 # see if this is the first child of any of its parents
3704 foreach p [lindex $parentlist $r] {
3705 if {[lsearch -exact $rowids $p] < 0} {
3706 # make this line extend up to the child
3707 set le [drawlineseg $p $r $er 0]
3708 lappend lineends($le) $p
3712 } elseif {![info exists prevlines($lid)]} {
3713 set le [drawlineseg $lid $r $er 1]
3714 lappend lineends($le) $lid
3715 set prevlines($lid) 1
3721 proc drawfrac {f0 f1} {
3724 set ymax [lindex [$canv cget -scrollregion] 3]
3725 if {$ymax eq {} || $ymax == 0} return
3726 set y0 [expr {int($f0 * $ymax)}]
3727 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3728 set y1 [expr {int($f1 * $ymax)}]
3729 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3730 drawcommits $row $endrow
3733 proc drawvisible {} {
3735 eval drawfrac [$canv yview]
3738 proc clear_display {} {
3739 global iddrawn linesegs
3740 global vhighlights fhighlights nhighlights rhighlights
3743 catch {unset iddrawn}
3744 catch {unset linesegs}
3745 catch {unset vhighlights}
3746 catch {unset fhighlights}
3747 catch {unset nhighlights}
3748 catch {unset rhighlights}
3751 proc findcrossings {id} {
3752 global rowidlist parentlist numcommits displayorder
3756 foreach {s e} [rowranges $id] {
3757 if {$e >= $numcommits} {
3758 set e [expr {$numcommits - 1}]
3760 if {$e <= $s} continue
3761 for {set row $e} {[incr row -1] >= $s} {} {
3762 set x [lsearch -exact [lindex $rowidlist $row] $id]
3764 set olds [lindex $parentlist $row]
3765 set kid [lindex $displayorder $row]
3766 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3767 if {$kidx < 0} continue
3768 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3770 set px [lsearch -exact $nextrow $p]
3771 if {$px < 0} continue
3772 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3773 if {[lsearch -exact $ccross $p] >= 0} continue
3774 if {$x == $px + ($kidx < $px? -1: 1)} {
3776 } elseif {[lsearch -exact $cross $p] < 0} {
3783 return [concat $ccross {{}} $cross]
3786 proc assigncolor {id} {
3787 global colormap colors nextcolor
3788 global commitrow parentlist children children curview
3790 if {[info exists colormap($id)]} return
3791 set ncolors [llength $colors]
3792 if {[info exists children($curview,$id)]} {
3793 set kids $children($curview,$id)
3797 if {[llength $kids] == 1} {
3798 set child [lindex $kids 0]
3799 if {[info exists colormap($child)]
3800 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3801 set colormap($id) $colormap($child)
3807 foreach x [findcrossings $id] {
3809 # delimiter between corner crossings and other crossings
3810 if {[llength $badcolors] >= $ncolors - 1} break
3811 set origbad $badcolors
3813 if {[info exists colormap($x)]
3814 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3815 lappend badcolors $colormap($x)
3818 if {[llength $badcolors] >= $ncolors} {
3819 set badcolors $origbad
3821 set origbad $badcolors
3822 if {[llength $badcolors] < $ncolors - 1} {
3823 foreach child $kids {
3824 if {[info exists colormap($child)]
3825 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3826 lappend badcolors $colormap($child)
3828 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3829 if {[info exists colormap($p)]
3830 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3831 lappend badcolors $colormap($p)
3835 if {[llength $badcolors] >= $ncolors} {
3836 set badcolors $origbad
3839 for {set i 0} {$i <= $ncolors} {incr i} {
3840 set c [lindex $colors $nextcolor]
3841 if {[incr nextcolor] >= $ncolors} {
3844 if {[lsearch -exact $badcolors $c]} break
3846 set colormap($id) $c
3849 proc bindline {t id} {
3852 $canv bind $t <Enter> "lineenter %x %y $id"
3853 $canv bind $t <Motion> "linemotion %x %y $id"
3854 $canv bind $t <Leave> "lineleave $id"
3855 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3858 proc drawtags {id x xt y1} {
3859 global idtags idheads idotherrefs mainhead
3860 global linespc lthickness
3861 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3866 if {[info exists idtags($id)]} {
3867 set marks $idtags($id)
3868 set ntags [llength $marks]
3870 if {[info exists idheads($id)]} {
3871 set marks [concat $marks $idheads($id)]
3872 set nheads [llength $idheads($id)]
3874 if {[info exists idotherrefs($id)]} {
3875 set marks [concat $marks $idotherrefs($id)]
3881 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3882 set yt [expr {$y1 - 0.5 * $linespc}]
3883 set yb [expr {$yt + $linespc - 1}]
3887 foreach tag $marks {
3889 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3890 set wid [font measure [concat $mainfont bold] $tag]
3892 set wid [font measure $mainfont $tag]
3896 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3898 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3899 -width $lthickness -fill black -tags tag.$id]
3901 foreach tag $marks x $xvals wid $wvals {
3902 set xl [expr {$x + $delta}]
3903 set xr [expr {$x + $delta + $wid + $lthickness}]
3905 if {[incr ntags -1] >= 0} {
3907 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3908 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3909 -width 1 -outline black -fill yellow -tags tag.$id]
3910 $canv bind $t <1> [list showtag $tag 1]
3911 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3913 # draw a head or other ref
3914 if {[incr nheads -1] >= 0} {
3916 if {$tag eq $mainhead} {
3922 set xl [expr {$xl - $delta/2}]
3923 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3924 -width 1 -outline black -fill $col -tags tag.$id
3925 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3926 set rwid [font measure $mainfont $remoteprefix]
3927 set xi [expr {$x + 1}]
3928 set yti [expr {$yt + 1}]
3929 set xri [expr {$x + $rwid}]
3930 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3931 -width 0 -fill "#ffddaa" -tags tag.$id
3934 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3935 -font $font -tags [list tag.$id text]]
3937 $canv bind $t <1> [list showtag $tag 1]
3938 } elseif {$nheads >= 0} {
3939 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3945 proc xcoord {i level ln} {
3946 global canvx0 xspc1 xspc2
3948 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3949 if {$i > 0 && $i == $level} {
3950 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3951 } elseif {$i > $level} {
3952 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3957 proc show_status {msg} {
3958 global canv mainfont fgcolor
3961 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3962 -tags text -fill $fgcolor
3965 # Insert a new commit as the child of the commit on row $row.
3966 # The new commit will be displayed on row $row and the commits
3967 # on that row and below will move down one row.
3968 proc insertrow {row newcmit} {
3969 global displayorder parentlist commitlisted children
3970 global commitrow curview rowidlist numcommits
3971 global rowlaidout rowoptim numcommits
3972 global selectedline commitidx
3974 if {$row >= $numcommits} {
3975 puts "oops, inserting new row $row but only have $numcommits rows"
3978 set p [lindex $displayorder $row]
3979 set displayorder [linsert $displayorder $row $newcmit]
3980 set parentlist [linsert $parentlist $row $p]
3981 set kids $children($curview,$p)
3982 lappend kids $newcmit
3983 set children($curview,$p) $kids
3984 set children($curview,$newcmit) {}
3985 set commitlisted [linsert $commitlisted $row 1]
3986 set l [llength $displayorder]
3987 for {set r $row} {$r < $l} {incr r} {
3988 set id [lindex $displayorder $r]
3989 set commitrow($curview,$id) $r
3991 incr commitidx($curview)
3993 set idlist [lindex $rowidlist $row]
3994 if {[llength $kids] == 1} {
3995 set col [lsearch -exact $idlist $p]
3996 lset idlist $col $newcmit
3998 set col [llength $idlist]
3999 lappend idlist $newcmit
4001 set rowidlist [linsert $rowidlist $row $idlist]
4007 if {[info exists selectedline] && $selectedline >= $row} {
4013 # Remove a commit that was inserted with insertrow on row $row.
4014 proc removerow {row} {
4015 global displayorder parentlist commitlisted children
4016 global commitrow curview rowidlist numcommits
4017 global rowlaidout rowoptim numcommits
4018 global linesegends selectedline commitidx
4020 if {$row >= $numcommits} {
4021 puts "oops, removing row $row but only have $numcommits rows"
4024 set rp1 [expr {$row + 1}]
4025 set id [lindex $displayorder $row]
4026 set p [lindex $parentlist $row]
4027 set displayorder [lreplace $displayorder $row $row]
4028 set parentlist [lreplace $parentlist $row $row]
4029 set commitlisted [lreplace $commitlisted $row $row]
4030 set kids $children($curview,$p)
4031 set i [lsearch -exact $kids $id]
4033 set kids [lreplace $kids $i $i]
4034 set children($curview,$p) $kids
4036 set l [llength $displayorder]
4037 for {set r $row} {$r < $l} {incr r} {
4038 set id [lindex $displayorder $r]
4039 set commitrow($curview,$id) $r
4041 incr commitidx($curview) -1
4043 set rowidlist [lreplace $rowidlist $row $row]
4049 if {[info exists selectedline] && $selectedline > $row} {
4050 incr selectedline -1
4055 # Don't change the text pane cursor if it is currently the hand cursor,
4056 # showing that we are over a sha1 ID link.
4057 proc settextcursor {c} {
4058 global ctext curtextcursor
4060 if {[$ctext cget -cursor] == $curtextcursor} {
4061 $ctext config -cursor $c
4063 set curtextcursor $c
4066 proc nowbusy {what} {
4069 if {[array names isbusy] eq {}} {
4070 . config -cursor watch
4076 proc notbusy {what} {
4077 global isbusy maincursor textcursor
4079 catch {unset isbusy($what)}
4080 if {[array names isbusy] eq {}} {
4081 . config -cursor $maincursor
4082 settextcursor $textcursor
4086 proc findmatches {f} {
4087 global findtype findstring
4088 if {$findtype == "Regexp"} {
4089 set matches [regexp -indices -all -inline $findstring $f]
4092 if {$findtype == "IgnCase"} {
4093 set f [string tolower $f]
4094 set fs [string tolower $fs]
4098 set l [string length $fs]
4099 while {[set j [string first $fs $f $i]] >= 0} {
4100 lappend matches [list $j [expr {$j+$l-1}]]
4101 set i [expr {$j + $l}]
4107 proc dofind {{rev 0}} {
4108 global findstring findstartline findcurline selectedline numcommits
4111 cancel_next_highlight
4113 if {$findstring eq {} || $numcommits == 0} return
4114 if {![info exists selectedline]} {
4115 set findstartline [lindex [visiblerows] $rev]
4117 set findstartline $selectedline
4119 set findcurline $findstartline
4124 if {$findcurline == 0} {
4125 set findcurline $numcommits
4132 proc findnext {restart} {
4134 if {![info exists findcurline]} {
4148 if {![info exists findcurline]} {
4157 global commitdata commitinfo numcommits findstring findpattern findloc
4158 global findstartline findcurline displayorder
4160 set fldtypes {Headline Author Date Committer CDate Comments}
4161 set l [expr {$findcurline + 1}]
4162 if {$l >= $numcommits} {
4165 if {$l <= $findstartline} {
4166 set lim [expr {$findstartline + 1}]
4170 if {$lim - $l > 500} {
4171 set lim [expr {$l + 500}]
4174 for {} {$l < $lim} {incr l} {
4175 set id [lindex $displayorder $l]
4176 # shouldn't happen unless git log doesn't give all the commits...
4177 if {![info exists commitdata($id)]} continue
4178 if {![doesmatch $commitdata($id)]} continue
4179 if {![info exists commitinfo($id)]} {
4182 set info $commitinfo($id)
4183 foreach f $info ty $fldtypes {
4184 if {($findloc eq "All fields" || $findloc eq $ty) &&
4192 if {$l == $findstartline + 1} {
4198 set findcurline [expr {$l - 1}]
4202 proc findmorerev {} {
4203 global commitdata commitinfo numcommits findstring findpattern findloc
4204 global findstartline findcurline displayorder
4206 set fldtypes {Headline Author Date Committer CDate Comments}
4212 if {$l >= $findstartline} {
4213 set lim [expr {$findstartline - 1}]
4217 if {$l - $lim > 500} {
4218 set lim [expr {$l - 500}]
4221 for {} {$l > $lim} {incr l -1} {
4222 set id [lindex $displayorder $l]
4223 if {![info exists commitdata($id)]} continue
4224 if {![doesmatch $commitdata($id)]} continue
4225 if {![info exists commitinfo($id)]} {
4228 set info $commitinfo($id)
4229 foreach f $info ty $fldtypes {
4230 if {($findloc eq "All fields" || $findloc eq $ty) &&
4244 set findcurline [expr {$l + 1}]
4248 proc findselectline {l} {
4249 global findloc commentend ctext findcurline markingmatches
4251 set markingmatches 1
4254 if {$findloc == "All fields" || $findloc == "Comments"} {
4255 # highlight the matches in the comments
4256 set f [$ctext get 1.0 $commentend]
4257 set matches [findmatches $f]
4258 foreach match $matches {
4259 set start [lindex $match 0]
4260 set end [expr {[lindex $match 1] + 1}]
4261 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4267 # mark the bits of a headline or author that match a find string
4268 proc markmatches {canv l str tag matches font row} {
4271 set bbox [$canv bbox $tag]
4272 set x0 [lindex $bbox 0]
4273 set y0 [lindex $bbox 1]
4274 set y1 [lindex $bbox 3]
4275 foreach match $matches {
4276 set start [lindex $match 0]
4277 set end [lindex $match 1]
4278 if {$start > $end} continue
4279 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4280 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4281 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4282 [expr {$x0+$xlen+2}] $y1 \
4283 -outline {} -tags [list match$l matches] -fill yellow]
4285 if {[info exists selectedline] && $row == $selectedline} {
4286 $canv raise $t secsel
4291 proc unmarkmatches {} {
4292 global findids markingmatches findcurline
4294 allcanvs delete matches
4295 catch {unset findids}
4296 set markingmatches 0
4297 catch {unset findcurline}
4300 proc selcanvline {w x y} {
4301 global canv canvy0 ctext linespc
4303 set ymax [lindex [$canv cget -scrollregion] 3]
4304 if {$ymax == {}} return
4305 set yfrac [lindex [$canv yview] 0]
4306 set y [expr {$y + $yfrac * $ymax}]
4307 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4312 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4318 proc commit_descriptor {p} {
4320 if {![info exists commitinfo($p)]} {
4324 if {[llength $commitinfo($p)] > 1} {
4325 set l [lindex $commitinfo($p) 0]
4330 # append some text to the ctext widget, and make any SHA1 ID
4331 # that we know about be a clickable link.
4332 proc appendwithlinks {text tags} {
4333 global ctext commitrow linknum curview pendinglinks
4335 set start [$ctext index "end - 1c"]
4336 $ctext insert end $text $tags
4337 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4341 set linkid [string range $text $s $e]
4343 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4344 setlink $linkid link$linknum
4349 proc setlink {id lk} {
4350 global curview commitrow ctext pendinglinks commitinterest
4352 if {[info exists commitrow($curview,$id)]} {
4353 $ctext tag conf $lk -foreground blue -underline 1
4354 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4355 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4356 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4358 lappend pendinglinks($id) $lk
4359 lappend commitinterest($id) {makelink %I}
4363 proc makelink {id} {
4366 if {![info exists pendinglinks($id)]} return
4367 foreach lk $pendinglinks($id) {
4370 unset pendinglinks($id)
4373 proc linkcursor {w inc} {
4374 global linkentercount curtextcursor
4376 if {[incr linkentercount $inc] > 0} {
4377 $w configure -cursor hand2
4379 $w configure -cursor $curtextcursor
4380 if {$linkentercount < 0} {
4381 set linkentercount 0
4386 proc viewnextline {dir} {
4390 set ymax [lindex [$canv cget -scrollregion] 3]
4391 set wnow [$canv yview]
4392 set wtop [expr {[lindex $wnow 0] * $ymax}]
4393 set newtop [expr {$wtop + $dir * $linespc}]
4396 } elseif {$newtop > $ymax} {
4399 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4402 # add a list of tag or branch names at position pos
4403 # returns the number of names inserted
4404 proc appendrefs {pos ids var} {
4405 global ctext commitrow linknum curview $var maxrefs
4407 if {[catch {$ctext index $pos}]} {
4410 $ctext conf -state normal
4411 $ctext delete $pos "$pos lineend"
4414 foreach tag [set $var\($id\)] {
4415 lappend tags [list $tag $id]
4418 if {[llength $tags] > $maxrefs} {
4419 $ctext insert $pos "many ([llength $tags])"
4421 set tags [lsort -index 0 -decreasing $tags]
4424 set id [lindex $ti 1]
4427 $ctext tag delete $lk
4428 $ctext insert $pos $sep
4429 $ctext insert $pos [lindex $ti 0] $lk
4434 $ctext conf -state disabled
4435 return [llength $tags]
4438 # called when we have finished computing the nearby tags
4439 proc dispneartags {delay} {
4440 global selectedline currentid showneartags tagphase
4442 if {![info exists selectedline] || !$showneartags} return
4443 after cancel dispnexttag
4445 after 200 dispnexttag
4448 after idle dispnexttag
4453 proc dispnexttag {} {
4454 global selectedline currentid showneartags tagphase ctext
4456 if {![info exists selectedline] || !$showneartags} return
4457 switch -- $tagphase {
4459 set dtags [desctags $currentid]
4461 appendrefs precedes $dtags idtags
4465 set atags [anctags $currentid]
4467 appendrefs follows $atags idtags
4471 set dheads [descheads $currentid]
4472 if {$dheads ne {}} {
4473 if {[appendrefs branch $dheads idheads] > 1
4474 && [$ctext get "branch -3c"] eq "h"} {
4475 # turn "Branch" into "Branches"
4476 $ctext conf -state normal
4477 $ctext insert "branch -2c" "es"
4478 $ctext conf -state disabled
4483 if {[incr tagphase] <= 2} {
4484 after idle dispnexttag
4488 proc selectline {l isnew} {
4489 global canv canv2 canv3 ctext commitinfo selectedline
4490 global displayorder linehtag linentag linedtag
4491 global canvy0 linespc parentlist children curview
4492 global currentid sha1entry
4493 global commentend idtags linknum
4494 global mergemax numcommits pending_select
4495 global cmitmode showneartags allcommits
4497 catch {unset pending_select}
4500 cancel_next_highlight
4502 if {$l < 0 || $l >= $numcommits} return
4503 set y [expr {$canvy0 + $l * $linespc}]
4504 set ymax [lindex [$canv cget -scrollregion] 3]
4505 set ytop [expr {$y - $linespc - 1}]
4506 set ybot [expr {$y + $linespc + 1}]
4507 set wnow [$canv yview]
4508 set wtop [expr {[lindex $wnow 0] * $ymax}]
4509 set wbot [expr {[lindex $wnow 1] * $ymax}]
4510 set wh [expr {$wbot - $wtop}]
4512 if {$ytop < $wtop} {
4513 if {$ybot < $wtop} {
4514 set newtop [expr {$y - $wh / 2.0}]
4517 if {$newtop > $wtop - $linespc} {
4518 set newtop [expr {$wtop - $linespc}]
4521 } elseif {$ybot > $wbot} {
4522 if {$ytop > $wbot} {
4523 set newtop [expr {$y - $wh / 2.0}]
4525 set newtop [expr {$ybot - $wh}]
4526 if {$newtop < $wtop + $linespc} {
4527 set newtop [expr {$wtop + $linespc}]
4531 if {$newtop != $wtop} {
4535 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4539 if {![info exists linehtag($l)]} return
4541 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4542 -tags secsel -fill [$canv cget -selectbackground]]
4544 $canv2 delete secsel
4545 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4546 -tags secsel -fill [$canv2 cget -selectbackground]]
4548 $canv3 delete secsel
4549 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4550 -tags secsel -fill [$canv3 cget -selectbackground]]
4554 addtohistory [list selectline $l 0]
4559 set id [lindex $displayorder $l]
4561 $sha1entry delete 0 end
4562 $sha1entry insert 0 $id
4563 $sha1entry selection from 0
4564 $sha1entry selection to end
4567 $ctext conf -state normal
4570 set info $commitinfo($id)
4571 set date [formatdate [lindex $info 2]]
4572 $ctext insert end "Author: [lindex $info 1] $date\n"
4573 set date [formatdate [lindex $info 4]]
4574 $ctext insert end "Committer: [lindex $info 3] $date\n"
4575 if {[info exists idtags($id)]} {
4576 $ctext insert end "Tags:"
4577 foreach tag $idtags($id) {
4578 $ctext insert end " $tag"
4580 $ctext insert end "\n"
4584 set olds [lindex $parentlist $l]
4585 if {[llength $olds] > 1} {
4588 if {$np >= $mergemax} {
4593 $ctext insert end "Parent: " $tag
4594 appendwithlinks [commit_descriptor $p] {}
4599 append headers "Parent: [commit_descriptor $p]"
4603 foreach c $children($curview,$id) {
4604 append headers "Child: [commit_descriptor $c]"
4607 # make anything that looks like a SHA1 ID be a clickable link
4608 appendwithlinks $headers {}
4609 if {$showneartags} {
4610 if {![info exists allcommits]} {
4613 $ctext insert end "Branch: "
4614 $ctext mark set branch "end -1c"
4615 $ctext mark gravity branch left
4616 $ctext insert end "\nFollows: "
4617 $ctext mark set follows "end -1c"
4618 $ctext mark gravity follows left
4619 $ctext insert end "\nPrecedes: "
4620 $ctext mark set precedes "end -1c"
4621 $ctext mark gravity precedes left
4622 $ctext insert end "\n"
4625 $ctext insert end "\n"
4626 set comment [lindex $info 5]
4627 if {[string first "\r" $comment] >= 0} {
4628 set comment [string map {"\r" "\n "} $comment]
4630 appendwithlinks $comment {comment}
4632 $ctext tag remove found 1.0 end
4633 $ctext conf -state disabled
4634 set commentend [$ctext index "end - 1c"]
4636 init_flist "Comments"
4637 if {$cmitmode eq "tree"} {
4639 } elseif {[llength $olds] <= 1} {
4646 proc selfirstline {} {
4651 proc sellastline {} {
4654 set l [expr {$numcommits - 1}]
4658 proc selnextline {dir} {
4661 if {![info exists selectedline]} return
4662 set l [expr {$selectedline + $dir}]
4667 proc selnextpage {dir} {
4668 global canv linespc selectedline numcommits
4670 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4674 allcanvs yview scroll [expr {$dir * $lpp}] units
4676 if {![info exists selectedline]} return
4677 set l [expr {$selectedline + $dir * $lpp}]
4680 } elseif {$l >= $numcommits} {
4681 set l [expr $numcommits - 1]
4687 proc unselectline {} {
4688 global selectedline currentid
4690 catch {unset selectedline}
4691 catch {unset currentid}
4692 allcanvs delete secsel
4694 cancel_next_highlight
4697 proc reselectline {} {
4700 if {[info exists selectedline]} {
4701 selectline $selectedline 0
4705 proc addtohistory {cmd} {
4706 global history historyindex curview
4708 set elt [list $curview $cmd]
4709 if {$historyindex > 0
4710 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4714 if {$historyindex < [llength $history]} {
4715 set history [lreplace $history $historyindex end $elt]
4717 lappend history $elt
4720 if {$historyindex > 1} {
4721 .tf.bar.leftbut conf -state normal
4723 .tf.bar.leftbut conf -state disabled
4725 .tf.bar.rightbut conf -state disabled
4731 set view [lindex $elt 0]
4732 set cmd [lindex $elt 1]
4733 if {$curview != $view} {
4740 global history historyindex
4743 if {$historyindex > 1} {
4744 incr historyindex -1
4745 godo [lindex $history [expr {$historyindex - 1}]]
4746 .tf.bar.rightbut conf -state normal
4748 if {$historyindex <= 1} {
4749 .tf.bar.leftbut conf -state disabled
4754 global history historyindex
4757 if {$historyindex < [llength $history]} {
4758 set cmd [lindex $history $historyindex]
4761 .tf.bar.leftbut conf -state normal
4763 if {$historyindex >= [llength $history]} {
4764 .tf.bar.rightbut conf -state disabled
4769 global treefilelist treeidlist diffids diffmergeid treepending
4770 global nullid nullid2
4773 catch {unset diffmergeid}
4774 if {![info exists treefilelist($id)]} {
4775 if {![info exists treepending]} {
4776 if {$id eq $nullid} {
4777 set cmd [list | git ls-files]
4778 } elseif {$id eq $nullid2} {
4779 set cmd [list | git ls-files --stage -t]
4781 set cmd [list | git ls-tree -r $id]
4783 if {[catch {set gtf [open $cmd r]}]} {
4787 set treefilelist($id) {}
4788 set treeidlist($id) {}
4789 fconfigure $gtf -blocking 0
4790 filerun $gtf [list gettreeline $gtf $id]
4797 proc gettreeline {gtf id} {
4798 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4801 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4802 if {$diffids eq $nullid} {
4805 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4806 set i [string first "\t" $line]
4807 if {$i < 0} continue
4808 set sha1 [lindex $line 2]
4809 set fname [string range $line [expr {$i+1}] end]
4810 if {[string index $fname 0] eq "\""} {
4811 set fname [lindex $fname 0]
4813 lappend treeidlist($id) $sha1
4815 lappend treefilelist($id) $fname
4818 return [expr {$nl >= 1000? 2: 1}]
4822 if {$cmitmode ne "tree"} {
4823 if {![info exists diffmergeid]} {
4824 gettreediffs $diffids
4826 } elseif {$id ne $diffids} {
4835 global treefilelist treeidlist diffids nullid nullid2
4836 global ctext commentend
4838 set i [lsearch -exact $treefilelist($diffids) $f]
4840 puts "oops, $f not in list for id $diffids"
4843 if {$diffids eq $nullid} {
4844 if {[catch {set bf [open $f r]} err]} {
4845 puts "oops, can't read $f: $err"
4849 set blob [lindex $treeidlist($diffids) $i]
4850 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4851 puts "oops, error reading blob $blob: $err"
4855 fconfigure $bf -blocking 0
4856 filerun $bf [list getblobline $bf $diffids]
4857 $ctext config -state normal
4858 clear_ctext $commentend
4859 $ctext insert end "\n"
4860 $ctext insert end "$f\n" filesep
4861 $ctext config -state disabled
4862 $ctext yview $commentend
4865 proc getblobline {bf id} {
4866 global diffids cmitmode ctext
4868 if {$id ne $diffids || $cmitmode ne "tree"} {
4872 $ctext config -state normal
4874 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4875 $ctext insert end "$line\n"
4878 # delete last newline
4879 $ctext delete "end - 2c" "end - 1c"
4883 $ctext config -state disabled
4884 return [expr {$nl >= 1000? 2: 1}]
4887 proc mergediff {id l} {
4888 global diffmergeid diffopts mdifffd
4894 # this doesn't seem to actually affect anything...
4895 set env(GIT_DIFF_OPTS) $diffopts
4896 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4897 if {[catch {set mdf [open $cmd r]} err]} {
4898 error_popup "Error getting merge diffs: $err"
4901 fconfigure $mdf -blocking 0
4902 set mdifffd($id) $mdf
4903 set np [llength [lindex $parentlist $l]]
4904 filerun $mdf [list getmergediffline $mdf $id $np]
4907 proc getmergediffline {mdf id np} {
4908 global diffmergeid ctext cflist mergemax
4909 global difffilestart mdifffd
4911 $ctext conf -state normal
4913 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4914 if {![info exists diffmergeid] || $id != $diffmergeid
4915 || $mdf != $mdifffd($id)} {
4919 if {[regexp {^diff --cc (.*)} $line match fname]} {
4920 # start of a new file
4921 $ctext insert end "\n"
4922 set here [$ctext index "end - 1c"]
4923 lappend difffilestart $here
4924 add_flist [list $fname]
4925 set l [expr {(78 - [string length $fname]) / 2}]
4926 set pad [string range "----------------------------------------" 1 $l]
4927 $ctext insert end "$pad $fname $pad\n" filesep
4928 } elseif {[regexp {^@@} $line]} {
4929 $ctext insert end "$line\n" hunksep
4930 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4933 # parse the prefix - one ' ', '-' or '+' for each parent
4938 for {set j 0} {$j < $np} {incr j} {
4939 set c [string range $line $j $j]
4942 } elseif {$c == "-"} {
4944 } elseif {$c == "+"} {
4953 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4954 # line doesn't appear in result, parents in $minuses have the line
4955 set num [lindex $minuses 0]
4956 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4957 # line appears in result, parents in $pluses don't have the line
4958 lappend tags mresult
4959 set num [lindex $spaces 0]
4962 if {$num >= $mergemax} {
4967 $ctext insert end "$line\n" $tags
4970 $ctext conf -state disabled
4975 return [expr {$nr >= 1000? 2: 1}]
4978 proc startdiff {ids} {
4979 global treediffs diffids treepending diffmergeid nullid nullid2
4982 catch {unset diffmergeid}
4983 if {![info exists treediffs($ids)] ||
4984 [lsearch -exact $ids $nullid] >= 0 ||
4985 [lsearch -exact $ids $nullid2] >= 0} {
4986 if {![info exists treepending]} {
4994 proc addtocflist {ids} {
4995 global treediffs cflist
4996 add_flist $treediffs($ids)
5000 proc diffcmd {ids flags} {
5001 global nullid nullid2
5003 set i [lsearch -exact $ids $nullid]
5004 set j [lsearch -exact $ids $nullid2]
5006 if {[llength $ids] > 1 && $j < 0} {
5007 # comparing working directory with some specific revision
5008 set cmd [concat | git diff-index $flags]
5010 lappend cmd -R [lindex $ids 1]
5012 lappend cmd [lindex $ids 0]
5015 # comparing working directory with index
5016 set cmd [concat | git diff-files $flags]
5021 } elseif {$j >= 0} {
5022 set cmd [concat | git diff-index --cached $flags]
5023 if {[llength $ids] > 1} {
5024 # comparing index with specific revision
5026 lappend cmd -R [lindex $ids 1]
5028 lappend cmd [lindex $ids 0]
5031 # comparing index with HEAD
5035 set cmd [concat | git diff-tree -r $flags $ids]
5040 proc gettreediffs {ids} {
5041 global treediff treepending
5043 set treepending $ids
5045 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5046 fconfigure $gdtf -blocking 0
5047 filerun $gdtf [list gettreediffline $gdtf $ids]
5050 proc gettreediffline {gdtf ids} {
5051 global treediff treediffs treepending diffids diffmergeid
5055 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5056 set i [string first "\t" $line]
5058 set file [string range $line [expr {$i+1}] end]
5059 if {[string index $file 0] eq "\""} {
5060 set file [lindex $file 0]
5062 lappend treediff $file
5066 return [expr {$nr >= 1000? 2: 1}]
5069 set treediffs($ids) $treediff
5071 if {$cmitmode eq "tree"} {
5073 } elseif {$ids != $diffids} {
5074 if {![info exists diffmergeid]} {
5075 gettreediffs $diffids
5083 # empty string or positive integer
5084 proc diffcontextvalidate {v} {
5085 return [regexp {^(|[1-9][0-9]*)$} $v]
5088 proc diffcontextchange {n1 n2 op} {
5089 global diffcontextstring diffcontext
5091 if {[string is integer -strict $diffcontextstring]} {
5092 if {$diffcontextstring > 0} {
5093 set diffcontext $diffcontextstring
5099 proc getblobdiffs {ids} {
5100 global diffopts blobdifffd diffids env
5101 global diffinhdr treediffs
5104 set env(GIT_DIFF_OPTS) $diffopts
5105 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5106 puts "error getting diffs: $err"
5110 fconfigure $bdf -blocking 0
5111 set blobdifffd($ids) $bdf
5112 filerun $bdf [list getblobdiffline $bdf $diffids]
5115 proc setinlist {var i val} {
5118 while {[llength [set $var]] < $i} {
5121 if {[llength [set $var]] == $i} {
5128 proc makediffhdr {fname ids} {
5129 global ctext curdiffstart treediffs
5131 set i [lsearch -exact $treediffs($ids) $fname]
5133 setinlist difffilestart $i $curdiffstart
5135 set l [expr {(78 - [string length $fname]) / 2}]
5136 set pad [string range "----------------------------------------" 1 $l]
5137 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5140 proc getblobdiffline {bdf ids} {
5141 global diffids blobdifffd ctext curdiffstart
5142 global diffnexthead diffnextnote difffilestart
5143 global diffinhdr treediffs
5146 $ctext conf -state normal
5147 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5148 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5152 if {![string compare -length 11 "diff --git " $line]} {
5153 # trim off "diff --git "
5154 set line [string range $line 11 end]
5156 # start of a new file
5157 $ctext insert end "\n"
5158 set curdiffstart [$ctext index "end - 1c"]
5159 $ctext insert end "\n" filesep
5160 # If the name hasn't changed the length will be odd,
5161 # the middle char will be a space, and the two bits either
5162 # side will be a/name and b/name, or "a/name" and "b/name".
5163 # If the name has changed we'll get "rename from" and
5164 # "rename to" or "copy from" and "copy to" lines following this,
5165 # and we'll use them to get the filenames.
5166 # This complexity is necessary because spaces in the filename(s)
5167 # don't get escaped.
5168 set l [string length $line]
5169 set i [expr {$l / 2}]
5170 if {!(($l & 1) && [string index $line $i] eq " " &&
5171 [string range $line 2 [expr {$i - 1}]] eq \
5172 [string range $line [expr {$i + 3}] end])} {
5175 # unescape if quoted and chop off the a/ from the front
5176 if {[string index $line 0] eq "\""} {
5177 set fname [string range [lindex $line 0] 2 end]
5179 set fname [string range $line 2 [expr {$i - 1}]]
5181 makediffhdr $fname $ids
5183 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5184 $line match f1l f1c f2l f2c rest]} {
5185 $ctext insert end "$line\n" hunksep
5188 } elseif {$diffinhdr} {
5189 if {![string compare -length 12 "rename from " $line] ||
5190 ![string compare -length 10 "copy from " $line]} {
5191 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5192 if {[string index $fname 0] eq "\""} {
5193 set fname [lindex $fname 0]
5195 set i [lsearch -exact $treediffs($ids) $fname]
5197 setinlist difffilestart $i $curdiffstart
5199 } elseif {![string compare -length 10 $line "rename to "] ||
5200 ![string compare -length 8 $line "copy to "]} {
5201 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5202 if {[string index $fname 0] eq "\""} {
5203 set fname [lindex $fname 0]
5205 makediffhdr $fname $ids
5206 } elseif {[string compare -length 3 $line "---"] == 0} {
5209 } elseif {[string compare -length 3 $line "+++"] == 0} {
5213 $ctext insert end "$line\n" filesep
5216 set x [string range $line 0 0]
5217 if {$x == "-" || $x == "+"} {
5218 set tag [expr {$x == "+"}]
5219 $ctext insert end "$line\n" d$tag
5220 } elseif {$x == " "} {
5221 $ctext insert end "$line\n"
5223 # "\ No newline at end of file",
5224 # or something else we don't recognize
5225 $ctext insert end "$line\n" hunksep
5229 $ctext conf -state disabled
5234 return [expr {$nr >= 1000? 2: 1}]
5237 proc changediffdisp {} {
5238 global ctext diffelide
5240 $ctext tag conf d0 -elide [lindex $diffelide 0]
5241 $ctext tag conf d1 -elide [lindex $diffelide 1]
5245 global difffilestart ctext
5246 set prev [lindex $difffilestart 0]
5247 set here [$ctext index @0,0]
5248 foreach loc $difffilestart {
5249 if {[$ctext compare $loc >= $here]} {
5259 global difffilestart ctext
5260 set here [$ctext index @0,0]
5261 foreach loc $difffilestart {
5262 if {[$ctext compare $loc > $here]} {
5269 proc clear_ctext {{first 1.0}} {
5270 global ctext smarktop smarkbot
5273 set l [lindex [split $first .] 0]
5274 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5277 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5280 $ctext delete $first end
5281 if {$first eq "1.0"} {
5282 catch {unset pendinglinks}
5286 proc incrsearch {name ix op} {
5287 global ctext searchstring searchdirn
5289 $ctext tag remove found 1.0 end
5290 if {[catch {$ctext index anchor}]} {
5291 # no anchor set, use start of selection, or of visible area
5292 set sel [$ctext tag ranges sel]
5294 $ctext mark set anchor [lindex $sel 0]
5295 } elseif {$searchdirn eq "-forwards"} {
5296 $ctext mark set anchor @0,0
5298 $ctext mark set anchor @0,[winfo height $ctext]
5301 if {$searchstring ne {}} {
5302 set here [$ctext search $searchdirn -- $searchstring anchor]
5311 global sstring ctext searchstring searchdirn
5314 $sstring icursor end
5315 set searchdirn -forwards
5316 if {$searchstring ne {}} {
5317 set sel [$ctext tag ranges sel]
5319 set start "[lindex $sel 0] + 1c"
5320 } elseif {[catch {set start [$ctext index anchor]}]} {
5323 set match [$ctext search -count mlen -- $searchstring $start]
5324 $ctext tag remove sel 1.0 end
5330 set mend "$match + $mlen c"
5331 $ctext tag add sel $match $mend
5332 $ctext mark unset anchor
5336 proc dosearchback {} {
5337 global sstring ctext searchstring searchdirn
5340 $sstring icursor end
5341 set searchdirn -backwards
5342 if {$searchstring ne {}} {
5343 set sel [$ctext tag ranges sel]
5345 set start [lindex $sel 0]
5346 } elseif {[catch {set start [$ctext index anchor]}]} {
5347 set start @0,[winfo height $ctext]
5349 set match [$ctext search -backwards -count ml -- $searchstring $start]
5350 $ctext tag remove sel 1.0 end
5356 set mend "$match + $ml c"
5357 $ctext tag add sel $match $mend
5358 $ctext mark unset anchor
5362 proc searchmark {first last} {
5363 global ctext searchstring
5367 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5368 if {$match eq {}} break
5369 set mend "$match + $mlen c"
5370 $ctext tag add found $match $mend
5374 proc searchmarkvisible {doall} {
5375 global ctext smarktop smarkbot
5377 set topline [lindex [split [$ctext index @0,0] .] 0]
5378 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5379 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5380 # no overlap with previous
5381 searchmark $topline $botline
5382 set smarktop $topline
5383 set smarkbot $botline
5385 if {$topline < $smarktop} {
5386 searchmark $topline [expr {$smarktop-1}]
5387 set smarktop $topline
5389 if {$botline > $smarkbot} {
5390 searchmark [expr {$smarkbot+1}] $botline
5391 set smarkbot $botline
5396 proc scrolltext {f0 f1} {
5399 .bleft.sb set $f0 $f1
5400 if {$searchstring ne {}} {
5406 global linespc charspc canvx0 canvy0 mainfont
5407 global xspc1 xspc2 lthickness
5409 set linespc [font metrics $mainfont -linespace]
5410 set charspc [font measure $mainfont "m"]
5411 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5412 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5413 set lthickness [expr {int($linespc / 9) + 1}]
5414 set xspc1(0) $linespc
5422 set ymax [lindex [$canv cget -scrollregion] 3]
5423 if {$ymax eq {} || $ymax == 0} return
5424 set span [$canv yview]
5427 allcanvs yview moveto [lindex $span 0]
5429 if {[info exists selectedline]} {
5430 selectline $selectedline 0
5431 allcanvs yview moveto [lindex $span 0]
5435 proc incrfont {inc} {
5436 global mainfont textfont ctext canv phase cflist showrefstop
5437 global charspc tabstop
5438 global stopped entries
5440 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5441 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5443 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5444 $cflist conf -font $textfont
5445 $ctext tag conf filesep -font [concat $textfont bold]
5446 foreach e $entries {
5447 $e conf -font $mainfont
5449 if {$phase eq "getcommits"} {
5450 $canv itemconf textitems -font $mainfont
5452 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5453 $showrefstop.list conf -font $mainfont
5459 global sha1entry sha1string
5460 if {[string length $sha1string] == 40} {
5461 $sha1entry delete 0 end
5465 proc sha1change {n1 n2 op} {
5466 global sha1string currentid sha1but
5467 if {$sha1string == {}
5468 || ([info exists currentid] && $sha1string == $currentid)} {
5473 if {[$sha1but cget -state] == $state} return
5474 if {$state == "normal"} {
5475 $sha1but conf -state normal -relief raised -text "Goto: "
5477 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5481 proc gotocommit {} {
5482 global sha1string currentid commitrow tagids headids
5483 global displayorder numcommits curview
5485 if {$sha1string == {}
5486 || ([info exists currentid] && $sha1string == $currentid)} return
5487 if {[info exists tagids($sha1string)]} {
5488 set id $tagids($sha1string)
5489 } elseif {[info exists headids($sha1string)]} {
5490 set id $headids($sha1string)
5492 set id [string tolower $sha1string]
5493 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5495 foreach i $displayorder {
5496 if {[string match $id* $i]} {
5500 if {$matches ne {}} {
5501 if {[llength $matches] > 1} {
5502 error_popup "Short SHA1 id $id is ambiguous"
5505 set id [lindex $matches 0]
5509 if {[info exists commitrow($curview,$id)]} {
5510 selectline $commitrow($curview,$id) 1
5513 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5518 error_popup "$type $sha1string is not known"
5521 proc lineenter {x y id} {
5522 global hoverx hovery hoverid hovertimer
5523 global commitinfo canv
5525 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5529 if {[info exists hovertimer]} {
5530 after cancel $hovertimer
5532 set hovertimer [after 500 linehover]
5536 proc linemotion {x y id} {
5537 global hoverx hovery hoverid hovertimer
5539 if {[info exists hoverid] && $id == $hoverid} {
5542 if {[info exists hovertimer]} {
5543 after cancel $hovertimer
5545 set hovertimer [after 500 linehover]
5549 proc lineleave {id} {
5550 global hoverid hovertimer canv
5552 if {[info exists hoverid] && $id == $hoverid} {
5554 if {[info exists hovertimer]} {
5555 after cancel $hovertimer
5563 global hoverx hovery hoverid hovertimer
5564 global canv linespc lthickness
5565 global commitinfo mainfont
5567 set text [lindex $commitinfo($hoverid) 0]
5568 set ymax [lindex [$canv cget -scrollregion] 3]
5569 if {$ymax == {}} return
5570 set yfrac [lindex [$canv yview] 0]
5571 set x [expr {$hoverx + 2 * $linespc}]
5572 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5573 set x0 [expr {$x - 2 * $lthickness}]
5574 set y0 [expr {$y - 2 * $lthickness}]
5575 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5576 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5577 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5578 -fill \#ffff80 -outline black -width 1 -tags hover]
5580 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5585 proc clickisonarrow {id y} {
5588 set ranges [rowranges $id]
5589 set thresh [expr {2 * $lthickness + 6}]
5590 set n [expr {[llength $ranges] - 1}]
5591 for {set i 1} {$i < $n} {incr i} {
5592 set row [lindex $ranges $i]
5593 if {abs([yc $row] - $y) < $thresh} {
5600 proc arrowjump {id n y} {
5603 # 1 <-> 2, 3 <-> 4, etc...
5604 set n [expr {(($n - 1) ^ 1) + 1}]
5605 set row [lindex [rowranges $id] $n]
5607 set ymax [lindex [$canv cget -scrollregion] 3]
5608 if {$ymax eq {} || $ymax <= 0} return
5609 set view [$canv yview]
5610 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5611 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5615 allcanvs yview moveto $yfrac
5618 proc lineclick {x y id isnew} {
5619 global ctext commitinfo children canv thickerline curview
5621 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5626 # draw this line thicker than normal
5630 set ymax [lindex [$canv cget -scrollregion] 3]
5631 if {$ymax eq {}} return
5632 set yfrac [lindex [$canv yview] 0]
5633 set y [expr {$y + $yfrac * $ymax}]
5635 set dirn [clickisonarrow $id $y]
5637 arrowjump $id $dirn $y
5642 addtohistory [list lineclick $x $y $id 0]
5644 # fill the details pane with info about this line
5645 $ctext conf -state normal
5647 $ctext insert end "Parent:\t"
5648 $ctext insert end $id link0
5650 set info $commitinfo($id)
5651 $ctext insert end "\n\t[lindex $info 0]\n"
5652 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5653 set date [formatdate [lindex $info 2]]
5654 $ctext insert end "\tDate:\t$date\n"
5655 set kids $children($curview,$id)
5657 $ctext insert end "\nChildren:"
5659 foreach child $kids {
5661 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5662 set info $commitinfo($child)
5663 $ctext insert end "\n\t"
5664 $ctext insert end $child link$i
5665 setlink $child link$i
5666 $ctext insert end "\n\t[lindex $info 0]"
5667 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5668 set date [formatdate [lindex $info 2]]
5669 $ctext insert end "\n\tDate:\t$date\n"
5672 $ctext conf -state disabled
5676 proc normalline {} {
5678 if {[info exists thickerline]} {
5686 global commitrow curview
5687 if {[info exists commitrow($curview,$id)]} {
5688 selectline $commitrow($curview,$id) 1
5694 if {![info exists startmstime]} {
5695 set startmstime [clock clicks -milliseconds]
5697 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5700 proc rowmenu {x y id} {
5701 global rowctxmenu commitrow selectedline rowmenuid curview
5702 global nullid nullid2 fakerowmenu mainhead
5705 if {![info exists selectedline]
5706 || $commitrow($curview,$id) eq $selectedline} {
5711 if {$id ne $nullid && $id ne $nullid2} {
5712 set menu $rowctxmenu
5713 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5715 set menu $fakerowmenu
5717 $menu entryconfigure "Diff this*" -state $state
5718 $menu entryconfigure "Diff selected*" -state $state
5719 $menu entryconfigure "Make patch" -state $state
5720 tk_popup $menu $x $y
5723 proc diffvssel {dirn} {
5724 global rowmenuid selectedline displayorder
5726 if {![info exists selectedline]} return
5728 set oldid [lindex $displayorder $selectedline]
5729 set newid $rowmenuid
5731 set oldid $rowmenuid
5732 set newid [lindex $displayorder $selectedline]
5734 addtohistory [list doseldiff $oldid $newid]
5735 doseldiff $oldid $newid
5738 proc doseldiff {oldid newid} {
5742 $ctext conf -state normal
5745 $ctext insert end "From "
5746 $ctext insert end $oldid link0
5747 setlink $oldid link0
5748 $ctext insert end "\n "
5749 $ctext insert end [lindex $commitinfo($oldid) 0]
5750 $ctext insert end "\n\nTo "
5751 $ctext insert end $newid link1
5752 setlink $newid link1
5753 $ctext insert end "\n "
5754 $ctext insert end [lindex $commitinfo($newid) 0]
5755 $ctext insert end "\n"
5756 $ctext conf -state disabled
5757 $ctext tag remove found 1.0 end
5758 startdiff [list $oldid $newid]
5762 global rowmenuid currentid commitinfo patchtop patchnum
5764 if {![info exists currentid]} return
5765 set oldid $currentid
5766 set oldhead [lindex $commitinfo($oldid) 0]
5767 set newid $rowmenuid
5768 set newhead [lindex $commitinfo($newid) 0]
5771 catch {destroy $top}
5773 label $top.title -text "Generate patch"
5774 grid $top.title - -pady 10
5775 label $top.from -text "From:"
5776 entry $top.fromsha1 -width 40 -relief flat
5777 $top.fromsha1 insert 0 $oldid
5778 $top.fromsha1 conf -state readonly
5779 grid $top.from $top.fromsha1 -sticky w
5780 entry $top.fromhead -width 60 -relief flat
5781 $top.fromhead insert 0 $oldhead
5782 $top.fromhead conf -state readonly
5783 grid x $top.fromhead -sticky w
5784 label $top.to -text "To:"
5785 entry $top.tosha1 -width 40 -relief flat
5786 $top.tosha1 insert 0 $newid
5787 $top.tosha1 conf -state readonly
5788 grid $top.to $top.tosha1 -sticky w
5789 entry $top.tohead -width 60 -relief flat
5790 $top.tohead insert 0 $newhead
5791 $top.tohead conf -state readonly
5792 grid x $top.tohead -sticky w
5793 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5794 grid $top.rev x -pady 10
5795 label $top.flab -text "Output file:"
5796 entry $top.fname -width 60
5797 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5799 grid $top.flab $top.fname -sticky w
5801 button $top.buts.gen -text "Generate" -command mkpatchgo
5802 button $top.buts.can -text "Cancel" -command mkpatchcan
5803 grid $top.buts.gen $top.buts.can
5804 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5805 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5806 grid $top.buts - -pady 10 -sticky ew
5810 proc mkpatchrev {} {
5813 set oldid [$patchtop.fromsha1 get]
5814 set oldhead [$patchtop.fromhead get]
5815 set newid [$patchtop.tosha1 get]
5816 set newhead [$patchtop.tohead get]
5817 foreach e [list fromsha1 fromhead tosha1 tohead] \
5818 v [list $newid $newhead $oldid $oldhead] {
5819 $patchtop.$e conf -state normal
5820 $patchtop.$e delete 0 end
5821 $patchtop.$e insert 0 $v
5822 $patchtop.$e conf -state readonly
5827 global patchtop nullid nullid2
5829 set oldid [$patchtop.fromsha1 get]
5830 set newid [$patchtop.tosha1 get]
5831 set fname [$patchtop.fname get]
5832 set cmd [diffcmd [list $oldid $newid] -p]
5833 lappend cmd >$fname &
5834 if {[catch {eval exec $cmd} err]} {
5835 error_popup "Error creating patch: $err"
5837 catch {destroy $patchtop}
5841 proc mkpatchcan {} {
5844 catch {destroy $patchtop}
5849 global rowmenuid mktagtop commitinfo
5853 catch {destroy $top}
5855 label $top.title -text "Create tag"
5856 grid $top.title - -pady 10
5857 label $top.id -text "ID:"
5858 entry $top.sha1 -width 40 -relief flat
5859 $top.sha1 insert 0 $rowmenuid
5860 $top.sha1 conf -state readonly
5861 grid $top.id $top.sha1 -sticky w
5862 entry $top.head -width 60 -relief flat
5863 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5864 $top.head conf -state readonly
5865 grid x $top.head -sticky w
5866 label $top.tlab -text "Tag name:"
5867 entry $top.tag -width 60
5868 grid $top.tlab $top.tag -sticky w
5870 button $top.buts.gen -text "Create" -command mktaggo
5871 button $top.buts.can -text "Cancel" -command mktagcan
5872 grid $top.buts.gen $top.buts.can
5873 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5874 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5875 grid $top.buts - -pady 10 -sticky ew
5880 global mktagtop env tagids idtags
5882 set id [$mktagtop.sha1 get]
5883 set tag [$mktagtop.tag get]
5885 error_popup "No tag name specified"
5888 if {[info exists tagids($tag)]} {
5889 error_popup "Tag \"$tag\" already exists"
5894 set fname [file join $dir "refs/tags" $tag]
5895 set f [open $fname w]
5899 error_popup "Error creating tag: $err"
5903 set tagids($tag) $id
5904 lappend idtags($id) $tag
5911 proc redrawtags {id} {
5912 global canv linehtag commitrow idpos selectedline curview
5913 global mainfont canvxmax iddrawn
5915 if {![info exists commitrow($curview,$id)]} return
5916 if {![info exists iddrawn($id)]} return
5917 drawcommits $commitrow($curview,$id)
5918 $canv delete tag.$id
5919 set xt [eval drawtags $id $idpos($id)]
5920 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5921 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5922 set xr [expr {$xt + [font measure $mainfont $text]}]
5923 if {$xr > $canvxmax} {
5927 if {[info exists selectedline]
5928 && $selectedline == $commitrow($curview,$id)} {
5929 selectline $selectedline 0
5936 catch {destroy $mktagtop}
5945 proc writecommit {} {
5946 global rowmenuid wrcomtop commitinfo wrcomcmd
5948 set top .writecommit
5950 catch {destroy $top}
5952 label $top.title -text "Write commit to file"
5953 grid $top.title - -pady 10
5954 label $top.id -text "ID:"
5955 entry $top.sha1 -width 40 -relief flat
5956 $top.sha1 insert 0 $rowmenuid
5957 $top.sha1 conf -state readonly
5958 grid $top.id $top.sha1 -sticky w
5959 entry $top.head -width 60 -relief flat
5960 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5961 $top.head conf -state readonly
5962 grid x $top.head -sticky w
5963 label $top.clab -text "Command:"
5964 entry $top.cmd -width 60 -textvariable wrcomcmd
5965 grid $top.clab $top.cmd -sticky w -pady 10
5966 label $top.flab -text "Output file:"
5967 entry $top.fname -width 60
5968 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5969 grid $top.flab $top.fname -sticky w
5971 button $top.buts.gen -text "Write" -command wrcomgo
5972 button $top.buts.can -text "Cancel" -command wrcomcan
5973 grid $top.buts.gen $top.buts.can
5974 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5975 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5976 grid $top.buts - -pady 10 -sticky ew
5983 set id [$wrcomtop.sha1 get]
5984 set cmd "echo $id | [$wrcomtop.cmd get]"
5985 set fname [$wrcomtop.fname get]
5986 if {[catch {exec sh -c $cmd >$fname &} err]} {
5987 error_popup "Error writing commit: $err"
5989 catch {destroy $wrcomtop}
5996 catch {destroy $wrcomtop}
6001 global rowmenuid mkbrtop
6004 catch {destroy $top}
6006 label $top.title -text "Create new branch"
6007 grid $top.title - -pady 10
6008 label $top.id -text "ID:"
6009 entry $top.sha1 -width 40 -relief flat
6010 $top.sha1 insert 0 $rowmenuid
6011 $top.sha1 conf -state readonly
6012 grid $top.id $top.sha1 -sticky w
6013 label $top.nlab -text "Name:"
6014 entry $top.name -width 40
6015 grid $top.nlab $top.name -sticky w
6017 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6018 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6019 grid $top.buts.go $top.buts.can
6020 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6021 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6022 grid $top.buts - -pady 10 -sticky ew
6027 global headids idheads
6029 set name [$top.name get]
6030 set id [$top.sha1 get]
6032 error_popup "Please specify a name for the new branch"
6035 catch {destroy $top}
6039 exec git branch $name $id
6044 set headids($name) $id
6045 lappend idheads($id) $name
6054 proc cherrypick {} {
6055 global rowmenuid curview commitrow
6058 set oldhead [exec git rev-parse HEAD]
6059 set dheads [descheads $rowmenuid]
6060 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6061 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6062 included in branch $mainhead -- really re-apply it?"]
6067 # Unfortunately git-cherry-pick writes stuff to stderr even when
6068 # no error occurs, and exec takes that as an indication of error...
6069 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6074 set newhead [exec git rev-parse HEAD]
6075 if {$newhead eq $oldhead} {
6077 error_popup "No changes committed"
6080 addnewchild $newhead $oldhead
6081 if {[info exists commitrow($curview,$oldhead)]} {
6082 insertrow $commitrow($curview,$oldhead) $newhead
6083 if {$mainhead ne {}} {
6084 movehead $newhead $mainhead
6085 movedhead $newhead $mainhead
6094 global mainheadid mainhead rowmenuid confirm_ok resettype
6095 global showlocalchanges
6098 set w ".confirmreset"
6101 wm title $w "Confirm reset"
6102 message $w.m -text \
6103 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6104 -justify center -aspect 1000
6105 pack $w.m -side top -fill x -padx 20 -pady 20
6106 frame $w.f -relief sunken -border 2
6107 message $w.f.rt -text "Reset type:" -aspect 1000
6108 grid $w.f.rt -sticky w
6110 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6111 -text "Soft: Leave working tree and index untouched"
6112 grid $w.f.soft -sticky w
6113 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6114 -text "Mixed: Leave working tree untouched, reset index"
6115 grid $w.f.mixed -sticky w
6116 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6117 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6118 grid $w.f.hard -sticky w
6119 pack $w.f -side top -fill x
6120 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6121 pack $w.ok -side left -fill x -padx 20 -pady 20
6122 button $w.cancel -text Cancel -command "destroy $w"
6123 pack $w.cancel -side right -fill x -padx 20 -pady 20
6124 bind $w <Visibility> "grab $w; focus $w"
6126 if {!$confirm_ok} return
6127 if {[catch {set fd [open \
6128 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6132 set w ".resetprogress"
6133 filerun $fd [list readresetstat $fd $w]
6136 wm title $w "Reset progress"
6137 message $w.m -text "Reset in progress, please wait..." \
6138 -justify center -aspect 1000
6139 pack $w.m -side top -fill x -padx 20 -pady 5
6140 canvas $w.c -width 150 -height 20 -bg white
6141 $w.c create rect 0 0 0 20 -fill green -tags rect
6142 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6147 proc readresetstat {fd w} {
6148 global mainhead mainheadid showlocalchanges
6150 if {[gets $fd line] >= 0} {
6151 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6152 set x [expr {($m * 150) / $n}]
6153 $w.c coords rect 0 0 $x 20
6159 if {[catch {close $fd} err]} {
6162 set oldhead $mainheadid
6163 set newhead [exec git rev-parse HEAD]
6164 if {$newhead ne $oldhead} {
6165 movehead $newhead $mainhead
6166 movedhead $newhead $mainhead
6167 set mainheadid $newhead
6171 if {$showlocalchanges} {
6177 # context menu for a head
6178 proc headmenu {x y id head} {
6179 global headmenuid headmenuhead headctxmenu mainhead
6182 set headmenuhead $head
6184 if {$head eq $mainhead} {
6187 $headctxmenu entryconfigure 0 -state $state
6188 $headctxmenu entryconfigure 1 -state $state
6189 tk_popup $headctxmenu $x $y
6193 global headmenuid headmenuhead mainhead headids
6194 global showlocalchanges mainheadid
6196 # check the tree is clean first??
6197 set oldmainhead $mainhead
6202 exec git checkout -q $headmenuhead
6208 set mainhead $headmenuhead
6209 set mainheadid $headmenuid
6210 if {[info exists headids($oldmainhead)]} {
6211 redrawtags $headids($oldmainhead)
6213 redrawtags $headmenuid
6215 if {$showlocalchanges} {
6221 global headmenuid headmenuhead mainhead
6224 set head $headmenuhead
6226 # this check shouldn't be needed any more...
6227 if {$head eq $mainhead} {
6228 error_popup "Cannot delete the currently checked-out branch"
6231 set dheads [descheads $id]
6232 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6233 # the stuff on this branch isn't on any other branch
6234 if {![confirm_popup "The commits on branch $head aren't on any other\
6235 branch.\nReally delete branch $head?"]} return
6239 if {[catch {exec git branch -D $head} err]} {
6244 removehead $id $head
6245 removedhead $id $head
6252 # Display a list of tags and heads
6254 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6255 global bglist fglist uifont reflistfilter reflist maincursor
6258 set showrefstop $top
6259 if {[winfo exists $top]} {
6265 wm title $top "Tags and heads: [file tail [pwd]]"
6266 text $top.list -background $bgcolor -foreground $fgcolor \
6267 -selectbackground $selectbgcolor -font $mainfont \
6268 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6269 -width 30 -height 20 -cursor $maincursor \
6270 -spacing1 1 -spacing3 1 -state disabled
6271 $top.list tag configure highlight -background $selectbgcolor
6272 lappend bglist $top.list
6273 lappend fglist $top.list
6274 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6275 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6276 grid $top.list $top.ysb -sticky nsew
6277 grid $top.xsb x -sticky ew
6279 label $top.f.l -text "Filter: " -font $uifont
6280 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6281 set reflistfilter "*"
6282 trace add variable reflistfilter write reflistfilter_change
6283 pack $top.f.e -side right -fill x -expand 1
6284 pack $top.f.l -side left
6285 grid $top.f - -sticky ew -pady 2
6286 button $top.close -command [list destroy $top] -text "Close" \
6289 grid columnconfigure $top 0 -weight 1
6290 grid rowconfigure $top 0 -weight 1
6291 bind $top.list <1> {break}
6292 bind $top.list <B1-Motion> {break}
6293 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6298 proc sel_reflist {w x y} {
6299 global showrefstop reflist headids tagids otherrefids
6301 if {![winfo exists $showrefstop]} return
6302 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6303 set ref [lindex $reflist [expr {$l-1}]]
6304 set n [lindex $ref 0]
6305 switch -- [lindex $ref 1] {
6306 "H" {selbyid $headids($n)}
6307 "T" {selbyid $tagids($n)}
6308 "o" {selbyid $otherrefids($n)}
6310 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6313 proc unsel_reflist {} {
6316 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6317 $showrefstop.list tag remove highlight 0.0 end
6320 proc reflistfilter_change {n1 n2 op} {
6321 global reflistfilter
6323 after cancel refill_reflist
6324 after 200 refill_reflist
6327 proc refill_reflist {} {
6328 global reflist reflistfilter showrefstop headids tagids otherrefids
6329 global commitrow curview commitinterest
6331 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6333 foreach n [array names headids] {
6334 if {[string match $reflistfilter $n]} {
6335 if {[info exists commitrow($curview,$headids($n))]} {
6336 lappend refs [list $n H]
6338 set commitinterest($headids($n)) {run refill_reflist}
6342 foreach n [array names tagids] {
6343 if {[string match $reflistfilter $n]} {
6344 if {[info exists commitrow($curview,$tagids($n))]} {
6345 lappend refs [list $n T]
6347 set commitinterest($tagids($n)) {run refill_reflist}
6351 foreach n [array names otherrefids] {
6352 if {[string match $reflistfilter $n]} {
6353 if {[info exists commitrow($curview,$otherrefids($n))]} {
6354 lappend refs [list $n o]
6356 set commitinterest($otherrefids($n)) {run refill_reflist}
6360 set refs [lsort -index 0 $refs]
6361 if {$refs eq $reflist} return
6363 # Update the contents of $showrefstop.list according to the
6364 # differences between $reflist (old) and $refs (new)
6365 $showrefstop.list conf -state normal
6366 $showrefstop.list insert end "\n"
6369 while {$i < [llength $reflist] || $j < [llength $refs]} {
6370 if {$i < [llength $reflist]} {
6371 if {$j < [llength $refs]} {
6372 set cmp [string compare [lindex $reflist $i 0] \
6373 [lindex $refs $j 0]]
6375 set cmp [string compare [lindex $reflist $i 1] \
6376 [lindex $refs $j 1]]
6386 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6394 set l [expr {$j + 1}]
6395 $showrefstop.list image create $l.0 -align baseline \
6396 -image reficon-[lindex $refs $j 1] -padx 2
6397 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6403 # delete last newline
6404 $showrefstop.list delete end-2c end-1c
6405 $showrefstop.list conf -state disabled
6408 # Stuff for finding nearby tags
6409 proc getallcommits {} {
6410 global allcommits allids nbmp nextarc seeds
6412 if {![info exists allcommits]} {
6420 set cmd [concat | git rev-list --all --parents]
6424 set fd [open $cmd r]
6425 fconfigure $fd -blocking 0
6428 filerun $fd [list getallclines $fd]
6431 # Since most commits have 1 parent and 1 child, we group strings of
6432 # such commits into "arcs" joining branch/merge points (BMPs), which
6433 # are commits that either don't have 1 parent or don't have 1 child.
6435 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6436 # arcout(id) - outgoing arcs for BMP
6437 # arcids(a) - list of IDs on arc including end but not start
6438 # arcstart(a) - BMP ID at start of arc
6439 # arcend(a) - BMP ID at end of arc
6440 # growing(a) - arc a is still growing
6441 # arctags(a) - IDs out of arcids (excluding end) that have tags
6442 # archeads(a) - IDs out of arcids (excluding end) that have heads
6443 # The start of an arc is at the descendent end, so "incoming" means
6444 # coming from descendents, and "outgoing" means going towards ancestors.
6446 proc getallclines {fd} {
6447 global allids allparents allchildren idtags idheads nextarc nbmp
6448 global arcnos arcids arctags arcout arcend arcstart archeads growing
6449 global seeds allcommits
6452 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6453 set id [lindex $line 0]
6454 if {[info exists allparents($id)]} {
6459 set olds [lrange $line 1 end]
6460 set allparents($id) $olds
6461 if {![info exists allchildren($id)]} {
6462 set allchildren($id) {}
6467 if {[llength $olds] == 1 && [llength $a] == 1} {
6468 lappend arcids($a) $id
6469 if {[info exists idtags($id)]} {
6470 lappend arctags($a) $id
6472 if {[info exists idheads($id)]} {
6473 lappend archeads($a) $id
6475 if {[info exists allparents($olds)]} {
6476 # seen parent already
6477 if {![info exists arcout($olds)]} {
6480 lappend arcids($a) $olds
6481 set arcend($a) $olds
6484 lappend allchildren($olds) $id
6485 lappend arcnos($olds) $a
6490 foreach a $arcnos($id) {
6491 lappend arcids($a) $id
6498 lappend allchildren($p) $id
6499 set a [incr nextarc]
6500 set arcstart($a) $id
6507 if {[info exists allparents($p)]} {
6508 # seen it already, may need to make a new branch
6509 if {![info exists arcout($p)]} {
6512 lappend arcids($a) $p
6516 lappend arcnos($p) $a
6521 global cached_dheads cached_dtags cached_atags
6522 catch {unset cached_dheads}
6523 catch {unset cached_dtags}
6524 catch {unset cached_atags}
6527 return [expr {$nid >= 1000? 2: 1}]
6530 if {[incr allcommits -1] == 0} {
6537 proc recalcarc {a} {
6538 global arctags archeads arcids idtags idheads
6542 foreach id [lrange $arcids($a) 0 end-1] {
6543 if {[info exists idtags($id)]} {
6546 if {[info exists idheads($id)]} {
6551 set archeads($a) $ah
6555 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6556 global arcstart arcend arcout allparents growing
6559 if {[llength $a] != 1} {
6560 puts "oops splitarc called but [llength $a] arcs already"
6564 set i [lsearch -exact $arcids($a) $p]
6566 puts "oops splitarc $p not in arc $a"
6569 set na [incr nextarc]
6570 if {[info exists arcend($a)]} {
6571 set arcend($na) $arcend($a)
6573 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6574 set j [lsearch -exact $arcnos($l) $a]
6575 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6577 set tail [lrange $arcids($a) [expr {$i+1}] end]
6578 set arcids($a) [lrange $arcids($a) 0 $i]
6580 set arcstart($na) $p
6582 set arcids($na) $tail
6583 if {[info exists growing($a)]} {
6590 if {[llength $arcnos($id)] == 1} {
6593 set j [lsearch -exact $arcnos($id) $a]
6594 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6598 # reconstruct tags and heads lists
6599 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6604 set archeads($na) {}
6608 # Update things for a new commit added that is a child of one
6609 # existing commit. Used when cherry-picking.
6610 proc addnewchild {id p} {
6611 global allids allparents allchildren idtags nextarc nbmp
6612 global arcnos arcids arctags arcout arcend arcstart archeads growing
6616 set allparents($id) [list $p]
6617 set allchildren($id) {}
6621 lappend allchildren($p) $id
6622 set a [incr nextarc]
6623 set arcstart($a) $id
6626 set arcids($a) [list $p]
6628 if {![info exists arcout($p)]} {
6631 lappend arcnos($p) $a
6632 set arcout($id) [list $a]
6635 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6636 # or 0 if neither is true.
6637 proc anc_or_desc {a b} {
6638 global arcout arcstart arcend arcnos cached_isanc
6640 if {$arcnos($a) eq $arcnos($b)} {
6641 # Both are on the same arc(s); either both are the same BMP,
6642 # or if one is not a BMP, the other is also not a BMP or is
6643 # the BMP at end of the arc (and it only has 1 incoming arc).
6644 # Or both can be BMPs with no incoming arcs.
6645 if {$a eq $b || $arcnos($a) eq {}} {
6648 # assert {[llength $arcnos($a)] == 1}
6649 set arc [lindex $arcnos($a) 0]
6650 set i [lsearch -exact $arcids($arc) $a]
6651 set j [lsearch -exact $arcids($arc) $b]
6652 if {$i < 0 || $i > $j} {
6659 if {![info exists arcout($a)]} {
6660 set arc [lindex $arcnos($a) 0]
6661 if {[info exists arcend($arc)]} {
6662 set aend $arcend($arc)
6666 set a $arcstart($arc)
6670 if {![info exists arcout($b)]} {
6671 set arc [lindex $arcnos($b) 0]
6672 if {[info exists arcend($arc)]} {
6673 set bend $arcend($arc)
6677 set b $arcstart($arc)
6687 if {[info exists cached_isanc($a,$bend)]} {
6688 if {$cached_isanc($a,$bend)} {
6692 if {[info exists cached_isanc($b,$aend)]} {
6693 if {$cached_isanc($b,$aend)} {
6696 if {[info exists cached_isanc($a,$bend)]} {
6701 set todo [list $a $b]
6704 for {set i 0} {$i < [llength $todo]} {incr i} {
6705 set x [lindex $todo $i]
6706 if {$anc($x) eq {}} {
6709 foreach arc $arcnos($x) {
6710 set xd $arcstart($arc)
6712 set cached_isanc($a,$bend) 1
6713 set cached_isanc($b,$aend) 0
6715 } elseif {$xd eq $aend} {
6716 set cached_isanc($b,$aend) 1
6717 set cached_isanc($a,$bend) 0
6720 if {![info exists anc($xd)]} {
6721 set anc($xd) $anc($x)
6723 } elseif {$anc($xd) ne $anc($x)} {
6728 set cached_isanc($a,$bend) 0
6729 set cached_isanc($b,$aend) 0
6733 # This identifies whether $desc has an ancestor that is
6734 # a growing tip of the graph and which is not an ancestor of $anc
6735 # and returns 0 if so and 1 if not.
6736 # If we subsequently discover a tag on such a growing tip, and that
6737 # turns out to be a descendent of $anc (which it could, since we
6738 # don't necessarily see children before parents), then $desc
6739 # isn't a good choice to display as a descendent tag of
6740 # $anc (since it is the descendent of another tag which is
6741 # a descendent of $anc). Similarly, $anc isn't a good choice to
6742 # display as a ancestor tag of $desc.
6744 proc is_certain {desc anc} {
6745 global arcnos arcout arcstart arcend growing problems
6748 if {[llength $arcnos($anc)] == 1} {
6749 # tags on the same arc are certain
6750 if {$arcnos($desc) eq $arcnos($anc)} {
6753 if {![info exists arcout($anc)]} {
6754 # if $anc is partway along an arc, use the start of the arc instead
6755 set a [lindex $arcnos($anc) 0]
6756 set anc $arcstart($a)
6759 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6762 set a [lindex $arcnos($desc) 0]
6768 set anclist [list $x]
6772 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6773 set x [lindex $anclist $i]
6778 foreach a $arcout($x) {
6779 if {[info exists growing($a)]} {
6780 if {![info exists growanc($x)] && $dl($x)} {
6786 if {[info exists dl($y)]} {
6790 if {![info exists done($y)]} {
6793 if {[info exists growanc($x)]} {
6797 for {set k 0} {$k < [llength $xl]} {incr k} {
6798 set z [lindex $xl $k]
6799 foreach c $arcout($z) {
6800 if {[info exists arcend($c)]} {
6802 if {[info exists dl($v)] && $dl($v)} {
6804 if {![info exists done($v)]} {
6807 if {[info exists growanc($v)]} {
6817 } elseif {$y eq $anc || !$dl($x)} {
6828 foreach x [array names growanc] {
6837 proc validate_arctags {a} {
6838 global arctags idtags
6842 foreach id $arctags($a) {
6844 if {![info exists idtags($id)]} {
6845 set na [lreplace $na $i $i]
6852 proc validate_archeads {a} {
6853 global archeads idheads
6856 set na $archeads($a)
6857 foreach id $archeads($a) {
6859 if {![info exists idheads($id)]} {
6860 set na [lreplace $na $i $i]
6864 set archeads($a) $na
6867 # Return the list of IDs that have tags that are descendents of id,
6868 # ignoring IDs that are descendents of IDs already reported.
6869 proc desctags {id} {
6870 global arcnos arcstart arcids arctags idtags allparents
6871 global growing cached_dtags
6873 if {![info exists allparents($id)]} {
6876 set t1 [clock clicks -milliseconds]
6878 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6879 # part-way along an arc; check that arc first
6880 set a [lindex $arcnos($id) 0]
6881 if {$arctags($a) ne {}} {
6883 set i [lsearch -exact $arcids($a) $id]
6885 foreach t $arctags($a) {
6886 set j [lsearch -exact $arcids($a) $t]
6894 set id $arcstart($a)
6895 if {[info exists idtags($id)]} {
6899 if {[info exists cached_dtags($id)]} {
6900 return $cached_dtags($id)
6907 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6908 set id [lindex $todo $i]
6910 set ta [info exists hastaggedancestor($id)]
6914 # ignore tags on starting node
6915 if {!$ta && $i > 0} {
6916 if {[info exists idtags($id)]} {
6919 } elseif {[info exists cached_dtags($id)]} {
6920 set tagloc($id) $cached_dtags($id)
6924 foreach a $arcnos($id) {
6926 if {!$ta && $arctags($a) ne {}} {
6928 if {$arctags($a) ne {}} {
6929 lappend tagloc($id) [lindex $arctags($a) end]
6932 if {$ta || $arctags($a) ne {}} {
6933 set tomark [list $d]
6934 for {set j 0} {$j < [llength $tomark]} {incr j} {
6935 set dd [lindex $tomark $j]
6936 if {![info exists hastaggedancestor($dd)]} {
6937 if {[info exists done($dd)]} {
6938 foreach b $arcnos($dd) {
6939 lappend tomark $arcstart($b)
6941 if {[info exists tagloc($dd)]} {
6944 } elseif {[info exists queued($dd)]} {
6947 set hastaggedancestor($dd) 1
6951 if {![info exists queued($d)]} {
6954 if {![info exists hastaggedancestor($d)]} {
6961 foreach id [array names tagloc] {
6962 if {![info exists hastaggedancestor($id)]} {
6963 foreach t $tagloc($id) {
6964 if {[lsearch -exact $tags $t] < 0} {
6970 set t2 [clock clicks -milliseconds]
6973 # remove tags that are descendents of other tags
6974 for {set i 0} {$i < [llength $tags]} {incr i} {
6975 set a [lindex $tags $i]
6976 for {set j 0} {$j < $i} {incr j} {
6977 set b [lindex $tags $j]
6978 set r [anc_or_desc $a $b]
6980 set tags [lreplace $tags $j $j]
6983 } elseif {$r == -1} {
6984 set tags [lreplace $tags $i $i]
6991 if {[array names growing] ne {}} {
6992 # graph isn't finished, need to check if any tag could get
6993 # eclipsed by another tag coming later. Simply ignore any
6994 # tags that could later get eclipsed.
6997 if {[is_certain $t $origid]} {
7001 if {$tags eq $ctags} {
7002 set cached_dtags($origid) $tags
7007 set cached_dtags($origid) $tags
7009 set t3 [clock clicks -milliseconds]
7010 if {0 && $t3 - $t1 >= 100} {
7011 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7012 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7018 global arcnos arcids arcout arcend arctags idtags allparents
7019 global growing cached_atags
7021 if {![info exists allparents($id)]} {
7024 set t1 [clock clicks -milliseconds]
7026 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7027 # part-way along an arc; check that arc first
7028 set a [lindex $arcnos($id) 0]
7029 if {$arctags($a) ne {}} {
7031 set i [lsearch -exact $arcids($a) $id]
7032 foreach t $arctags($a) {
7033 set j [lsearch -exact $arcids($a) $t]
7039 if {![info exists arcend($a)]} {
7043 if {[info exists idtags($id)]} {
7047 if {[info exists cached_atags($id)]} {
7048 return $cached_atags($id)
7056 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7057 set id [lindex $todo $i]
7059 set td [info exists hastaggeddescendent($id)]
7063 # ignore tags on starting node
7064 if {!$td && $i > 0} {
7065 if {[info exists idtags($id)]} {
7068 } elseif {[info exists cached_atags($id)]} {
7069 set tagloc($id) $cached_atags($id)
7073 foreach a $arcout($id) {
7074 if {!$td && $arctags($a) ne {}} {
7076 if {$arctags($a) ne {}} {
7077 lappend tagloc($id) [lindex $arctags($a) 0]
7080 if {![info exists arcend($a)]} continue
7082 if {$td || $arctags($a) ne {}} {
7083 set tomark [list $d]
7084 for {set j 0} {$j < [llength $tomark]} {incr j} {
7085 set dd [lindex $tomark $j]
7086 if {![info exists hastaggeddescendent($dd)]} {
7087 if {[info exists done($dd)]} {
7088 foreach b $arcout($dd) {
7089 if {[info exists arcend($b)]} {
7090 lappend tomark $arcend($b)
7093 if {[info exists tagloc($dd)]} {
7096 } elseif {[info exists queued($dd)]} {
7099 set hastaggeddescendent($dd) 1
7103 if {![info exists queued($d)]} {
7106 if {![info exists hastaggeddescendent($d)]} {
7112 set t2 [clock clicks -milliseconds]
7115 foreach id [array names tagloc] {
7116 if {![info exists hastaggeddescendent($id)]} {
7117 foreach t $tagloc($id) {
7118 if {[lsearch -exact $tags $t] < 0} {
7125 # remove tags that are ancestors of other tags
7126 for {set i 0} {$i < [llength $tags]} {incr i} {
7127 set a [lindex $tags $i]
7128 for {set j 0} {$j < $i} {incr j} {
7129 set b [lindex $tags $j]
7130 set r [anc_or_desc $a $b]
7132 set tags [lreplace $tags $j $j]
7135 } elseif {$r == 1} {
7136 set tags [lreplace $tags $i $i]
7143 if {[array names growing] ne {}} {
7144 # graph isn't finished, need to check if any tag could get
7145 # eclipsed by another tag coming later. Simply ignore any
7146 # tags that could later get eclipsed.
7149 if {[is_certain $origid $t]} {
7153 if {$tags eq $ctags} {
7154 set cached_atags($origid) $tags
7159 set cached_atags($origid) $tags
7161 set t3 [clock clicks -milliseconds]
7162 if {0 && $t3 - $t1 >= 100} {
7163 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7164 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7169 # Return the list of IDs that have heads that are descendents of id,
7170 # including id itself if it has a head.
7171 proc descheads {id} {
7172 global arcnos arcstart arcids archeads idheads cached_dheads
7175 if {![info exists allparents($id)]} {
7179 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7180 # part-way along an arc; check it first
7181 set a [lindex $arcnos($id) 0]
7182 if {$archeads($a) ne {}} {
7183 validate_archeads $a
7184 set i [lsearch -exact $arcids($a) $id]
7185 foreach t $archeads($a) {
7186 set j [lsearch -exact $arcids($a) $t]
7191 set id $arcstart($a)
7197 for {set i 0} {$i < [llength $todo]} {incr i} {
7198 set id [lindex $todo $i]
7199 if {[info exists cached_dheads($id)]} {
7200 set ret [concat $ret $cached_dheads($id)]
7202 if {[info exists idheads($id)]} {
7205 foreach a $arcnos($id) {
7206 if {$archeads($a) ne {}} {
7207 validate_archeads $a
7208 if {$archeads($a) ne {}} {
7209 set ret [concat $ret $archeads($a)]
7213 if {![info exists seen($d)]} {
7220 set ret [lsort -unique $ret]
7221 set cached_dheads($origid) $ret
7222 return [concat $ret $aret]
7225 proc addedtag {id} {
7226 global arcnos arcout cached_dtags cached_atags
7228 if {![info exists arcnos($id)]} return
7229 if {![info exists arcout($id)]} {
7230 recalcarc [lindex $arcnos($id) 0]
7232 catch {unset cached_dtags}
7233 catch {unset cached_atags}
7236 proc addedhead {hid head} {
7237 global arcnos arcout cached_dheads
7239 if {![info exists arcnos($hid)]} return
7240 if {![info exists arcout($hid)]} {
7241 recalcarc [lindex $arcnos($hid) 0]
7243 catch {unset cached_dheads}
7246 proc removedhead {hid head} {
7247 global cached_dheads
7249 catch {unset cached_dheads}
7252 proc movedhead {hid head} {
7253 global arcnos arcout cached_dheads
7255 if {![info exists arcnos($hid)]} return
7256 if {![info exists arcout($hid)]} {
7257 recalcarc [lindex $arcnos($hid) 0]
7259 catch {unset cached_dheads}
7262 proc changedrefs {} {
7263 global cached_dheads cached_dtags cached_atags
7264 global arctags archeads arcnos arcout idheads idtags
7266 foreach id [concat [array names idheads] [array names idtags]] {
7267 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7268 set a [lindex $arcnos($id) 0]
7269 if {![info exists donearc($a)]} {
7275 catch {unset cached_dtags}
7276 catch {unset cached_atags}
7277 catch {unset cached_dheads}
7280 proc rereadrefs {} {
7281 global idtags idheads idotherrefs mainhead
7283 set refids [concat [array names idtags] \
7284 [array names idheads] [array names idotherrefs]]
7285 foreach id $refids {
7286 if {![info exists ref($id)]} {
7287 set ref($id) [listrefs $id]
7290 set oldmainhead $mainhead
7293 set refids [lsort -unique [concat $refids [array names idtags] \
7294 [array names idheads] [array names idotherrefs]]]
7295 foreach id $refids {
7296 set v [listrefs $id]
7297 if {![info exists ref($id)] || $ref($id) != $v ||
7298 ($id eq $oldmainhead && $id ne $mainhead) ||
7299 ($id eq $mainhead && $id ne $oldmainhead)} {
7306 proc listrefs {id} {
7307 global idtags idheads idotherrefs
7310 if {[info exists idtags($id)]} {
7314 if {[info exists idheads($id)]} {
7318 if {[info exists idotherrefs($id)]} {
7319 set z $idotherrefs($id)
7321 return [list $x $y $z]
7324 proc showtag {tag isnew} {
7325 global ctext tagcontents tagids linknum tagobjid
7328 addtohistory [list showtag $tag 0]
7330 $ctext conf -state normal
7333 if {![info exists tagcontents($tag)]} {
7335 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7338 if {[info exists tagcontents($tag)]} {
7339 set text $tagcontents($tag)
7341 set text "Tag: $tag\nId: $tagids($tag)"
7343 appendwithlinks $text {}
7344 $ctext conf -state disabled
7356 global maxwidth maxgraphpct diffopts
7357 global oldprefs prefstop showneartags showlocalchanges
7358 global bgcolor fgcolor ctext diffcolors selectbgcolor
7359 global uifont tabstop
7363 if {[winfo exists $top]} {
7367 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7368 set oldprefs($v) [set $v]
7371 wm title $top "Gitk preferences"
7372 label $top.ldisp -text "Commit list display options"
7373 $top.ldisp configure -font $uifont
7374 grid $top.ldisp - -sticky w -pady 10
7375 label $top.spacer -text " "
7376 label $top.maxwidthl -text "Maximum graph width (lines)" \
7378 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7379 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7380 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7382 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7383 grid x $top.maxpctl $top.maxpct -sticky w
7384 frame $top.showlocal
7385 label $top.showlocal.l -text "Show local changes" -font optionfont
7386 checkbutton $top.showlocal.b -variable showlocalchanges
7387 pack $top.showlocal.b $top.showlocal.l -side left
7388 grid x $top.showlocal -sticky w
7390 label $top.ddisp -text "Diff display options"
7391 $top.ddisp configure -font $uifont
7392 grid $top.ddisp - -sticky w -pady 10
7393 label $top.diffoptl -text "Options for diff program" \
7395 entry $top.diffopt -width 20 -textvariable diffopts
7396 grid x $top.diffoptl $top.diffopt -sticky w
7398 label $top.ntag.l -text "Display nearby tags" -font optionfont
7399 checkbutton $top.ntag.b -variable showneartags
7400 pack $top.ntag.b $top.ntag.l -side left
7401 grid x $top.ntag -sticky w
7402 label $top.tabstopl -text "tabstop" -font optionfont
7403 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7404 grid x $top.tabstopl $top.tabstop -sticky w
7406 label $top.cdisp -text "Colors: press to choose"
7407 $top.cdisp configure -font $uifont
7408 grid $top.cdisp - -sticky w -pady 10
7409 label $top.bg -padx 40 -relief sunk -background $bgcolor
7410 button $top.bgbut -text "Background" -font optionfont \
7411 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7412 grid x $top.bgbut $top.bg -sticky w
7413 label $top.fg -padx 40 -relief sunk -background $fgcolor
7414 button $top.fgbut -text "Foreground" -font optionfont \
7415 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7416 grid x $top.fgbut $top.fg -sticky w
7417 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7418 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7419 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7420 [list $ctext tag conf d0 -foreground]]
7421 grid x $top.diffoldbut $top.diffold -sticky w
7422 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7423 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7424 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7425 [list $ctext tag conf d1 -foreground]]
7426 grid x $top.diffnewbut $top.diffnew -sticky w
7427 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7428 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7429 -command [list choosecolor diffcolors 2 $top.hunksep \
7430 "diff hunk header" \
7431 [list $ctext tag conf hunksep -foreground]]
7432 grid x $top.hunksepbut $top.hunksep -sticky w
7433 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7434 button $top.selbgbut -text "Select bg" -font optionfont \
7435 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7436 grid x $top.selbgbut $top.selbgsep -sticky w
7439 button $top.buts.ok -text "OK" -command prefsok -default active
7440 $top.buts.ok configure -font $uifont
7441 button $top.buts.can -text "Cancel" -command prefscan -default normal
7442 $top.buts.can configure -font $uifont
7443 grid $top.buts.ok $top.buts.can
7444 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7445 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7446 grid $top.buts - - -pady 10 -sticky ew
7447 bind $top <Visibility> "focus $top.buts.ok"
7450 proc choosecolor {v vi w x cmd} {
7453 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7454 -title "Gitk: choose color for $x"]
7455 if {$c eq {}} return
7456 $w conf -background $c
7462 global bglist cflist
7464 $w configure -selectbackground $c
7466 $cflist tag configure highlight \
7467 -background [$cflist cget -selectbackground]
7468 allcanvs itemconf secsel -fill $c
7475 $w conf -background $c
7483 $w conf -foreground $c
7485 allcanvs itemconf text -fill $c
7486 $canv itemconf circle -outline $c
7490 global maxwidth maxgraphpct diffopts
7491 global oldprefs prefstop showneartags showlocalchanges
7493 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7494 set $v $oldprefs($v)
7496 catch {destroy $prefstop}
7501 global maxwidth maxgraphpct
7502 global oldprefs prefstop showneartags showlocalchanges
7503 global charspc ctext tabstop
7505 catch {destroy $prefstop}
7507 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7508 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7509 if {$showlocalchanges} {
7515 if {$maxwidth != $oldprefs(maxwidth)
7516 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7518 } elseif {$showneartags != $oldprefs(showneartags)} {
7523 proc formatdate {d} {
7524 global datetimeformat
7526 set d [clock format $d -format $datetimeformat]
7531 # This list of encoding names and aliases is distilled from
7532 # http://www.iana.org/assignments/character-sets.
7533 # Not all of them are supported by Tcl.
7534 set encoding_aliases {
7535 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7536 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7537 { ISO-10646-UTF-1 csISO10646UTF1 }
7538 { ISO_646.basic:1983 ref csISO646basic1983 }
7539 { INVARIANT csINVARIANT }
7540 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7541 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7542 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7543 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7544 { NATS-DANO iso-ir-9-1 csNATSDANO }
7545 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7546 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7547 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7548 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7549 { ISO-2022-KR csISO2022KR }
7551 { ISO-2022-JP csISO2022JP }
7552 { ISO-2022-JP-2 csISO2022JP2 }
7553 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7555 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7556 { IT iso-ir-15 ISO646-IT csISO15Italian }
7557 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7558 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7559 { greek7-old iso-ir-18 csISO18Greek7Old }
7560 { latin-greek iso-ir-19 csISO19LatinGreek }
7561 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7562 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7563 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7564 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7565 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7566 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7567 { INIS iso-ir-49 csISO49INIS }
7568 { INIS-8 iso-ir-50 csISO50INIS8 }
7569 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7570 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7571 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7572 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7573 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7574 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7576 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7577 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7578 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7579 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7580 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7581 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7582 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7583 { greek7 iso-ir-88 csISO88Greek7 }
7584 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7585 { iso-ir-90 csISO90 }
7586 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7587 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7588 csISO92JISC62991984b }
7589 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7590 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7591 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7592 csISO95JIS62291984handadd }
7593 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7594 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7595 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7596 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7598 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7599 { T.61-7bit iso-ir-102 csISO102T617bit }
7600 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7601 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7602 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7603 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7604 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7605 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7606 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7607 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7608 arabic csISOLatinArabic }
7609 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7610 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7611 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7612 greek greek8 csISOLatinGreek }
7613 { T.101-G2 iso-ir-128 csISO128T101G2 }
7614 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7616 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7617 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7618 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7619 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7620 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7621 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7622 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7623 csISOLatinCyrillic }
7624 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7625 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7626 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7627 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7628 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7629 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7630 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7631 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7632 { ISO_10367-box iso-ir-155 csISO10367Box }
7633 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7634 { latin-lap lap iso-ir-158 csISO158Lap }
7635 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7636 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7639 { JIS_X0201 X0201 csHalfWidthKatakana }
7640 { KSC5636 ISO646-KR csKSC5636 }
7641 { ISO-10646-UCS-2 csUnicode }
7642 { ISO-10646-UCS-4 csUCS4 }
7643 { DEC-MCS dec csDECMCS }
7644 { hp-roman8 roman8 r8 csHPRoman8 }
7645 { macintosh mac csMacintosh }
7646 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7648 { IBM038 EBCDIC-INT cp038 csIBM038 }
7649 { IBM273 CP273 csIBM273 }
7650 { IBM274 EBCDIC-BE CP274 csIBM274 }
7651 { IBM275 EBCDIC-BR cp275 csIBM275 }
7652 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7653 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7654 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7655 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7656 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7657 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7658 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7659 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7660 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7661 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7662 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7663 { IBM437 cp437 437 csPC8CodePage437 }
7664 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7665 { IBM775 cp775 csPC775Baltic }
7666 { IBM850 cp850 850 csPC850Multilingual }
7667 { IBM851 cp851 851 csIBM851 }
7668 { IBM852 cp852 852 csPCp852 }
7669 { IBM855 cp855 855 csIBM855 }
7670 { IBM857 cp857 857 csIBM857 }
7671 { IBM860 cp860 860 csIBM860 }
7672 { IBM861 cp861 861 cp-is csIBM861 }
7673 { IBM862 cp862 862 csPC862LatinHebrew }
7674 { IBM863 cp863 863 csIBM863 }
7675 { IBM864 cp864 csIBM864 }
7676 { IBM865 cp865 865 csIBM865 }
7677 { IBM866 cp866 866 csIBM866 }
7678 { IBM868 CP868 cp-ar csIBM868 }
7679 { IBM869 cp869 869 cp-gr csIBM869 }
7680 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7681 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7682 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7683 { IBM891 cp891 csIBM891 }
7684 { IBM903 cp903 csIBM903 }
7685 { IBM904 cp904 904 csIBBM904 }
7686 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7687 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7688 { IBM1026 CP1026 csIBM1026 }
7689 { EBCDIC-AT-DE csIBMEBCDICATDE }
7690 { EBCDIC-AT-DE-A csEBCDICATDEA }
7691 { EBCDIC-CA-FR csEBCDICCAFR }
7692 { EBCDIC-DK-NO csEBCDICDKNO }
7693 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7694 { EBCDIC-FI-SE csEBCDICFISE }
7695 { EBCDIC-FI-SE-A csEBCDICFISEA }
7696 { EBCDIC-FR csEBCDICFR }
7697 { EBCDIC-IT csEBCDICIT }
7698 { EBCDIC-PT csEBCDICPT }
7699 { EBCDIC-ES csEBCDICES }
7700 { EBCDIC-ES-A csEBCDICESA }
7701 { EBCDIC-ES-S csEBCDICESS }
7702 { EBCDIC-UK csEBCDICUK }
7703 { EBCDIC-US csEBCDICUS }
7704 { UNKNOWN-8BIT csUnknown8BiT }
7705 { MNEMONIC csMnemonic }
7710 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7711 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7712 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7713 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7714 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7715 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7716 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7717 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7718 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7719 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7720 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7721 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7722 { IBM1047 IBM-1047 }
7723 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7724 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7725 { UNICODE-1-1 csUnicode11 }
7728 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7729 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7731 { ISO-8859-15 ISO_8859-15 Latin-9 }
7732 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7733 { GBK CP936 MS936 windows-936 }
7734 { JIS_Encoding csJISEncoding }
7735 { Shift_JIS MS_Kanji csShiftJIS }
7736 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7738 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7739 { ISO-10646-UCS-Basic csUnicodeASCII }
7740 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7741 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7742 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7743 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7744 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7745 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7746 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7747 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7748 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7749 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7750 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7751 { Ventura-US csVenturaUS }
7752 { Ventura-International csVenturaInternational }
7753 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7754 { PC8-Turkish csPC8Turkish }
7755 { IBM-Symbols csIBMSymbols }
7756 { IBM-Thai csIBMThai }
7757 { HP-Legal csHPLegal }
7758 { HP-Pi-font csHPPiFont }
7759 { HP-Math8 csHPMath8 }
7760 { Adobe-Symbol-Encoding csHPPSMath }
7761 { HP-DeskTop csHPDesktop }
7762 { Ventura-Math csVenturaMath }
7763 { Microsoft-Publishing csMicrosoftPublishing }
7764 { Windows-31J csWindows31J }
7769 proc tcl_encoding {enc} {
7770 global encoding_aliases
7771 set names [encoding names]
7772 set lcnames [string tolower $names]
7773 set enc [string tolower $enc]
7774 set i [lsearch -exact $lcnames $enc]
7776 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7777 if {[regsub {^iso[-_]} $enc iso encx]} {
7778 set i [lsearch -exact $lcnames $encx]
7782 foreach l $encoding_aliases {
7783 set ll [string tolower $l]
7784 if {[lsearch -exact $ll $enc] < 0} continue
7785 # look through the aliases for one that tcl knows about
7787 set i [lsearch -exact $lcnames $e]
7789 if {[regsub {^iso[-_]} $e iso ex]} {
7790 set i [lsearch -exact $lcnames $ex]
7799 return [lindex $names $i]
7806 set diffopts "-U 5 -p"
7807 set wrcomcmd "git diff-tree --stdin -p --pretty"
7811 set gitencoding [exec git config --get i18n.commitencoding]
7813 if {$gitencoding == ""} {
7814 set gitencoding "utf-8"
7816 set tclencoding [tcl_encoding $gitencoding]
7817 if {$tclencoding == {}} {
7818 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7821 set mainfont {Helvetica 9}
7822 set textfont {Courier 9}
7823 set uifont {Helvetica 9 bold}
7825 set findmergefiles 0
7833 set cmitmode "patch"
7834 set wrapcomment "none"
7838 set showlocalchanges 1
7839 set datetimeformat "%Y-%m-%d %H:%M:%S"
7841 set colors {green red blue magenta darkgrey brown orange}
7844 set diffcolors {red "#00a000" blue}
7846 set selectbgcolor gray85
7848 catch {source ~/.gitk}
7850 font create optionfont -family sans-serif -size -12
7852 # check that we can find a .git directory somewhere...
7853 if {[catch {set gitdir [gitdir]}]} {
7854 show_error {} . "Cannot find a git repository here."
7857 if {![file isdirectory $gitdir]} {
7858 show_error {} . "Cannot find the git directory \"$gitdir\"."
7863 set cmdline_files {}
7868 "-d" { set datemode 1 }
7870 set cmdline_files [lrange $argv [expr {$i + 1}] end]
7874 lappend revtreeargs $arg
7880 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7881 # no -- on command line, but some arguments (other than -d)
7883 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7884 set cmdline_files [split $f "\n"]
7885 set n [llength $cmdline_files]
7886 set revtreeargs [lrange $revtreeargs 0 end-$n]
7887 # Unfortunately git rev-parse doesn't produce an error when
7888 # something is both a revision and a filename. To be consistent
7889 # with git log and git rev-list, check revtreeargs for filenames.
7890 foreach arg $revtreeargs {
7891 if {[file exists $arg]} {
7892 show_error {} . "Ambiguous argument '$arg': both revision\
7898 # unfortunately we get both stdout and stderr in $err,
7899 # so look for "fatal:".
7900 set i [string first "fatal:" $err]
7902 set err [string range $err [expr {$i + 6}] end]
7904 show_error {} . "Bad arguments to gitk:\n$err"
7909 set nullid "0000000000000000000000000000000000000000"
7910 set nullid2 "0000000000000000000000000000000000000001"
7918 set highlight_paths {}
7919 set searchdirn -forwards
7923 set markingmatches 0
7924 set linkentercount 0
7931 set selectedhlview None
7940 set lookingforhead 0
7946 # wait for the window to become visible
7948 wm title . "[file tail $argv0]: [file tail [pwd]]"
7951 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7952 # create a view for the files/dirs specified on the command line
7956 set viewname(1) "Command line"
7957 set viewfiles(1) $cmdline_files
7958 set viewargs(1) $revtreeargs
7961 .bar.view entryconf Edit* -state normal
7962 .bar.view entryconf Delete* -state normal
7965 if {[info exists permviews]} {
7966 foreach v $permviews {
7969 set viewname($n) [lindex $v 0]
7970 set viewfiles($n) [lindex $v 1]
7971 set viewargs($n) [lindex $v 2]