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
86 global lookingforhead showlocalchanges
88 set startmsecs [clock clicks -milliseconds]
89 set commitidx($view) 0
90 set order "--topo-order"
92 set order "--date-order"
95 set fd [open [concat | git log -z --pretty=raw $order --parents \
96 --boundary $viewargs($view) "--" $viewfiles($view)] r]
98 error_popup "Error executing git rev-list: $err"
101 set commfd($view) $fd
102 set leftover($view) {}
103 set lookingforhead $showlocalchanges
104 fconfigure $fd -blocking 0 -translation lf -eofchar {}
105 if {$tclencoding != {}} {
106 fconfigure $fd -encoding $tclencoding
108 filerun $fd [list getcommitlines $fd $view]
112 proc stop_rev_list {} {
113 global commfd curview
115 if {![info exists commfd($curview)]} return
116 set fd $commfd($curview)
122 unset commfd($curview)
126 global phase canv mainfont curview
130 start_rev_list $curview
131 show_status "Reading commits..."
134 proc getcommitlines {fd view} {
136 global leftover commfd
137 global displayorder commitidx commitrow commitdata
138 global parentlist children curview hlview
139 global vparentlist vdisporder vcmitlisted
141 set stuff [read $fd 500000]
142 # git log doesn't terminate the last commit with a null...
143 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
153 # set it blocking so we wait for the process to terminate
154 fconfigure $fd -blocking 1
155 if {[catch {close $fd} err]} {
157 if {$view != $curview} {
158 set fv " for the \"$viewname($view)\" view"
160 if {[string range $err 0 4] == "usage"} {
161 set err "Gitk: error reading commits$fv:\
162 bad arguments to git rev-list."
163 if {$viewname($view) eq "Command line"} {
165 " (Note: arguments to gitk are passed to git rev-list\
166 to allow selection of commits to be displayed.)"
169 set err "Error reading commits$fv: $err"
173 if {$view == $curview} {
174 run chewcommits $view
181 set i [string first "\0" $stuff $start]
183 append leftover($view) [string range $stuff $start end]
187 set cmit $leftover($view)
188 append cmit [string range $stuff 0 [expr {$i - 1}]]
189 set leftover($view) {}
191 set cmit [string range $stuff $start [expr {$i - 1}]]
193 set start [expr {$i + 1}]
194 set j [string first "\n" $cmit]
197 if {$j >= 0 && [string match "commit *" $cmit]} {
198 set ids [string range $cmit 7 [expr {$j - 1}]]
199 if {[string match {[-<>]*} $ids]} {
200 switch -- [string index $ids 0] {
205 set ids [string range $ids 1 end]
209 if {[string length $id] != 40} {
217 if {[string length $shortcmit] > 80} {
218 set shortcmit "[string range $shortcmit 0 80]..."
220 error_popup "Can't parse git log output: {$shortcmit}"
223 set id [lindex $ids 0]
225 set olds [lrange $ids 1 end]
228 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
229 lappend children($view,$p) $id
236 if {![info exists children($view,$id)]} {
237 set children($view,$id) {}
239 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
240 set commitrow($view,$id) $commitidx($view)
241 incr commitidx($view)
242 if {$view == $curview} {
243 lappend parentlist $olds
244 lappend displayorder $id
245 lappend commitlisted $listed
247 lappend vparentlist($view) $olds
248 lappend vdisporder($view) $id
249 lappend vcmitlisted($view) $listed
254 run chewcommits $view
259 proc chewcommits {view} {
260 global curview hlview commfd
261 global selectedline pending_select
264 if {$view == $curview} {
265 set allread [expr {![info exists commfd($view)]}]
266 set tlimit [expr {[clock clicks -milliseconds] + 50}]
267 set more [layoutmore $tlimit $allread]
268 if {$allread && !$more} {
269 global displayorder commitidx phase
270 global numcommits startmsecs
272 if {[info exists pending_select]} {
273 set row [first_real_row]
276 if {$commitidx($curview) > 0} {
277 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
278 #puts "overall $ms ms for $numcommits commits"
280 show_status "No commits selected"
286 if {[info exists hlview] && $view == $hlview} {
292 proc readcommit {id} {
293 if {[catch {set contents [exec git cat-file commit $id]}]} return
294 parsecommit $id $contents 0
297 proc updatecommits {} {
298 global viewdata curview phase displayorder
299 global children commitrow selectedline thickerline showneartags
306 foreach id $displayorder {
307 catch {unset children($n,$id)}
308 catch {unset commitrow($n,$id)}
311 catch {unset selectedline}
312 catch {unset thickerline}
313 catch {unset viewdata($n)}
322 proc parsecommit {id contents listed} {
323 global commitinfo cdate
332 set hdrend [string first "\n\n" $contents]
334 # should never happen...
335 set hdrend [string length $contents]
337 set header [string range $contents 0 [expr {$hdrend - 1}]]
338 set comment [string range $contents [expr {$hdrend + 2}] end]
339 foreach line [split $header "\n"] {
340 set tag [lindex $line 0]
341 if {$tag == "author"} {
342 set audate [lindex $line end-1]
343 set auname [lrange $line 1 end-2]
344 } elseif {$tag == "committer"} {
345 set comdate [lindex $line end-1]
346 set comname [lrange $line 1 end-2]
350 # take the first non-blank line of the comment as the headline
351 set headline [string trimleft $comment]
352 set i [string first "\n" $headline]
354 set headline [string range $headline 0 $i]
356 set headline [string trimright $headline]
357 set i [string first "\r" $headline]
359 set headline [string trimright [string range $headline 0 $i]]
362 # git rev-list indents the comment by 4 spaces;
363 # if we got this via git cat-file, add the indentation
365 foreach line [split $comment "\n"] {
366 append newcomment " "
367 append newcomment $line
368 append newcomment "\n"
370 set comment $newcomment
372 if {$comdate != {}} {
373 set cdate($id) $comdate
375 set commitinfo($id) [list $headline $auname $audate \
376 $comname $comdate $comment]
379 proc getcommit {id} {
380 global commitdata commitinfo
382 if {[info exists commitdata($id)]} {
383 parsecommit $id $commitdata($id) 1
386 if {![info exists commitinfo($id)]} {
387 set commitinfo($id) {"No commit information available"}
394 global tagids idtags headids idheads tagobjid
395 global otherrefids idotherrefs mainhead mainheadid
397 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
400 set refd [open [list | git show-ref -d] r]
401 while {[gets $refd line] >= 0} {
402 if {[string index $line 40] ne " "} continue
403 set id [string range $line 0 39]
404 set ref [string range $line 41 end]
405 if {![string match "refs/*" $ref]} continue
406 set name [string range $ref 5 end]
407 if {[string match "remotes/*" $name]} {
408 if {![string match "*/HEAD" $name]} {
409 set headids($name) $id
410 lappend idheads($id) $name
412 } elseif {[string match "heads/*" $name]} {
413 set name [string range $name 6 end]
414 set headids($name) $id
415 lappend idheads($id) $name
416 } elseif {[string match "tags/*" $name]} {
417 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
418 # which is what we want since the former is the commit ID
419 set name [string range $name 5 end]
420 if {[string match "*^{}" $name]} {
421 set name [string range $name 0 end-3]
423 set tagobjid($name) $id
425 set tagids($name) $id
426 lappend idtags($id) $name
428 set otherrefids($name) $id
429 lappend idotherrefs($id) $name
436 set thehead [exec git symbolic-ref HEAD]
437 if {[string match "refs/heads/*" $thehead]} {
438 set mainhead [string range $thehead 11 end]
439 if {[info exists headids($mainhead)]} {
440 set mainheadid $headids($mainhead)
446 # skip over fake commits
447 proc first_real_row {} {
448 global nullid nullid2 displayorder numcommits
450 for {set row 0} {$row < $numcommits} {incr row} {
451 set id [lindex $displayorder $row]
452 if {$id ne $nullid && $id ne $nullid2} {
459 # update things for a head moved to a child of its previous location
460 proc movehead {id name} {
461 global headids idheads
463 removehead $headids($name) $name
464 set headids($name) $id
465 lappend idheads($id) $name
468 # update things when a head has been removed
469 proc removehead {id name} {
470 global headids idheads
472 if {$idheads($id) eq $name} {
475 set i [lsearch -exact $idheads($id) $name]
477 set idheads($id) [lreplace $idheads($id) $i $i]
483 proc show_error {w top msg} {
484 message $w.m -text $msg -justify center -aspect 400
485 pack $w.m -side top -fill x -padx 20 -pady 20
486 button $w.ok -text OK -command "destroy $top"
487 pack $w.ok -side bottom -fill x
488 bind $top <Visibility> "grab $top; focus $top"
489 bind $top <Key-Return> "destroy $top"
493 proc error_popup msg {
497 show_error $w $w $msg
500 proc confirm_popup msg {
506 message $w.m -text $msg -justify center -aspect 400
507 pack $w.m -side top -fill x -padx 20 -pady 20
508 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
509 pack $w.ok -side left -fill x
510 button $w.cancel -text Cancel -command "destroy $w"
511 pack $w.cancel -side right -fill x
512 bind $w <Visibility> "grab $w; focus $w"
518 global canv canv2 canv3 linespc charspc ctext cflist
519 global textfont mainfont uifont tabstop
520 global findtype findtypemenu findloc findstring fstring geometry
521 global entries sha1entry sha1string sha1but
522 global diffcontextstring diffcontext
523 global maincursor textcursor curtextcursor
524 global rowctxmenu fakerowmenu mergemax wrapcomment
525 global highlight_files gdttype
526 global searchstring sstring
527 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
531 .bar add cascade -label "File" -menu .bar.file
532 .bar configure -font $uifont
534 .bar.file add command -label "Update" -command updatecommits
535 .bar.file add command -label "Reread references" -command rereadrefs
536 .bar.file add command -label "List references" -command showrefs
537 .bar.file add command -label "Quit" -command doquit
538 .bar.file configure -font $uifont
540 .bar add cascade -label "Edit" -menu .bar.edit
541 .bar.edit add command -label "Preferences" -command doprefs
542 .bar.edit configure -font $uifont
544 menu .bar.view -font $uifont
545 .bar add cascade -label "View" -menu .bar.view
546 .bar.view add command -label "New view..." -command {newview 0}
547 .bar.view add command -label "Edit view..." -command editview \
549 .bar.view add command -label "Delete view" -command delview -state disabled
550 .bar.view add separator
551 .bar.view add radiobutton -label "All files" -command {showview 0} \
552 -variable selectedview -value 0
555 .bar add cascade -label "Help" -menu .bar.help
556 .bar.help add command -label "About gitk" -command about
557 .bar.help add command -label "Key bindings" -command keys
558 .bar.help configure -font $uifont
559 . configure -menu .bar
561 # the gui has upper and lower half, parts of a paned window.
562 panedwindow .ctop -orient vertical
564 # possibly use assumed geometry
565 if {![info exists geometry(pwsash0)]} {
566 set geometry(topheight) [expr {15 * $linespc}]
567 set geometry(topwidth) [expr {80 * $charspc}]
568 set geometry(botheight) [expr {15 * $linespc}]
569 set geometry(botwidth) [expr {50 * $charspc}]
570 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
571 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
574 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
575 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
577 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
579 # create three canvases
580 set cscroll .tf.histframe.csb
581 set canv .tf.histframe.pwclist.canv
583 -selectbackground $selectbgcolor \
584 -background $bgcolor -bd 0 \
585 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
586 .tf.histframe.pwclist add $canv
587 set canv2 .tf.histframe.pwclist.canv2
589 -selectbackground $selectbgcolor \
590 -background $bgcolor -bd 0 -yscrollincr $linespc
591 .tf.histframe.pwclist add $canv2
592 set canv3 .tf.histframe.pwclist.canv3
594 -selectbackground $selectbgcolor \
595 -background $bgcolor -bd 0 -yscrollincr $linespc
596 .tf.histframe.pwclist add $canv3
597 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
598 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
600 # a scroll bar to rule them
601 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
602 pack $cscroll -side right -fill y
603 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
604 lappend bglist $canv $canv2 $canv3
605 pack .tf.histframe.pwclist -fill both -expand 1 -side left
607 # we have two button bars at bottom of top frame. Bar 1
609 frame .tf.lbar -height 15
611 set sha1entry .tf.bar.sha1
612 set entries $sha1entry
613 set sha1but .tf.bar.sha1label
614 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
615 -command gotocommit -width 8 -font $uifont
616 $sha1but conf -disabledforeground [$sha1but cget -foreground]
617 pack .tf.bar.sha1label -side left
618 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
619 trace add variable sha1string write sha1change
620 pack $sha1entry -side left -pady 2
622 image create bitmap bm-left -data {
623 #define left_width 16
624 #define left_height 16
625 static unsigned char left_bits[] = {
626 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
627 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
628 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
630 image create bitmap bm-right -data {
631 #define right_width 16
632 #define right_height 16
633 static unsigned char right_bits[] = {
634 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
635 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
636 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
638 button .tf.bar.leftbut -image bm-left -command goback \
639 -state disabled -width 26
640 pack .tf.bar.leftbut -side left -fill y
641 button .tf.bar.rightbut -image bm-right -command goforw \
642 -state disabled -width 26
643 pack .tf.bar.rightbut -side left -fill y
645 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
646 pack .tf.bar.findbut -side left
648 set fstring .tf.bar.findstring
649 lappend entries $fstring
650 entry $fstring -width 30 -font $textfont -textvariable findstring
651 trace add variable findstring write find_change
652 pack $fstring -side left -expand 1 -fill x -in .tf.bar
654 set findtypemenu [tk_optionMenu .tf.bar.findtype \
655 findtype Exact IgnCase Regexp]
656 trace add variable findtype write find_change
657 .tf.bar.findtype configure -font $uifont
658 .tf.bar.findtype.menu configure -font $uifont
659 set findloc "All fields"
660 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
661 Comments Author Committer
662 trace add variable findloc write find_change
663 .tf.bar.findloc configure -font $uifont
664 .tf.bar.findloc.menu configure -font $uifont
665 pack .tf.bar.findloc -side right
666 pack .tf.bar.findtype -side right
668 # build up the bottom bar of upper window
669 label .tf.lbar.flabel -text "Highlight: Commits " \
671 pack .tf.lbar.flabel -side left -fill y
672 set gdttype "touching paths:"
673 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
674 "adding/removing string:"]
675 trace add variable gdttype write hfiles_change
676 $gm conf -font $uifont
677 .tf.lbar.gdttype conf -font $uifont
678 pack .tf.lbar.gdttype -side left -fill y
679 entry .tf.lbar.fent -width 25 -font $textfont \
680 -textvariable highlight_files
681 trace add variable highlight_files write hfiles_change
682 lappend entries .tf.lbar.fent
683 pack .tf.lbar.fent -side left -fill x -expand 1
684 label .tf.lbar.vlabel -text " OR in view" -font $uifont
685 pack .tf.lbar.vlabel -side left -fill y
686 global viewhlmenu selectedhlview
687 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
688 $viewhlmenu entryconf None -command delvhighlight
689 $viewhlmenu conf -font $uifont
690 .tf.lbar.vhl conf -font $uifont
691 pack .tf.lbar.vhl -side left -fill y
692 label .tf.lbar.rlabel -text " OR " -font $uifont
693 pack .tf.lbar.rlabel -side left -fill y
694 global highlight_related
695 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
696 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
697 $m conf -font $uifont
698 .tf.lbar.relm conf -font $uifont
699 trace add variable highlight_related write vrel_change
700 pack .tf.lbar.relm -side left -fill y
702 # Finish putting the upper half of the viewer together
703 pack .tf.lbar -in .tf -side bottom -fill x
704 pack .tf.bar -in .tf -side bottom -fill x
705 pack .tf.histframe -fill both -side top -expand 1
707 .ctop paneconfigure .tf -height $geometry(topheight)
708 .ctop paneconfigure .tf -width $geometry(topwidth)
710 # now build up the bottom
711 panedwindow .pwbottom -orient horizontal
713 # lower left, a text box over search bar, scroll bar to the right
714 # if we know window height, then that will set the lower text height, otherwise
715 # we set lower text height which will drive window height
716 if {[info exists geometry(main)]} {
717 frame .bleft -width $geometry(botwidth)
719 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
724 button .bleft.top.search -text "Search" -command dosearch \
726 pack .bleft.top.search -side left -padx 5
727 set sstring .bleft.top.sstring
728 entry $sstring -width 20 -font $textfont -textvariable searchstring
729 lappend entries $sstring
730 trace add variable searchstring write incrsearch
731 pack $sstring -side left -expand 1 -fill x
732 radiobutton .bleft.mid.diff -text "Diff" \
733 -command changediffdisp -variable diffelide -value {0 0}
734 radiobutton .bleft.mid.old -text "Old version" \
735 -command changediffdisp -variable diffelide -value {0 1}
736 radiobutton .bleft.mid.new -text "New version" \
737 -command changediffdisp -variable diffelide -value {1 0}
738 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
740 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
741 spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
742 -from 1 -increment 1 -to 10000000 \
743 -validate all -validatecommand "diffcontextvalidate %P" \
744 -textvariable diffcontextstring
745 .bleft.mid.diffcontext set $diffcontext
746 trace add variable diffcontextstring write diffcontextchange
747 lappend entries .bleft.mid.diffcontext
748 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
749 set ctext .bleft.ctext
750 text $ctext -background $bgcolor -foreground $fgcolor \
751 -tabs "[expr {$tabstop * $charspc}]" \
752 -state disabled -font $textfont \
753 -yscrollcommand scrolltext -wrap none
754 scrollbar .bleft.sb -command "$ctext yview"
755 pack .bleft.top -side top -fill x
756 pack .bleft.mid -side top -fill x
757 pack .bleft.sb -side right -fill y
758 pack $ctext -side left -fill both -expand 1
759 lappend bglist $ctext
760 lappend fglist $ctext
762 $ctext tag conf comment -wrap $wrapcomment
763 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
764 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
765 $ctext tag conf d0 -fore [lindex $diffcolors 0]
766 $ctext tag conf d1 -fore [lindex $diffcolors 1]
767 $ctext tag conf m0 -fore red
768 $ctext tag conf m1 -fore blue
769 $ctext tag conf m2 -fore green
770 $ctext tag conf m3 -fore purple
771 $ctext tag conf m4 -fore brown
772 $ctext tag conf m5 -fore "#009090"
773 $ctext tag conf m6 -fore magenta
774 $ctext tag conf m7 -fore "#808000"
775 $ctext tag conf m8 -fore "#009000"
776 $ctext tag conf m9 -fore "#ff0080"
777 $ctext tag conf m10 -fore cyan
778 $ctext tag conf m11 -fore "#b07070"
779 $ctext tag conf m12 -fore "#70b0f0"
780 $ctext tag conf m13 -fore "#70f0b0"
781 $ctext tag conf m14 -fore "#f0b070"
782 $ctext tag conf m15 -fore "#ff70b0"
783 $ctext tag conf mmax -fore darkgrey
785 $ctext tag conf mresult -font [concat $textfont bold]
786 $ctext tag conf msep -font [concat $textfont bold]
787 $ctext tag conf found -back yellow
790 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
795 radiobutton .bright.mode.patch -text "Patch" \
796 -command reselectline -variable cmitmode -value "patch"
797 .bright.mode.patch configure -font $uifont
798 radiobutton .bright.mode.tree -text "Tree" \
799 -command reselectline -variable cmitmode -value "tree"
800 .bright.mode.tree configure -font $uifont
801 grid .bright.mode.patch .bright.mode.tree -sticky ew
802 pack .bright.mode -side top -fill x
803 set cflist .bright.cfiles
804 set indent [font measure $mainfont "nn"]
806 -selectbackground $selectbgcolor \
807 -background $bgcolor -foreground $fgcolor \
809 -tabs [list $indent [expr {2 * $indent}]] \
810 -yscrollcommand ".bright.sb set" \
811 -cursor [. cget -cursor] \
812 -spacing1 1 -spacing3 1
813 lappend bglist $cflist
814 lappend fglist $cflist
815 scrollbar .bright.sb -command "$cflist yview"
816 pack .bright.sb -side right -fill y
817 pack $cflist -side left -fill both -expand 1
818 $cflist tag configure highlight \
819 -background [$cflist cget -selectbackground]
820 $cflist tag configure bold -font [concat $mainfont bold]
822 .pwbottom add .bright
825 # restore window position if known
826 if {[info exists geometry(main)]} {
827 wm geometry . "$geometry(main)"
830 if {[tk windowingsystem] eq {aqua}} {
836 bind .pwbottom <Configure> {resizecdetpanes %W %w}
837 pack .ctop -fill both -expand 1
838 bindall <1> {selcanvline %W %x %y}
839 #bindall <B1-Motion> {selcanvline %W %x %y}
840 if {[tk windowingsystem] == "win32"} {
841 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
842 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
844 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
845 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
847 bindall <2> "canvscan mark %W %x %y"
848 bindall <B2-Motion> "canvscan dragto %W %x %y"
849 bindkey <Home> selfirstline
850 bindkey <End> sellastline
851 bind . <Key-Up> "selnextline -1"
852 bind . <Key-Down> "selnextline 1"
853 bind . <Shift-Key-Up> "next_highlight -1"
854 bind . <Shift-Key-Down> "next_highlight 1"
855 bindkey <Key-Right> "goforw"
856 bindkey <Key-Left> "goback"
857 bind . <Key-Prior> "selnextpage -1"
858 bind . <Key-Next> "selnextpage 1"
859 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
860 bind . <$M1B-End> "allcanvs yview moveto 1.0"
861 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
862 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
863 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
864 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
865 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
866 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
867 bindkey <Key-space> "$ctext yview scroll 1 pages"
868 bindkey p "selnextline -1"
869 bindkey n "selnextline 1"
872 bindkey i "selnextline -1"
873 bindkey k "selnextline 1"
876 bindkey b "$ctext yview scroll -1 pages"
877 bindkey d "$ctext yview scroll 18 units"
878 bindkey u "$ctext yview scroll -18 units"
879 bindkey / {findnext 1}
880 bindkey <Key-Return> {findnext 0}
883 bindkey <F5> updatecommits
884 bind . <$M1B-q> doquit
885 bind . <$M1B-f> dofind
886 bind . <$M1B-g> {findnext 0}
887 bind . <$M1B-r> dosearchback
888 bind . <$M1B-s> dosearch
889 bind . <$M1B-equal> {incrfont 1}
890 bind . <$M1B-KP_Add> {incrfont 1}
891 bind . <$M1B-minus> {incrfont -1}
892 bind . <$M1B-KP_Subtract> {incrfont -1}
893 wm protocol . WM_DELETE_WINDOW doquit
894 bind . <Button-1> "click %W"
895 bind $fstring <Key-Return> dofind
896 bind $sha1entry <Key-Return> gotocommit
897 bind $sha1entry <<PasteSelection>> clearsha1
898 bind $cflist <1> {sel_flist %W %x %y; break}
899 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
900 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
901 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
903 set maincursor [. cget -cursor]
904 set textcursor [$ctext cget -cursor]
905 set curtextcursor $textcursor
907 set rowctxmenu .rowctxmenu
908 menu $rowctxmenu -tearoff 0
909 $rowctxmenu add command -label "Diff this -> selected" \
910 -command {diffvssel 0}
911 $rowctxmenu add command -label "Diff selected -> this" \
912 -command {diffvssel 1}
913 $rowctxmenu add command -label "Make patch" -command mkpatch
914 $rowctxmenu add command -label "Create tag" -command mktag
915 $rowctxmenu add command -label "Write commit to file" -command writecommit
916 $rowctxmenu add command -label "Create new branch" -command mkbranch
917 $rowctxmenu add command -label "Cherry-pick this commit" \
919 $rowctxmenu add command -label "Reset HEAD branch to here" \
922 set fakerowmenu .fakerowmenu
923 menu $fakerowmenu -tearoff 0
924 $fakerowmenu add command -label "Diff this -> selected" \
925 -command {diffvssel 0}
926 $fakerowmenu add command -label "Diff selected -> this" \
927 -command {diffvssel 1}
928 $fakerowmenu add command -label "Make patch" -command mkpatch
929 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
930 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
931 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
933 set headctxmenu .headctxmenu
934 menu $headctxmenu -tearoff 0
935 $headctxmenu add command -label "Check out this branch" \
937 $headctxmenu add command -label "Remove this branch" \
941 set flist_menu .flistctxmenu
942 menu $flist_menu -tearoff 0
943 $flist_menu add command -label "Highlight this too" \
944 -command {flist_hl 0}
945 $flist_menu add command -label "Highlight this only" \
946 -command {flist_hl 1}
949 # Windows sends all mouse wheel events to the current focused window, not
950 # the one where the mouse hovers, so bind those events here and redirect
951 # to the correct window
952 proc windows_mousewheel_redirector {W X Y D} {
953 global canv canv2 canv3
954 set w [winfo containing -displayof $W $X $Y]
956 set u [expr {$D < 0 ? 5 : -5}]
957 if {$w == $canv || $w == $canv2 || $w == $canv3} {
958 allcanvs yview scroll $u units
961 $w yview scroll $u units
967 # mouse-2 makes all windows scan vertically, but only the one
968 # the cursor is in scans horizontally
969 proc canvscan {op w x y} {
970 global canv canv2 canv3
971 foreach c [list $canv $canv2 $canv3] {
980 proc scrollcanv {cscroll f0 f1} {
986 # when we make a key binding for the toplevel, make sure
987 # it doesn't get triggered when that key is pressed in the
988 # find string entry widget.
989 proc bindkey {ev script} {
992 set escript [bind Entry $ev]
993 if {$escript == {}} {
994 set escript [bind Entry <Key>]
997 bind $e $ev "$escript; break"
1001 # set the focus back to the toplevel for any click outside
1004 global ctext entries
1005 foreach e [concat $entries $ctext] {
1006 if {$w == $e} return
1011 proc savestuff {w} {
1012 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1013 global stuffsaved findmergefiles maxgraphpct
1014 global maxwidth showneartags showlocalchanges
1015 global viewname viewfiles viewargs viewperm nextviewnum
1016 global cmitmode wrapcomment datetimeformat
1017 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1019 if {$stuffsaved} return
1020 if {![winfo viewable .]} return
1022 set f [open "~/.gitk-new" w]
1023 puts $f [list set mainfont $mainfont]
1024 puts $f [list set textfont $textfont]
1025 puts $f [list set uifont $uifont]
1026 puts $f [list set tabstop $tabstop]
1027 puts $f [list set findmergefiles $findmergefiles]
1028 puts $f [list set maxgraphpct $maxgraphpct]
1029 puts $f [list set maxwidth $maxwidth]
1030 puts $f [list set cmitmode $cmitmode]
1031 puts $f [list set wrapcomment $wrapcomment]
1032 puts $f [list set showneartags $showneartags]
1033 puts $f [list set showlocalchanges $showlocalchanges]
1034 puts $f [list set datetimeformat $datetimeformat]
1035 puts $f [list set bgcolor $bgcolor]
1036 puts $f [list set fgcolor $fgcolor]
1037 puts $f [list set colors $colors]
1038 puts $f [list set diffcolors $diffcolors]
1039 puts $f [list set diffcontext $diffcontext]
1040 puts $f [list set selectbgcolor $selectbgcolor]
1042 puts $f "set geometry(main) [wm geometry .]"
1043 puts $f "set geometry(topwidth) [winfo width .tf]"
1044 puts $f "set geometry(topheight) [winfo height .tf]"
1045 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1046 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1047 puts $f "set geometry(botwidth) [winfo width .bleft]"
1048 puts $f "set geometry(botheight) [winfo height .bleft]"
1050 puts -nonewline $f "set permviews {"
1051 for {set v 0} {$v < $nextviewnum} {incr v} {
1052 if {$viewperm($v)} {
1053 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1058 file rename -force "~/.gitk-new" "~/.gitk"
1063 proc resizeclistpanes {win w} {
1065 if {[info exists oldwidth($win)]} {
1066 set s0 [$win sash coord 0]
1067 set s1 [$win sash coord 1]
1069 set sash0 [expr {int($w/2 - 2)}]
1070 set sash1 [expr {int($w*5/6 - 2)}]
1072 set factor [expr {1.0 * $w / $oldwidth($win)}]
1073 set sash0 [expr {int($factor * [lindex $s0 0])}]
1074 set sash1 [expr {int($factor * [lindex $s1 0])}]
1078 if {$sash1 < $sash0 + 20} {
1079 set sash1 [expr {$sash0 + 20}]
1081 if {$sash1 > $w - 10} {
1082 set sash1 [expr {$w - 10}]
1083 if {$sash0 > $sash1 - 20} {
1084 set sash0 [expr {$sash1 - 20}]
1088 $win sash place 0 $sash0 [lindex $s0 1]
1089 $win sash place 1 $sash1 [lindex $s1 1]
1091 set oldwidth($win) $w
1094 proc resizecdetpanes {win w} {
1096 if {[info exists oldwidth($win)]} {
1097 set s0 [$win sash coord 0]
1099 set sash0 [expr {int($w*3/4 - 2)}]
1101 set factor [expr {1.0 * $w / $oldwidth($win)}]
1102 set sash0 [expr {int($factor * [lindex $s0 0])}]
1106 if {$sash0 > $w - 15} {
1107 set sash0 [expr {$w - 15}]
1110 $win sash place 0 $sash0 [lindex $s0 1]
1112 set oldwidth($win) $w
1115 proc allcanvs args {
1116 global canv canv2 canv3
1122 proc bindall {event action} {
1123 global canv canv2 canv3
1124 bind $canv $event $action
1125 bind $canv2 $event $action
1126 bind $canv3 $event $action
1132 if {[winfo exists $w]} {
1137 wm title $w "About gitk"
1138 message $w.m -text {
1139 Gitk - a commit viewer for git
1141 Copyright © 2005-2006 Paul Mackerras
1143 Use and redistribute under the terms of the GNU General Public License} \
1144 -justify center -aspect 400 -border 2 -bg white -relief groove
1145 pack $w.m -side top -fill x -padx 2 -pady 2
1146 $w.m configure -font $uifont
1147 button $w.ok -text Close -command "destroy $w" -default active
1148 pack $w.ok -side bottom
1149 $w.ok configure -font $uifont
1150 bind $w <Visibility> "focus $w.ok"
1151 bind $w <Key-Escape> "destroy $w"
1152 bind $w <Key-Return> "destroy $w"
1158 if {[winfo exists $w]} {
1162 if {[tk windowingsystem] eq {aqua}} {
1168 wm title $w "Gitk key bindings"
1169 message $w.m -text "
1173 <Home> Move to first commit
1174 <End> Move to last commit
1175 <Up>, p, i Move up one commit
1176 <Down>, n, k Move down one commit
1177 <Left>, z, j Go back in history list
1178 <Right>, x, l Go forward in history list
1179 <PageUp> Move up one page in commit list
1180 <PageDown> Move down one page in commit list
1181 <$M1T-Home> Scroll to top of commit list
1182 <$M1T-End> Scroll to bottom of commit list
1183 <$M1T-Up> Scroll commit list up one line
1184 <$M1T-Down> Scroll commit list down one line
1185 <$M1T-PageUp> Scroll commit list up one page
1186 <$M1T-PageDown> Scroll commit list down one page
1187 <Shift-Up> Move to previous highlighted line
1188 <Shift-Down> Move to next highlighted line
1189 <Delete>, b Scroll diff view up one page
1190 <Backspace> Scroll diff view up one page
1191 <Space> Scroll diff view down one page
1192 u Scroll diff view up 18 lines
1193 d Scroll diff view down 18 lines
1195 <$M1T-G> Move to next find hit
1196 <Return> Move to next find hit
1197 / Move to next find hit, or redo find
1198 ? Move to previous find hit
1199 f Scroll diff view to next file
1200 <$M1T-S> Search for next hit in diff view
1201 <$M1T-R> Search for previous hit in diff view
1202 <$M1T-KP+> Increase font size
1203 <$M1T-plus> Increase font size
1204 <$M1T-KP-> Decrease font size
1205 <$M1T-minus> Decrease font size
1208 -justify left -bg white -border 2 -relief groove
1209 pack $w.m -side top -fill both -padx 2 -pady 2
1210 $w.m configure -font $uifont
1211 button $w.ok -text Close -command "destroy $w" -default active
1212 pack $w.ok -side bottom
1213 $w.ok configure -font $uifont
1214 bind $w <Visibility> "focus $w.ok"
1215 bind $w <Key-Escape> "destroy $w"
1216 bind $w <Key-Return> "destroy $w"
1219 # Procedures for manipulating the file list window at the
1220 # bottom right of the overall window.
1222 proc treeview {w l openlevs} {
1223 global treecontents treediropen treeheight treeparent treeindex
1233 set treecontents() {}
1234 $w conf -state normal
1236 while {[string range $f 0 $prefixend] ne $prefix} {
1237 if {$lev <= $openlevs} {
1238 $w mark set e:$treeindex($prefix) "end -1c"
1239 $w mark gravity e:$treeindex($prefix) left
1241 set treeheight($prefix) $ht
1242 incr ht [lindex $htstack end]
1243 set htstack [lreplace $htstack end end]
1244 set prefixend [lindex $prefendstack end]
1245 set prefendstack [lreplace $prefendstack end end]
1246 set prefix [string range $prefix 0 $prefixend]
1249 set tail [string range $f [expr {$prefixend+1}] end]
1250 while {[set slash [string first "/" $tail]] >= 0} {
1253 lappend prefendstack $prefixend
1254 incr prefixend [expr {$slash + 1}]
1255 set d [string range $tail 0 $slash]
1256 lappend treecontents($prefix) $d
1257 set oldprefix $prefix
1259 set treecontents($prefix) {}
1260 set treeindex($prefix) [incr ix]
1261 set treeparent($prefix) $oldprefix
1262 set tail [string range $tail [expr {$slash+1}] end]
1263 if {$lev <= $openlevs} {
1265 set treediropen($prefix) [expr {$lev < $openlevs}]
1266 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1267 $w mark set d:$ix "end -1c"
1268 $w mark gravity d:$ix left
1270 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1272 $w image create end -align center -image $bm -padx 1 \
1274 $w insert end $d [highlight_tag $prefix]
1275 $w mark set s:$ix "end -1c"
1276 $w mark gravity s:$ix left
1281 if {$lev <= $openlevs} {
1284 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1286 $w insert end $tail [highlight_tag $f]
1288 lappend treecontents($prefix) $tail
1291 while {$htstack ne {}} {
1292 set treeheight($prefix) $ht
1293 incr ht [lindex $htstack end]
1294 set htstack [lreplace $htstack end end]
1295 set prefixend [lindex $prefendstack end]
1296 set prefendstack [lreplace $prefendstack end end]
1297 set prefix [string range $prefix 0 $prefixend]
1299 $w conf -state disabled
1302 proc linetoelt {l} {
1303 global treeheight treecontents
1308 foreach e $treecontents($prefix) {
1313 if {[string index $e end] eq "/"} {
1314 set n $treeheight($prefix$e)
1326 proc highlight_tree {y prefix} {
1327 global treeheight treecontents cflist
1329 foreach e $treecontents($prefix) {
1331 if {[highlight_tag $path] ne {}} {
1332 $cflist tag add bold $y.0 "$y.0 lineend"
1335 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1336 set y [highlight_tree $y $path]
1342 proc treeclosedir {w dir} {
1343 global treediropen treeheight treeparent treeindex
1345 set ix $treeindex($dir)
1346 $w conf -state normal
1347 $w delete s:$ix e:$ix
1348 set treediropen($dir) 0
1349 $w image configure a:$ix -image tri-rt
1350 $w conf -state disabled
1351 set n [expr {1 - $treeheight($dir)}]
1352 while {$dir ne {}} {
1353 incr treeheight($dir) $n
1354 set dir $treeparent($dir)
1358 proc treeopendir {w dir} {
1359 global treediropen treeheight treeparent treecontents treeindex
1361 set ix $treeindex($dir)
1362 $w conf -state normal
1363 $w image configure a:$ix -image tri-dn
1364 $w mark set e:$ix s:$ix
1365 $w mark gravity e:$ix right
1368 set n [llength $treecontents($dir)]
1369 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1372 incr treeheight($x) $n
1374 foreach e $treecontents($dir) {
1376 if {[string index $e end] eq "/"} {
1377 set iy $treeindex($de)
1378 $w mark set d:$iy e:$ix
1379 $w mark gravity d:$iy left
1380 $w insert e:$ix $str
1381 set treediropen($de) 0
1382 $w image create e:$ix -align center -image tri-rt -padx 1 \
1384 $w insert e:$ix $e [highlight_tag $de]
1385 $w mark set s:$iy e:$ix
1386 $w mark gravity s:$iy left
1387 set treeheight($de) 1
1389 $w insert e:$ix $str
1390 $w insert e:$ix $e [highlight_tag $de]
1393 $w mark gravity e:$ix left
1394 $w conf -state disabled
1395 set treediropen($dir) 1
1396 set top [lindex [split [$w index @0,0] .] 0]
1397 set ht [$w cget -height]
1398 set l [lindex [split [$w index s:$ix] .] 0]
1401 } elseif {$l + $n + 1 > $top + $ht} {
1402 set top [expr {$l + $n + 2 - $ht}]
1410 proc treeclick {w x y} {
1411 global treediropen cmitmode ctext cflist cflist_top
1413 if {$cmitmode ne "tree"} return
1414 if {![info exists cflist_top]} return
1415 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1416 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1417 $cflist tag add highlight $l.0 "$l.0 lineend"
1423 set e [linetoelt $l]
1424 if {[string index $e end] ne "/"} {
1426 } elseif {$treediropen($e)} {
1433 proc setfilelist {id} {
1434 global treefilelist cflist
1436 treeview $cflist $treefilelist($id) 0
1439 image create bitmap tri-rt -background black -foreground blue -data {
1440 #define tri-rt_width 13
1441 #define tri-rt_height 13
1442 static unsigned char tri-rt_bits[] = {
1443 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1444 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1447 #define tri-rt-mask_width 13
1448 #define tri-rt-mask_height 13
1449 static unsigned char tri-rt-mask_bits[] = {
1450 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1451 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1454 image create bitmap tri-dn -background black -foreground blue -data {
1455 #define tri-dn_width 13
1456 #define tri-dn_height 13
1457 static unsigned char tri-dn_bits[] = {
1458 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1459 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1462 #define tri-dn-mask_width 13
1463 #define tri-dn-mask_height 13
1464 static unsigned char tri-dn-mask_bits[] = {
1465 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1466 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1470 image create bitmap reficon-T -background black -foreground yellow -data {
1471 #define tagicon_width 13
1472 #define tagicon_height 9
1473 static unsigned char tagicon_bits[] = {
1474 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1475 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1477 #define tagicon-mask_width 13
1478 #define tagicon-mask_height 9
1479 static unsigned char tagicon-mask_bits[] = {
1480 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1481 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1484 #define headicon_width 13
1485 #define headicon_height 9
1486 static unsigned char headicon_bits[] = {
1487 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1488 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1491 #define headicon-mask_width 13
1492 #define headicon-mask_height 9
1493 static unsigned char headicon-mask_bits[] = {
1494 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1495 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1497 image create bitmap reficon-H -background black -foreground green \
1498 -data $rectdata -maskdata $rectmask
1499 image create bitmap reficon-o -background black -foreground "#ddddff" \
1500 -data $rectdata -maskdata $rectmask
1502 proc init_flist {first} {
1503 global cflist cflist_top selectedline difffilestart
1505 $cflist conf -state normal
1506 $cflist delete 0.0 end
1508 $cflist insert end $first
1510 $cflist tag add highlight 1.0 "1.0 lineend"
1512 catch {unset cflist_top}
1514 $cflist conf -state disabled
1515 set difffilestart {}
1518 proc highlight_tag {f} {
1519 global highlight_paths
1521 foreach p $highlight_paths {
1522 if {[string match $p $f]} {
1529 proc highlight_filelist {} {
1530 global cmitmode cflist
1532 $cflist conf -state normal
1533 if {$cmitmode ne "tree"} {
1534 set end [lindex [split [$cflist index end] .] 0]
1535 for {set l 2} {$l < $end} {incr l} {
1536 set line [$cflist get $l.0 "$l.0 lineend"]
1537 if {[highlight_tag $line] ne {}} {
1538 $cflist tag add bold $l.0 "$l.0 lineend"
1544 $cflist conf -state disabled
1547 proc unhighlight_filelist {} {
1550 $cflist conf -state normal
1551 $cflist tag remove bold 1.0 end
1552 $cflist conf -state disabled
1555 proc add_flist {fl} {
1558 $cflist conf -state normal
1560 $cflist insert end "\n"
1561 $cflist insert end $f [highlight_tag $f]
1563 $cflist conf -state disabled
1566 proc sel_flist {w x y} {
1567 global ctext difffilestart cflist cflist_top cmitmode
1569 if {$cmitmode eq "tree"} return
1570 if {![info exists cflist_top]} return
1571 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1572 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1573 $cflist tag add highlight $l.0 "$l.0 lineend"
1578 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1582 proc pop_flist_menu {w X Y x y} {
1583 global ctext cflist cmitmode flist_menu flist_menu_file
1584 global treediffs diffids
1586 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1588 if {$cmitmode eq "tree"} {
1589 set e [linetoelt $l]
1590 if {[string index $e end] eq "/"} return
1592 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1594 set flist_menu_file $e
1595 tk_popup $flist_menu $X $Y
1598 proc flist_hl {only} {
1599 global flist_menu_file highlight_files
1601 set x [shellquote $flist_menu_file]
1602 if {$only || $highlight_files eq {}} {
1603 set highlight_files $x
1605 append highlight_files " " $x
1609 # Functions for adding and removing shell-type quoting
1611 proc shellquote {str} {
1612 if {![string match "*\['\"\\ \t]*" $str]} {
1615 if {![string match "*\['\"\\]*" $str]} {
1618 if {![string match "*'*" $str]} {
1621 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1624 proc shellarglist {l} {
1630 append str [shellquote $a]
1635 proc shelldequote {str} {
1640 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1641 append ret [string range $str $used end]
1642 set used [string length $str]
1645 set first [lindex $first 0]
1646 set ch [string index $str $first]
1647 if {$first > $used} {
1648 append ret [string range $str $used [expr {$first - 1}]]
1651 if {$ch eq " " || $ch eq "\t"} break
1654 set first [string first "'" $str $used]
1656 error "unmatched single-quote"
1658 append ret [string range $str $used [expr {$first - 1}]]
1663 if {$used >= [string length $str]} {
1664 error "trailing backslash"
1666 append ret [string index $str $used]
1671 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1672 error "unmatched double-quote"
1674 set first [lindex $first 0]
1675 set ch [string index $str $first]
1676 if {$first > $used} {
1677 append ret [string range $str $used [expr {$first - 1}]]
1680 if {$ch eq "\""} break
1682 append ret [string index $str $used]
1686 return [list $used $ret]
1689 proc shellsplit {str} {
1692 set str [string trimleft $str]
1693 if {$str eq {}} break
1694 set dq [shelldequote $str]
1695 set n [lindex $dq 0]
1696 set word [lindex $dq 1]
1697 set str [string range $str $n end]
1703 # Code to implement multiple views
1705 proc newview {ishighlight} {
1706 global nextviewnum newviewname newviewperm uifont newishighlight
1707 global newviewargs revtreeargs
1709 set newishighlight $ishighlight
1711 if {[winfo exists $top]} {
1715 set newviewname($nextviewnum) "View $nextviewnum"
1716 set newviewperm($nextviewnum) 0
1717 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1718 vieweditor $top $nextviewnum "Gitk view definition"
1723 global viewname viewperm newviewname newviewperm
1724 global viewargs newviewargs
1726 set top .gitkvedit-$curview
1727 if {[winfo exists $top]} {
1731 set newviewname($curview) $viewname($curview)
1732 set newviewperm($curview) $viewperm($curview)
1733 set newviewargs($curview) [shellarglist $viewargs($curview)]
1734 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1737 proc vieweditor {top n title} {
1738 global newviewname newviewperm viewfiles
1742 wm title $top $title
1743 label $top.nl -text "Name" -font $uifont
1744 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1745 grid $top.nl $top.name -sticky w -pady 5
1746 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1748 grid $top.perm - -pady 5 -sticky w
1749 message $top.al -aspect 1000 -font $uifont \
1750 -text "Commits to include (arguments to git rev-list):"
1751 grid $top.al - -sticky w -pady 5
1752 entry $top.args -width 50 -textvariable newviewargs($n) \
1753 -background white -font $uifont
1754 grid $top.args - -sticky ew -padx 5
1755 message $top.l -aspect 1000 -font $uifont \
1756 -text "Enter files and directories to include, one per line:"
1757 grid $top.l - -sticky w
1758 text $top.t -width 40 -height 10 -background white -font $uifont
1759 if {[info exists viewfiles($n)]} {
1760 foreach f $viewfiles($n) {
1761 $top.t insert end $f
1762 $top.t insert end "\n"
1764 $top.t delete {end - 1c} end
1765 $top.t mark set insert 0.0
1767 grid $top.t - -sticky ew -padx 5
1769 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1771 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1773 grid $top.buts.ok $top.buts.can
1774 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1775 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1776 grid $top.buts - -pady 10 -sticky ew
1780 proc doviewmenu {m first cmd op argv} {
1781 set nmenu [$m index end]
1782 for {set i $first} {$i <= $nmenu} {incr i} {
1783 if {[$m entrycget $i -command] eq $cmd} {
1784 eval $m $op $i $argv
1790 proc allviewmenus {n op args} {
1793 doviewmenu .bar.view 5 [list showview $n] $op $args
1794 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1797 proc newviewok {top n} {
1798 global nextviewnum newviewperm newviewname newishighlight
1799 global viewname viewfiles viewperm selectedview curview
1800 global viewargs newviewargs viewhlmenu
1803 set newargs [shellsplit $newviewargs($n)]
1805 error_popup "Error in commit selection arguments: $err"
1811 foreach f [split [$top.t get 0.0 end] "\n"] {
1812 set ft [string trim $f]
1817 if {![info exists viewfiles($n)]} {
1818 # creating a new view
1820 set viewname($n) $newviewname($n)
1821 set viewperm($n) $newviewperm($n)
1822 set viewfiles($n) $files
1823 set viewargs($n) $newargs
1825 if {!$newishighlight} {
1828 run addvhighlight $n
1831 # editing an existing view
1832 set viewperm($n) $newviewperm($n)
1833 if {$newviewname($n) ne $viewname($n)} {
1834 set viewname($n) $newviewname($n)
1835 doviewmenu .bar.view 5 [list showview $n] \
1836 entryconf [list -label $viewname($n)]
1837 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1838 entryconf [list -label $viewname($n) -value $viewname($n)]
1840 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1841 set viewfiles($n) $files
1842 set viewargs($n) $newargs
1843 if {$curview == $n} {
1848 catch {destroy $top}
1852 global curview viewdata viewperm hlview selectedhlview
1854 if {$curview == 0} return
1855 if {[info exists hlview] && $hlview == $curview} {
1856 set selectedhlview None
1859 allviewmenus $curview delete
1860 set viewdata($curview) {}
1861 set viewperm($curview) 0
1865 proc addviewmenu {n} {
1866 global viewname viewhlmenu
1868 .bar.view add radiobutton -label $viewname($n) \
1869 -command [list showview $n] -variable selectedview -value $n
1870 $viewhlmenu add radiobutton -label $viewname($n) \
1871 -command [list addvhighlight $n] -variable selectedhlview
1874 proc flatten {var} {
1878 foreach i [array names $var] {
1879 lappend ret $i [set $var\($i\)]
1884 proc unflatten {var l} {
1894 global curview viewdata viewfiles
1895 global displayorder parentlist rowidlist rowoffsets
1896 global colormap rowtextx commitrow nextcolor canvxmax
1897 global numcommits rowrangelist commitlisted idrowranges rowchk
1898 global selectedline currentid canv canvy0
1900 global pending_select phase
1901 global commitidx rowlaidout rowoptim
1903 global selectedview selectfirst
1904 global vparentlist vdisporder vcmitlisted
1905 global hlview selectedhlview
1907 if {$n == $curview} return
1909 if {[info exists selectedline]} {
1910 set selid $currentid
1911 set y [yc $selectedline]
1912 set ymax [lindex [$canv cget -scrollregion] 3]
1913 set span [$canv yview]
1914 set ytop [expr {[lindex $span 0] * $ymax}]
1915 set ybot [expr {[lindex $span 1] * $ymax}]
1916 if {$ytop < $y && $y < $ybot} {
1917 set yscreen [expr {$y - $ytop}]
1919 set yscreen [expr {($ybot - $ytop) / 2}]
1921 } elseif {[info exists pending_select]} {
1922 set selid $pending_select
1923 unset pending_select
1927 if {$curview >= 0} {
1928 set vparentlist($curview) $parentlist
1929 set vdisporder($curview) $displayorder
1930 set vcmitlisted($curview) $commitlisted
1932 set viewdata($curview) \
1933 [list $phase $rowidlist $rowoffsets $rowrangelist \
1934 [flatten idrowranges] [flatten idinlist] \
1935 $rowlaidout $rowoptim $numcommits]
1936 } elseif {![info exists viewdata($curview)]
1937 || [lindex $viewdata($curview) 0] ne {}} {
1938 set viewdata($curview) \
1939 [list {} $rowidlist $rowoffsets $rowrangelist]
1942 catch {unset treediffs}
1944 if {[info exists hlview] && $hlview == $n} {
1946 set selectedhlview None
1951 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1952 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1954 if {![info exists viewdata($n)]} {
1956 set pending_select $selid
1963 set phase [lindex $v 0]
1964 set displayorder $vdisporder($n)
1965 set parentlist $vparentlist($n)
1966 set commitlisted $vcmitlisted($n)
1967 set rowidlist [lindex $v 1]
1968 set rowoffsets [lindex $v 2]
1969 set rowrangelist [lindex $v 3]
1971 set numcommits [llength $displayorder]
1972 catch {unset idrowranges}
1974 unflatten idrowranges [lindex $v 4]
1975 unflatten idinlist [lindex $v 5]
1976 set rowlaidout [lindex $v 6]
1977 set rowoptim [lindex $v 7]
1978 set numcommits [lindex $v 8]
1979 catch {unset rowchk}
1982 catch {unset colormap}
1983 catch {unset rowtextx}
1985 set canvxmax [$canv cget -width]
1992 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1993 set row $commitrow($n,$selid)
1994 # try to get the selected row in the same position on the screen
1995 set ymax [lindex [$canv cget -scrollregion] 3]
1996 set ytop [expr {[yc $row] - $yscreen}]
2000 set yf [expr {$ytop * 1.0 / $ymax}]
2002 allcanvs yview moveto $yf
2006 } elseif {$selid ne {}} {
2007 set pending_select $selid
2009 set row [first_real_row]
2010 if {$row < $numcommits} {
2017 if {$phase eq "getcommits"} {
2018 show_status "Reading commits..."
2021 } elseif {$numcommits == 0} {
2022 show_status "No commits selected"
2027 # Stuff relating to the highlighting facility
2029 proc ishighlighted {row} {
2030 global vhighlights fhighlights nhighlights rhighlights
2032 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2033 return $nhighlights($row)
2035 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2036 return $vhighlights($row)
2038 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2039 return $fhighlights($row)
2041 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2042 return $rhighlights($row)
2047 proc bolden {row font} {
2048 global canv linehtag selectedline boldrows
2050 lappend boldrows $row
2051 $canv itemconf $linehtag($row) -font $font
2052 if {[info exists selectedline] && $row == $selectedline} {
2054 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2055 -outline {{}} -tags secsel \
2056 -fill [$canv cget -selectbackground]]
2061 proc bolden_name {row font} {
2062 global canv2 linentag selectedline boldnamerows
2064 lappend boldnamerows $row
2065 $canv2 itemconf $linentag($row) -font $font
2066 if {[info exists selectedline] && $row == $selectedline} {
2067 $canv2 delete secsel
2068 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2069 -outline {{}} -tags secsel \
2070 -fill [$canv2 cget -selectbackground]]
2076 global mainfont boldrows
2079 foreach row $boldrows {
2080 if {![ishighlighted $row]} {
2081 bolden $row $mainfont
2083 lappend stillbold $row
2086 set boldrows $stillbold
2089 proc addvhighlight {n} {
2090 global hlview curview viewdata vhl_done vhighlights commitidx
2092 if {[info exists hlview]} {
2096 if {$n != $curview && ![info exists viewdata($n)]} {
2097 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
2098 set vparentlist($n) {}
2099 set vdisporder($n) {}
2100 set vcmitlisted($n) {}
2103 set vhl_done $commitidx($hlview)
2104 if {$vhl_done > 0} {
2109 proc delvhighlight {} {
2110 global hlview vhighlights
2112 if {![info exists hlview]} return
2114 catch {unset vhighlights}
2118 proc vhighlightmore {} {
2119 global hlview vhl_done commitidx vhighlights
2120 global displayorder vdisporder curview mainfont
2122 set font [concat $mainfont bold]
2123 set max $commitidx($hlview)
2124 if {$hlview == $curview} {
2125 set disp $displayorder
2127 set disp $vdisporder($hlview)
2129 set vr [visiblerows]
2130 set r0 [lindex $vr 0]
2131 set r1 [lindex $vr 1]
2132 for {set i $vhl_done} {$i < $max} {incr i} {
2133 set id [lindex $disp $i]
2134 if {[info exists commitrow($curview,$id)]} {
2135 set row $commitrow($curview,$id)
2136 if {$r0 <= $row && $row <= $r1} {
2137 if {![highlighted $row]} {
2140 set vhighlights($row) 1
2147 proc askvhighlight {row id} {
2148 global hlview vhighlights commitrow iddrawn mainfont
2150 if {[info exists commitrow($hlview,$id)]} {
2151 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2152 bolden $row [concat $mainfont bold]
2154 set vhighlights($row) 1
2156 set vhighlights($row) 0
2160 proc hfiles_change {name ix op} {
2161 global highlight_files filehighlight fhighlights fh_serial
2162 global mainfont highlight_paths
2164 if {[info exists filehighlight]} {
2165 # delete previous highlights
2166 catch {close $filehighlight}
2168 catch {unset fhighlights}
2170 unhighlight_filelist
2172 set highlight_paths {}
2173 after cancel do_file_hl $fh_serial
2175 if {$highlight_files ne {}} {
2176 after 300 do_file_hl $fh_serial
2180 proc makepatterns {l} {
2183 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2184 if {[string index $ee end] eq "/"} {
2194 proc do_file_hl {serial} {
2195 global highlight_files filehighlight highlight_paths gdttype fhl_list
2197 if {$gdttype eq "touching paths:"} {
2198 if {[catch {set paths [shellsplit $highlight_files]}]} return
2199 set highlight_paths [makepatterns $paths]
2201 set gdtargs [concat -- $paths]
2203 set gdtargs [list "-S$highlight_files"]
2205 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2206 set filehighlight [open $cmd r+]
2207 fconfigure $filehighlight -blocking 0
2208 filerun $filehighlight readfhighlight
2214 proc flushhighlights {} {
2215 global filehighlight fhl_list
2217 if {[info exists filehighlight]} {
2219 puts $filehighlight ""
2220 flush $filehighlight
2224 proc askfilehighlight {row id} {
2225 global filehighlight fhighlights fhl_list
2227 lappend fhl_list $id
2228 set fhighlights($row) -1
2229 puts $filehighlight $id
2232 proc readfhighlight {} {
2233 global filehighlight fhighlights commitrow curview mainfont iddrawn
2236 if {![info exists filehighlight]} {
2240 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2241 set line [string trim $line]
2242 set i [lsearch -exact $fhl_list $line]
2243 if {$i < 0} continue
2244 for {set j 0} {$j < $i} {incr j} {
2245 set id [lindex $fhl_list $j]
2246 if {[info exists commitrow($curview,$id)]} {
2247 set fhighlights($commitrow($curview,$id)) 0
2250 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2251 if {$line eq {}} continue
2252 if {![info exists commitrow($curview,$line)]} continue
2253 set row $commitrow($curview,$line)
2254 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2255 bolden $row [concat $mainfont bold]
2257 set fhighlights($row) 1
2259 if {[eof $filehighlight]} {
2261 puts "oops, git diff-tree died"
2262 catch {close $filehighlight}
2270 proc find_change {name ix op} {
2271 global nhighlights mainfont boldnamerows
2272 global findstring findpattern findtype
2274 # delete previous highlights, if any
2275 foreach row $boldnamerows {
2276 bolden_name $row $mainfont
2279 catch {unset nhighlights}
2282 if {$findtype ne "Regexp"} {
2283 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2285 set findpattern "*$e*"
2290 proc doesmatch {f} {
2291 global findtype findstring findpattern
2293 if {$findtype eq "Regexp"} {
2294 return [regexp $findstring $f]
2295 } elseif {$findtype eq "IgnCase"} {
2296 return [string match -nocase $findpattern $f]
2298 return [string match $findpattern $f]
2302 proc askfindhighlight {row id} {
2303 global nhighlights commitinfo iddrawn mainfont
2305 global markingmatches
2307 if {![info exists commitinfo($id)]} {
2310 set info $commitinfo($id)
2312 set fldtypes {Headline Author Date Committer CDate Comments}
2313 foreach f $info ty $fldtypes {
2314 if {($findloc eq "All fields" || $findloc eq $ty) &&
2316 if {$ty eq "Author"} {
2323 if {$isbold && [info exists iddrawn($id)]} {
2324 set f [concat $mainfont bold]
2325 if {![ishighlighted $row]} {
2331 if {$markingmatches} {
2332 markrowmatches $row $id
2335 set nhighlights($row) $isbold
2338 proc markrowmatches {row id} {
2339 global canv canv2 linehtag linentag commitinfo findloc
2341 set headline [lindex $commitinfo($id) 0]
2342 set author [lindex $commitinfo($id) 1]
2343 $canv delete match$row
2344 $canv2 delete match$row
2345 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2346 set m [findmatches $headline]
2348 markmatches $canv $row $headline $linehtag($row) $m \
2349 [$canv itemcget $linehtag($row) -font] $row
2352 if {$findloc eq "All fields" || $findloc eq "Author"} {
2353 set m [findmatches $author]
2355 markmatches $canv2 $row $author $linentag($row) $m \
2356 [$canv2 itemcget $linentag($row) -font] $row
2361 proc vrel_change {name ix op} {
2362 global highlight_related
2365 if {$highlight_related ne "None"} {
2370 # prepare for testing whether commits are descendents or ancestors of a
2371 proc rhighlight_sel {a} {
2372 global descendent desc_todo ancestor anc_todo
2373 global highlight_related rhighlights
2375 catch {unset descendent}
2376 set desc_todo [list $a]
2377 catch {unset ancestor}
2378 set anc_todo [list $a]
2379 if {$highlight_related ne "None"} {
2385 proc rhighlight_none {} {
2388 catch {unset rhighlights}
2392 proc is_descendent {a} {
2393 global curview children commitrow descendent desc_todo
2396 set la $commitrow($v,$a)
2400 for {set i 0} {$i < [llength $todo]} {incr i} {
2401 set do [lindex $todo $i]
2402 if {$commitrow($v,$do) < $la} {
2403 lappend leftover $do
2406 foreach nk $children($v,$do) {
2407 if {![info exists descendent($nk)]} {
2408 set descendent($nk) 1
2416 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2420 set descendent($a) 0
2421 set desc_todo $leftover
2424 proc is_ancestor {a} {
2425 global curview parentlist commitrow ancestor anc_todo
2428 set la $commitrow($v,$a)
2432 for {set i 0} {$i < [llength $todo]} {incr i} {
2433 set do [lindex $todo $i]
2434 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2435 lappend leftover $do
2438 foreach np [lindex $parentlist $commitrow($v,$do)] {
2439 if {![info exists ancestor($np)]} {
2448 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2453 set anc_todo $leftover
2456 proc askrelhighlight {row id} {
2457 global descendent highlight_related iddrawn mainfont rhighlights
2458 global selectedline ancestor
2460 if {![info exists selectedline]} return
2462 if {$highlight_related eq "Descendent" ||
2463 $highlight_related eq "Not descendent"} {
2464 if {![info exists descendent($id)]} {
2467 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2470 } elseif {$highlight_related eq "Ancestor" ||
2471 $highlight_related eq "Not ancestor"} {
2472 if {![info exists ancestor($id)]} {
2475 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2479 if {[info exists iddrawn($id)]} {
2480 if {$isbold && ![ishighlighted $row]} {
2481 bolden $row [concat $mainfont bold]
2484 set rhighlights($row) $isbold
2487 proc next_hlcont {} {
2488 global fhl_row fhl_dirn displayorder numcommits
2489 global vhighlights fhighlights nhighlights rhighlights
2490 global hlview filehighlight findstring highlight_related
2492 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2495 if {$row < 0 || $row >= $numcommits} {
2500 set id [lindex $displayorder $row]
2501 if {[info exists hlview]} {
2502 if {![info exists vhighlights($row)]} {
2503 askvhighlight $row $id
2505 if {$vhighlights($row) > 0} break
2507 if {$findstring ne {}} {
2508 if {![info exists nhighlights($row)]} {
2509 askfindhighlight $row $id
2511 if {$nhighlights($row) > 0} break
2513 if {$highlight_related ne "None"} {
2514 if {![info exists rhighlights($row)]} {
2515 askrelhighlight $row $id
2517 if {$rhighlights($row) > 0} break
2519 if {[info exists filehighlight]} {
2520 if {![info exists fhighlights($row)]} {
2521 # ask for a few more while we're at it...
2523 for {set n 0} {$n < 100} {incr n} {
2524 if {![info exists fhighlights($r)]} {
2525 askfilehighlight $r [lindex $displayorder $r]
2528 if {$r < 0 || $r >= $numcommits} break
2532 if {$fhighlights($row) < 0} {
2536 if {$fhighlights($row) > 0} break
2544 proc next_highlight {dirn} {
2545 global selectedline fhl_row fhl_dirn
2546 global hlview filehighlight findstring highlight_related
2548 if {![info exists selectedline]} return
2549 if {!([info exists hlview] || $findstring ne {} ||
2550 $highlight_related ne "None" || [info exists filehighlight])} return
2551 set fhl_row [expr {$selectedline + $dirn}]
2556 proc cancel_next_highlight {} {
2562 # Graph layout functions
2564 proc shortids {ids} {
2567 if {[llength $id] > 1} {
2568 lappend res [shortids $id]
2569 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2570 lappend res [string range $id 0 7]
2578 proc incrange {l x o} {
2581 set e [lindex $l $x]
2583 lset l $x [expr {$e + $o}]
2592 for {} {$n > 0} {incr n -1} {
2598 proc usedinrange {id l1 l2} {
2599 global children commitrow curview
2601 if {[info exists commitrow($curview,$id)]} {
2602 set r $commitrow($curview,$id)
2603 if {$l1 <= $r && $r <= $l2} {
2604 return [expr {$r - $l1 + 1}]
2607 set kids $children($curview,$id)
2609 set r $commitrow($curview,$c)
2610 if {$l1 <= $r && $r <= $l2} {
2611 return [expr {$r - $l1 + 1}]
2617 proc sanity {row {full 0}} {
2618 global rowidlist rowoffsets
2621 set ids [lindex $rowidlist $row]
2624 if {$id eq {}} continue
2625 if {$col < [llength $ids] - 1 &&
2626 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2627 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2629 set o [lindex $rowoffsets $row $col]
2635 if {[lindex $rowidlist $y $x] != $id} {
2636 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2637 puts " id=[shortids $id] check started at row $row"
2638 for {set i $row} {$i >= $y} {incr i -1} {
2639 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2644 set o [lindex $rowoffsets $y $x]
2649 proc makeuparrow {oid x y z} {
2650 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2652 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2655 set off0 [lindex $rowoffsets $y]
2656 for {set x0 $x} {1} {incr x0} {
2657 if {$x0 >= [llength $off0]} {
2658 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2661 set z [lindex $off0 $x0]
2667 set z [expr {$x0 - $x}]
2668 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2669 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2671 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2672 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2673 lappend idrowranges($oid) [lindex $displayorder $y]
2676 proc initlayout {} {
2677 global rowidlist rowoffsets displayorder commitlisted
2678 global rowlaidout rowoptim
2679 global idinlist rowchk rowrangelist idrowranges
2680 global numcommits canvxmax canv
2683 global colormap rowtextx
2694 catch {unset idinlist}
2695 catch {unset rowchk}
2698 set canvxmax [$canv cget -width]
2699 catch {unset colormap}
2700 catch {unset rowtextx}
2701 catch {unset idrowranges}
2705 proc setcanvscroll {} {
2706 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2708 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2709 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2710 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2711 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2714 proc visiblerows {} {
2715 global canv numcommits linespc
2717 set ymax [lindex [$canv cget -scrollregion] 3]
2718 if {$ymax eq {} || $ymax == 0} return
2720 set y0 [expr {int([lindex $f 0] * $ymax)}]
2721 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2725 set y1 [expr {int([lindex $f 1] * $ymax)}]
2726 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2727 if {$r1 >= $numcommits} {
2728 set r1 [expr {$numcommits - 1}]
2730 return [list $r0 $r1]
2733 proc layoutmore {tmax allread} {
2734 global rowlaidout rowoptim commitidx numcommits optim_delay
2735 global uparrowlen curview rowidlist idinlist
2738 set showdelay $optim_delay
2739 set optdelay [expr {$uparrowlen + 1}]
2741 if {$rowoptim - $showdelay > $numcommits} {
2742 showstuff [expr {$rowoptim - $showdelay}] $showlast
2743 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2744 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2748 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2750 } elseif {$commitidx($curview) > $rowlaidout} {
2751 set nr [expr {$commitidx($curview) - $rowlaidout}]
2752 # may need to increase this threshold if uparrowlen or
2753 # mingaplen are increased...
2758 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2759 if {$rowlaidout == $row} {
2762 } elseif {$allread} {
2764 set nrows $commitidx($curview)
2765 if {[lindex $rowidlist $nrows] ne {} ||
2766 [array names idinlist] ne {}} {
2768 set rowlaidout $commitidx($curview)
2769 } elseif {$rowoptim == $nrows} {
2772 if {$numcommits == $nrows} {
2779 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2785 proc showstuff {canshow last} {
2786 global numcommits commitrow pending_select selectedline curview
2787 global lookingforhead mainheadid displayorder selectfirst
2788 global lastscrollset commitinterest
2790 if {$numcommits == 0} {
2792 set phase "incrdraw"
2795 for {set l $numcommits} {$l < $canshow} {incr l} {
2796 set id [lindex $displayorder $l]
2797 if {[info exists commitinterest($id)]} {
2798 foreach script $commitinterest($id) {
2799 eval [string map [list "%I" $id] $script]
2801 unset commitinterest($id)
2805 set prev $numcommits
2806 set numcommits $canshow
2807 set t [clock clicks -milliseconds]
2808 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2809 set lastscrollset $t
2812 set rows [visiblerows]
2813 set r1 [lindex $rows 1]
2814 if {$r1 >= $canshow} {
2815 set r1 [expr {$canshow - 1}]
2820 if {[info exists pending_select] &&
2821 [info exists commitrow($curview,$pending_select)] &&
2822 $commitrow($curview,$pending_select) < $numcommits} {
2823 selectline $commitrow($curview,$pending_select) 1
2826 if {[info exists selectedline] || [info exists pending_select]} {
2829 set l [first_real_row]
2834 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2835 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2836 set lookingforhead 0
2841 proc doshowlocalchanges {} {
2842 global lookingforhead curview mainheadid phase commitrow
2844 if {[info exists commitrow($curview,$mainheadid)] &&
2845 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2847 } elseif {$phase ne {}} {
2848 set lookingforhead 1
2852 proc dohidelocalchanges {} {
2853 global lookingforhead localfrow localirow lserial
2855 set lookingforhead 0
2856 if {$localfrow >= 0} {
2857 removerow $localfrow
2859 if {$localirow > 0} {
2863 if {$localirow >= 0} {
2864 removerow $localirow
2870 # spawn off a process to do git diff-index --cached HEAD
2871 proc dodiffindex {} {
2872 global localirow localfrow lserial
2877 set fd [open "|git diff-index --cached HEAD" r]
2878 fconfigure $fd -blocking 0
2879 filerun $fd [list readdiffindex $fd $lserial]
2882 proc readdiffindex {fd serial} {
2883 global localirow commitrow mainheadid nullid2 curview
2884 global commitinfo commitdata lserial
2887 if {[gets $fd line] < 0} {
2893 # we only need to see one line and we don't really care what it says...
2896 # now see if there are any local changes not checked in to the index
2897 if {$serial == $lserial} {
2898 set fd [open "|git diff-files" r]
2899 fconfigure $fd -blocking 0
2900 filerun $fd [list readdifffiles $fd $serial]
2903 if {$isdiff && $serial == $lserial && $localirow == -1} {
2904 # add the line for the changes in the index to the graph
2905 set localirow $commitrow($curview,$mainheadid)
2906 set hl "Local changes checked in to index but not committed"
2907 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2908 set commitdata($nullid2) "\n $hl\n"
2909 insertrow $localirow $nullid2
2914 proc readdifffiles {fd serial} {
2915 global localirow localfrow commitrow mainheadid nullid curview
2916 global commitinfo commitdata lserial
2919 if {[gets $fd line] < 0} {
2925 # we only need to see one line and we don't really care what it says...
2928 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2929 # add the line for the local diff to the graph
2930 if {$localirow >= 0} {
2931 set localfrow $localirow
2934 set localfrow $commitrow($curview,$mainheadid)
2936 set hl "Local uncommitted changes, not checked in to index"
2937 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2938 set commitdata($nullid) "\n $hl\n"
2939 insertrow $localfrow $nullid
2944 proc layoutrows {row endrow last} {
2945 global rowidlist rowoffsets displayorder
2946 global uparrowlen downarrowlen maxwidth mingaplen
2947 global children parentlist
2949 global commitidx curview
2950 global idinlist rowchk rowrangelist
2952 set idlist [lindex $rowidlist $row]
2953 set offs [lindex $rowoffsets $row]
2954 while {$row < $endrow} {
2955 set id [lindex $displayorder $row]
2956 set nev [expr {[llength $idlist] - $maxwidth + 1}]
2957 foreach p [lindex $parentlist $row] {
2958 if {![info exists idinlist($p)] || !$idinlist($p)} {
2964 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2965 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2966 set i [lindex $idlist $x]
2967 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2968 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2969 [expr {$row + $uparrowlen + $mingaplen}]]
2971 set idlist [lreplace $idlist $x $x]
2972 set offs [lreplace $offs $x $x]
2973 set offs [incrange $offs $x 1]
2975 set rm1 [expr {$row - 1}]
2976 lappend idrowranges($i) [lindex $displayorder $rm1]
2977 if {[incr nev -1] <= 0} break
2980 set rowchk($i) [expr {$row + $r}]
2983 lset rowidlist $row $idlist
2984 lset rowoffsets $row $offs
2988 foreach p [lindex $parentlist $row] {
2989 if {![info exists idinlist($p)]} {
2991 } elseif {!$idinlist($p)} {
2996 set col [lsearch -exact $idlist $id]
2998 set col [llength $idlist]
3000 lset rowidlist $row $idlist
3002 if {$children($curview,$id) ne {}} {
3003 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
3007 lset rowoffsets $row $offs
3009 makeuparrow $id $col $row $z
3015 if {[info exists idrowranges($id)]} {
3016 set ranges $idrowranges($id)
3018 unset idrowranges($id)
3020 lappend rowrangelist $ranges
3022 set offs [ntimes [llength $idlist] 0]
3023 set l [llength $newolds]
3024 set idlist [eval lreplace \$idlist $col $col $newolds]
3027 set offs [lrange $offs 0 [expr {$col - 1}]]
3028 foreach x $newolds {
3033 set tmp [expr {[llength $idlist] - [llength $offs]}]
3035 set offs [concat $offs [ntimes $tmp $o]]
3040 foreach i $newolds {
3041 set idrowranges($i) $id
3044 foreach oid $oldolds {
3045 set idlist [linsert $idlist $col $oid]
3046 set offs [linsert $offs $col $o]
3047 makeuparrow $oid $col $row $o
3050 lappend rowidlist $idlist
3051 lappend rowoffsets $offs
3056 proc addextraid {id row} {
3057 global displayorder commitrow commitinfo
3058 global commitidx commitlisted
3059 global parentlist children curview
3061 incr commitidx($curview)
3062 lappend displayorder $id
3063 lappend commitlisted 0
3064 lappend parentlist {}
3065 set commitrow($curview,$id) $row
3067 if {![info exists commitinfo($id)]} {
3068 set commitinfo($id) {"No commit information available"}
3070 if {![info exists children($curview,$id)]} {
3071 set children($curview,$id) {}
3075 proc layouttail {} {
3076 global rowidlist rowoffsets idinlist commitidx curview
3077 global idrowranges rowrangelist
3079 set row $commitidx($curview)
3080 set idlist [lindex $rowidlist $row]
3081 while {$idlist ne {}} {
3082 set col [expr {[llength $idlist] - 1}]
3083 set id [lindex $idlist $col]
3085 catch {unset idinlist($id)}
3086 lappend idrowranges($id) $id
3087 lappend rowrangelist $idrowranges($id)
3088 unset idrowranges($id)
3090 set offs [ntimes $col 0]
3091 set idlist [lreplace $idlist $col $col]
3092 lappend rowidlist $idlist
3093 lappend rowoffsets $offs
3096 foreach id [array names idinlist] {
3099 lset rowidlist $row [list $id]
3100 lset rowoffsets $row 0
3101 makeuparrow $id 0 $row 0
3102 lappend idrowranges($id) $id
3103 lappend rowrangelist $idrowranges($id)
3104 unset idrowranges($id)
3106 lappend rowidlist {}
3107 lappend rowoffsets {}
3111 proc insert_pad {row col npad} {
3112 global rowidlist rowoffsets
3114 set pad [ntimes $npad {}]
3115 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
3116 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
3117 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
3120 proc optimize_rows {row col endrow} {
3121 global rowidlist rowoffsets displayorder
3123 for {} {$row < $endrow} {incr row} {
3124 set idlist [lindex $rowidlist $row]
3125 set offs [lindex $rowoffsets $row]
3127 for {} {$col < [llength $offs]} {incr col} {
3128 if {[lindex $idlist $col] eq {}} {
3132 set z [lindex $offs $col]
3133 if {$z eq {}} continue
3135 set x0 [expr {$col + $z}]
3136 set y0 [expr {$row - 1}]
3137 set z0 [lindex $rowoffsets $y0 $x0]
3139 set id [lindex $idlist $col]
3140 set ranges [rowranges $id]
3141 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
3145 # Looking at lines from this row to the previous row,
3146 # make them go straight up if they end in an arrow on
3147 # the previous row; otherwise make them go straight up
3149 if {$z < -1 || ($z < 0 && $isarrow)} {
3150 # Line currently goes left too much;
3151 # insert pads in the previous row, then optimize it
3152 set npad [expr {-1 - $z + $isarrow}]
3153 set offs [incrange $offs $col $npad]
3154 insert_pad $y0 $x0 $npad
3156 optimize_rows $y0 $x0 $row
3158 set z [lindex $offs $col]
3159 set x0 [expr {$col + $z}]
3160 set z0 [lindex $rowoffsets $y0 $x0]
3161 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3162 # Line currently goes right too much;
3163 # insert pads in this line and adjust the next's rowoffsets
3164 set npad [expr {$z - 1 + $isarrow}]
3165 set y1 [expr {$row + 1}]
3166 set offs2 [lindex $rowoffsets $y1]
3170 if {$z eq {} || $x1 + $z < $col} continue
3171 if {$x1 + $z > $col} {
3174 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
3177 set pad [ntimes $npad {}]
3178 set idlist [eval linsert \$idlist $col $pad]
3179 set tmp [eval linsert \$offs $col $pad]
3181 set offs [incrange $tmp $col [expr {-$npad}]]
3182 set z [lindex $offs $col]
3185 if {$z0 eq {} && !$isarrow} {
3186 # this line links to its first child on row $row-2
3187 set rm2 [expr {$row - 2}]
3188 set id [lindex $displayorder $rm2]
3189 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
3191 set z0 [expr {$xc - $x0}]
3194 # avoid lines jigging left then immediately right
3195 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3196 insert_pad $y0 $x0 1
3197 set offs [incrange $offs $col 1]
3198 optimize_rows $y0 [expr {$x0 + 1}] $row
3203 # Find the first column that doesn't have a line going right
3204 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3205 set o [lindex $offs $col]
3207 # check if this is the link to the first child
3208 set id [lindex $idlist $col]
3209 set ranges [rowranges $id]
3210 if {$ranges ne {} && $row == [lindex $ranges 0]} {
3211 # it is, work out offset to child
3212 set y0 [expr {$row - 1}]
3213 set id [lindex $displayorder $y0]
3214 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3216 set o [expr {$x0 - $col}]
3220 if {$o eq {} || $o <= 0} break
3222 # Insert a pad at that column as long as it has a line and
3223 # isn't the last column, and adjust the next row' offsets
3224 if {$o ne {} && [incr col] < [llength $idlist]} {
3225 set y1 [expr {$row + 1}]
3226 set offs2 [lindex $rowoffsets $y1]
3230 if {$z eq {} || $x1 + $z < $col} continue
3231 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3234 set idlist [linsert $idlist $col {}]
3235 set tmp [linsert $offs $col {}]
3237 set offs [incrange $tmp $col -1]
3240 lset rowidlist $row $idlist
3241 lset rowoffsets $row $offs
3247 global canvx0 linespc
3248 return [expr {$canvx0 + $col * $linespc}]
3252 global canvy0 linespc
3253 return [expr {$canvy0 + $row * $linespc}]
3256 proc linewidth {id} {
3257 global thickerline lthickness
3260 if {[info exists thickerline] && $id eq $thickerline} {
3261 set wid [expr {2 * $lthickness}]
3266 proc rowranges {id} {
3267 global phase idrowranges commitrow rowlaidout rowrangelist curview
3271 ([info exists commitrow($curview,$id)]
3272 && $commitrow($curview,$id) < $rowlaidout)} {
3273 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3274 } elseif {[info exists idrowranges($id)]} {
3275 set ranges $idrowranges($id)
3278 foreach rid $ranges {
3279 lappend linenos $commitrow($curview,$rid)
3281 if {$linenos ne {}} {
3282 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3287 # work around tk8.4 refusal to draw arrows on diagonal segments
3288 proc adjarrowhigh {coords} {
3291 set x0 [lindex $coords 0]
3292 set x1 [lindex $coords 2]
3294 set y0 [lindex $coords 1]
3295 set y1 [lindex $coords 3]
3296 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3297 # we have a nearby vertical segment, just trim off the diag bit
3298 set coords [lrange $coords 2 end]
3300 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3301 set xi [expr {$x0 - $slope * $linespc / 2}]
3302 set yi [expr {$y0 - $linespc / 2}]
3303 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3309 proc drawlineseg {id row endrow arrowlow} {
3310 global rowidlist displayorder iddrawn linesegs
3311 global canv colormap linespc curview maxlinelen
3313 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3314 set le [expr {$row + 1}]
3317 set c [lsearch -exact [lindex $rowidlist $le] $id]
3323 set x [lindex $displayorder $le]
3328 if {[info exists iddrawn($x)] || $le == $endrow} {
3329 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3345 if {[info exists linesegs($id)]} {
3346 set lines $linesegs($id)
3348 set r0 [lindex $li 0]
3350 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3360 set li [lindex $lines [expr {$i-1}]]
3361 set r1 [lindex $li 1]
3362 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3367 set x [lindex $cols [expr {$le - $row}]]
3368 set xp [lindex $cols [expr {$le - 1 - $row}]]
3369 set dir [expr {$xp - $x}]
3371 set ith [lindex $lines $i 2]
3372 set coords [$canv coords $ith]
3373 set ah [$canv itemcget $ith -arrow]
3374 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3375 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3376 if {$x2 ne {} && $x - $x2 == $dir} {
3377 set coords [lrange $coords 0 end-2]
3380 set coords [list [xc $le $x] [yc $le]]
3383 set itl [lindex $lines [expr {$i-1}] 2]
3384 set al [$canv itemcget $itl -arrow]
3385 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3386 } elseif {$arrowlow &&
3387 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3390 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3391 for {set y $le} {[incr y -1] > $row} {} {
3393 set xp [lindex $cols [expr {$y - 1 - $row}]]
3394 set ndir [expr {$xp - $x}]
3395 if {$dir != $ndir || $xp < 0} {
3396 lappend coords [xc $y $x] [yc $y]
3402 # join parent line to first child
3403 set ch [lindex $displayorder $row]
3404 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3406 puts "oops: drawlineseg: child $ch not on row $row"
3409 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3410 } elseif {$xc > $x + 1} {
3411 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3415 lappend coords [xc $row $x] [yc $row]
3417 set xn [xc $row $xp]
3419 # work around tk8.4 refusal to draw arrows on diagonal segments
3420 if {$arrowlow && $xn != [lindex $coords end-1]} {
3421 if {[llength $coords] < 4 ||
3422 [lindex $coords end-3] != [lindex $coords end-1] ||
3423 [lindex $coords end] - $yn > 2 * $linespc} {
3424 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3425 set yo [yc [expr {$row + 0.5}]]
3426 lappend coords $xn $yo $xn $yn
3429 lappend coords $xn $yn
3434 set coords [adjarrowhigh $coords]
3437 set t [$canv create line $coords -width [linewidth $id] \
3438 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3441 set lines [linsert $lines $i [list $row $le $t]]
3443 $canv coords $ith $coords
3444 if {$arrow ne $ah} {
3445 $canv itemconf $ith -arrow $arrow
3447 lset lines $i 0 $row
3450 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3451 set ndir [expr {$xo - $xp}]
3452 set clow [$canv coords $itl]
3453 if {$dir == $ndir} {
3454 set clow [lrange $clow 2 end]
3456 set coords [concat $coords $clow]
3458 lset lines [expr {$i-1}] 1 $le
3460 set coords [adjarrowhigh $coords]
3463 # coalesce two pieces
3465 set b [lindex $lines [expr {$i-1}] 0]
3466 set e [lindex $lines $i 1]
3467 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3469 $canv coords $itl $coords
3470 if {$arrow ne $al} {
3471 $canv itemconf $itl -arrow $arrow
3475 set linesegs($id) $lines
3479 proc drawparentlinks {id row} {
3480 global rowidlist canv colormap curview parentlist
3483 set rowids [lindex $rowidlist $row]
3484 set col [lsearch -exact $rowids $id]
3485 if {$col < 0} return
3486 set olds [lindex $parentlist $row]
3487 set row2 [expr {$row + 1}]
3488 set x [xc $row $col]
3491 set ids [lindex $rowidlist $row2]
3492 # rmx = right-most X coord used
3495 set i [lsearch -exact $ids $p]
3497 puts "oops, parent $p of $id not in list"
3500 set x2 [xc $row2 $i]
3504 if {[lsearch -exact $rowids $p] < 0} {
3505 # drawlineseg will do this one for us
3509 # should handle duplicated parents here...
3510 set coords [list $x $y]
3511 if {$i < $col - 1} {
3512 lappend coords [xc $row [expr {$i + 1}]] $y
3513 } elseif {$i > $col + 1} {
3514 lappend coords [xc $row [expr {$i - 1}]] $y
3516 lappend coords $x2 $y2
3517 set t [$canv create line $coords -width [linewidth $p] \
3518 -fill $colormap($p) -tags lines.$p]
3522 if {$rmx > [lindex $idpos($id) 1]} {
3523 lset idpos($id) 1 $rmx
3528 proc drawlines {id} {
3531 $canv itemconf lines.$id -width [linewidth $id]
3534 proc drawcmittext {id row col} {
3535 global linespc canv canv2 canv3 canvy0 fgcolor curview
3536 global commitlisted commitinfo rowidlist parentlist
3537 global rowtextx idpos idtags idheads idotherrefs
3538 global linehtag linentag linedtag
3539 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3541 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3542 set listed [lindex $commitlisted $row]
3543 if {$id eq $nullid} {
3545 } elseif {$id eq $nullid2} {
3548 set ofill [expr {$listed != 0? "blue": "white"}]
3550 set x [xc $row $col]
3552 set orad [expr {$linespc / 3}]
3554 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3555 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3556 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3557 } elseif {$listed == 2} {
3558 # triangle pointing left for left-side commits
3559 set t [$canv create polygon \
3560 [expr {$x - $orad}] $y \
3561 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3562 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3563 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3565 # triangle pointing right for right-side commits
3566 set t [$canv create polygon \
3567 [expr {$x + $orad - 1}] $y \
3568 [expr {$x - $orad}] [expr {$y - $orad}] \
3569 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3570 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3573 $canv bind $t <1> {selcanvline {} %x %y}
3574 set rmx [llength [lindex $rowidlist $row]]
3575 set olds [lindex $parentlist $row]
3577 set nextids [lindex $rowidlist [expr {$row + 1}]]
3579 set i [lsearch -exact $nextids $p]
3585 set xt [xc $row $rmx]
3586 set rowtextx($row) $xt
3587 set idpos($id) [list $x $xt $y]
3588 if {[info exists idtags($id)] || [info exists idheads($id)]
3589 || [info exists idotherrefs($id)]} {
3590 set xt [drawtags $id $x $xt $y]
3592 set headline [lindex $commitinfo($id) 0]
3593 set name [lindex $commitinfo($id) 1]
3594 set date [lindex $commitinfo($id) 2]
3595 set date [formatdate $date]
3598 set isbold [ishighlighted $row]
3600 lappend boldrows $row
3603 lappend boldnamerows $row
3607 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3608 -text $headline -font $font -tags text]
3609 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3610 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3611 -text $name -font $nfont -tags text]
3612 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3613 -text $date -font $mainfont -tags text]
3614 set xr [expr {$xt + [font measure $mainfont $headline]}]
3615 if {$xr > $canvxmax} {
3621 proc drawcmitrow {row} {
3622 global displayorder rowidlist
3623 global iddrawn markingmatches
3624 global commitinfo parentlist numcommits
3625 global filehighlight fhighlights findstring nhighlights
3626 global hlview vhighlights
3627 global highlight_related rhighlights
3629 if {$row >= $numcommits} return
3631 set id [lindex $displayorder $row]
3632 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3633 askvhighlight $row $id
3635 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3636 askfilehighlight $row $id
3638 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3639 askfindhighlight $row $id
3641 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3642 askrelhighlight $row $id
3644 if {![info exists iddrawn($id)]} {
3645 set col [lsearch -exact [lindex $rowidlist $row] $id]
3647 puts "oops, row $row id $id not in list"
3650 if {![info exists commitinfo($id)]} {
3654 drawcmittext $id $row $col
3657 if {$markingmatches} {
3658 markrowmatches $row $id
3662 proc drawcommits {row {endrow {}}} {
3663 global numcommits iddrawn displayorder curview
3664 global parentlist rowidlist
3669 if {$endrow eq {}} {
3672 if {$endrow >= $numcommits} {
3673 set endrow [expr {$numcommits - 1}]
3676 # make the lines join to already-drawn rows either side
3677 set r [expr {$row - 1}]
3678 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3681 set er [expr {$endrow + 1}]
3682 if {$er >= $numcommits ||
3683 ![info exists iddrawn([lindex $displayorder $er])]} {
3686 for {} {$r <= $er} {incr r} {
3687 set id [lindex $displayorder $r]
3688 set wasdrawn [info exists iddrawn($id)]
3690 if {$r == $er} break
3691 set nextid [lindex $displayorder [expr {$r + 1}]]
3692 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3693 catch {unset prevlines}
3696 drawparentlinks $id $r
3698 if {[info exists lineends($r)]} {
3699 foreach lid $lineends($r) {
3700 unset prevlines($lid)
3703 set rowids [lindex $rowidlist $r]
3704 foreach lid $rowids {
3705 if {$lid eq {}} continue
3707 # see if this is the first child of any of its parents
3708 foreach p [lindex $parentlist $r] {
3709 if {[lsearch -exact $rowids $p] < 0} {
3710 # make this line extend up to the child
3711 set le [drawlineseg $p $r $er 0]
3712 lappend lineends($le) $p
3716 } elseif {![info exists prevlines($lid)]} {
3717 set le [drawlineseg $lid $r $er 1]
3718 lappend lineends($le) $lid
3719 set prevlines($lid) 1
3725 proc drawfrac {f0 f1} {
3728 set ymax [lindex [$canv cget -scrollregion] 3]
3729 if {$ymax eq {} || $ymax == 0} return
3730 set y0 [expr {int($f0 * $ymax)}]
3731 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3732 set y1 [expr {int($f1 * $ymax)}]
3733 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3734 drawcommits $row $endrow
3737 proc drawvisible {} {
3739 eval drawfrac [$canv yview]
3742 proc clear_display {} {
3743 global iddrawn linesegs
3744 global vhighlights fhighlights nhighlights rhighlights
3747 catch {unset iddrawn}
3748 catch {unset linesegs}
3749 catch {unset vhighlights}
3750 catch {unset fhighlights}
3751 catch {unset nhighlights}
3752 catch {unset rhighlights}
3755 proc findcrossings {id} {
3756 global rowidlist parentlist numcommits rowoffsets displayorder
3760 foreach {s e} [rowranges $id] {
3761 if {$e >= $numcommits} {
3762 set e [expr {$numcommits - 1}]
3764 if {$e <= $s} continue
3765 set x [lsearch -exact [lindex $rowidlist $e] $id]
3767 puts "findcrossings: oops, no [shortids $id] in row $e"
3770 for {set row $e} {[incr row -1] >= $s} {} {
3771 set olds [lindex $parentlist $row]
3772 set kid [lindex $displayorder $row]
3773 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3774 if {$kidx < 0} continue
3775 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3777 set px [lsearch -exact $nextrow $p]
3778 if {$px < 0} continue
3779 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3780 if {[lsearch -exact $ccross $p] >= 0} continue
3781 if {$x == $px + ($kidx < $px? -1: 1)} {
3783 } elseif {[lsearch -exact $cross $p] < 0} {
3788 set inc [lindex $rowoffsets $row $x]
3789 if {$inc eq {}} break
3793 return [concat $ccross {{}} $cross]
3796 proc assigncolor {id} {
3797 global colormap colors nextcolor
3798 global commitrow parentlist children children curview
3800 if {[info exists colormap($id)]} return
3801 set ncolors [llength $colors]
3802 if {[info exists children($curview,$id)]} {
3803 set kids $children($curview,$id)
3807 if {[llength $kids] == 1} {
3808 set child [lindex $kids 0]
3809 if {[info exists colormap($child)]
3810 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3811 set colormap($id) $colormap($child)
3817 foreach x [findcrossings $id] {
3819 # delimiter between corner crossings and other crossings
3820 if {[llength $badcolors] >= $ncolors - 1} break
3821 set origbad $badcolors
3823 if {[info exists colormap($x)]
3824 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3825 lappend badcolors $colormap($x)
3828 if {[llength $badcolors] >= $ncolors} {
3829 set badcolors $origbad
3831 set origbad $badcolors
3832 if {[llength $badcolors] < $ncolors - 1} {
3833 foreach child $kids {
3834 if {[info exists colormap($child)]
3835 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3836 lappend badcolors $colormap($child)
3838 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3839 if {[info exists colormap($p)]
3840 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3841 lappend badcolors $colormap($p)
3845 if {[llength $badcolors] >= $ncolors} {
3846 set badcolors $origbad
3849 for {set i 0} {$i <= $ncolors} {incr i} {
3850 set c [lindex $colors $nextcolor]
3851 if {[incr nextcolor] >= $ncolors} {
3854 if {[lsearch -exact $badcolors $c]} break
3856 set colormap($id) $c
3859 proc bindline {t id} {
3862 $canv bind $t <Enter> "lineenter %x %y $id"
3863 $canv bind $t <Motion> "linemotion %x %y $id"
3864 $canv bind $t <Leave> "lineleave $id"
3865 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3868 proc drawtags {id x xt y1} {
3869 global idtags idheads idotherrefs mainhead
3870 global linespc lthickness
3871 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3876 if {[info exists idtags($id)]} {
3877 set marks $idtags($id)
3878 set ntags [llength $marks]
3880 if {[info exists idheads($id)]} {
3881 set marks [concat $marks $idheads($id)]
3882 set nheads [llength $idheads($id)]
3884 if {[info exists idotherrefs($id)]} {
3885 set marks [concat $marks $idotherrefs($id)]
3891 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3892 set yt [expr {$y1 - 0.5 * $linespc}]
3893 set yb [expr {$yt + $linespc - 1}]
3897 foreach tag $marks {
3899 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3900 set wid [font measure [concat $mainfont bold] $tag]
3902 set wid [font measure $mainfont $tag]
3906 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3908 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3909 -width $lthickness -fill black -tags tag.$id]
3911 foreach tag $marks x $xvals wid $wvals {
3912 set xl [expr {$x + $delta}]
3913 set xr [expr {$x + $delta + $wid + $lthickness}]
3915 if {[incr ntags -1] >= 0} {
3917 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3918 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3919 -width 1 -outline black -fill yellow -tags tag.$id]
3920 $canv bind $t <1> [list showtag $tag 1]
3921 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3923 # draw a head or other ref
3924 if {[incr nheads -1] >= 0} {
3926 if {$tag eq $mainhead} {
3932 set xl [expr {$xl - $delta/2}]
3933 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3934 -width 1 -outline black -fill $col -tags tag.$id
3935 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3936 set rwid [font measure $mainfont $remoteprefix]
3937 set xi [expr {$x + 1}]
3938 set yti [expr {$yt + 1}]
3939 set xri [expr {$x + $rwid}]
3940 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3941 -width 0 -fill "#ffddaa" -tags tag.$id
3944 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3945 -font $font -tags [list tag.$id text]]
3947 $canv bind $t <1> [list showtag $tag 1]
3948 } elseif {$nheads >= 0} {
3949 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3955 proc xcoord {i level ln} {
3956 global canvx0 xspc1 xspc2
3958 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3959 if {$i > 0 && $i == $level} {
3960 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3961 } elseif {$i > $level} {
3962 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3967 proc show_status {msg} {
3968 global canv mainfont fgcolor
3971 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3972 -tags text -fill $fgcolor
3975 # Insert a new commit as the child of the commit on row $row.
3976 # The new commit will be displayed on row $row and the commits
3977 # on that row and below will move down one row.
3978 proc insertrow {row newcmit} {
3979 global displayorder parentlist commitlisted children
3980 global commitrow curview rowidlist rowoffsets numcommits
3981 global rowrangelist rowlaidout rowoptim numcommits
3982 global selectedline rowchk commitidx
3984 if {$row >= $numcommits} {
3985 puts "oops, inserting new row $row but only have $numcommits rows"
3988 set p [lindex $displayorder $row]
3989 set displayorder [linsert $displayorder $row $newcmit]
3990 set parentlist [linsert $parentlist $row $p]
3991 set kids $children($curview,$p)
3992 lappend kids $newcmit
3993 set children($curview,$p) $kids
3994 set children($curview,$newcmit) {}
3995 set commitlisted [linsert $commitlisted $row 1]
3996 set l [llength $displayorder]
3997 for {set r $row} {$r < $l} {incr r} {
3998 set id [lindex $displayorder $r]
3999 set commitrow($curview,$id) $r
4001 incr commitidx($curview)
4003 set idlist [lindex $rowidlist $row]
4004 set offs [lindex $rowoffsets $row]
4007 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
4013 if {[llength $kids] == 1} {
4014 set col [lsearch -exact $idlist $p]
4015 lset idlist $col $newcmit
4017 set col [llength $idlist]
4018 lappend idlist $newcmit
4020 lset rowoffsets $row $offs
4022 set rowidlist [linsert $rowidlist $row $idlist]
4023 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
4025 set rowrangelist [linsert $rowrangelist $row {}]
4026 if {[llength $kids] > 1} {
4027 set rp1 [expr {$row + 1}]
4028 set ranges [lindex $rowrangelist $rp1]
4029 if {$ranges eq {}} {
4030 set ranges [list $newcmit $p]
4031 } elseif {[lindex $ranges end-1] eq $p} {
4032 lset ranges end-1 $newcmit
4034 lset rowrangelist $rp1 $ranges
4037 catch {unset rowchk}
4043 if {[info exists selectedline] && $selectedline >= $row} {
4049 # Remove a commit that was inserted with insertrow on row $row.
4050 proc removerow {row} {
4051 global displayorder parentlist commitlisted children
4052 global commitrow curview rowidlist rowoffsets numcommits
4053 global rowrangelist idrowranges rowlaidout rowoptim numcommits
4054 global linesegends selectedline rowchk commitidx
4056 if {$row >= $numcommits} {
4057 puts "oops, removing row $row but only have $numcommits rows"
4060 set rp1 [expr {$row + 1}]
4061 set id [lindex $displayorder $row]
4062 set p [lindex $parentlist $row]
4063 set displayorder [lreplace $displayorder $row $row]
4064 set parentlist [lreplace $parentlist $row $row]
4065 set commitlisted [lreplace $commitlisted $row $row]
4066 set kids $children($curview,$p)
4067 set i [lsearch -exact $kids $id]
4069 set kids [lreplace $kids $i $i]
4070 set children($curview,$p) $kids
4072 set l [llength $displayorder]
4073 for {set r $row} {$r < $l} {incr r} {
4074 set id [lindex $displayorder $r]
4075 set commitrow($curview,$id) $r
4077 incr commitidx($curview) -1
4079 set rowidlist [lreplace $rowidlist $row $row]
4080 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
4082 set offs [lindex $rowoffsets $row]
4083 set offs [lreplace $offs end end]
4084 lset rowoffsets $row $offs
4087 set rowrangelist [lreplace $rowrangelist $row $row]
4088 if {[llength $kids] > 0} {
4089 set ranges [lindex $rowrangelist $row]
4090 if {[lindex $ranges end-1] eq $id} {
4091 set ranges [lreplace $ranges end-1 end]
4092 lset rowrangelist $row $ranges
4096 catch {unset rowchk}
4102 if {[info exists selectedline] && $selectedline > $row} {
4103 incr selectedline -1
4108 # Don't change the text pane cursor if it is currently the hand cursor,
4109 # showing that we are over a sha1 ID link.
4110 proc settextcursor {c} {
4111 global ctext curtextcursor
4113 if {[$ctext cget -cursor] == $curtextcursor} {
4114 $ctext config -cursor $c
4116 set curtextcursor $c
4119 proc nowbusy {what} {
4122 if {[array names isbusy] eq {}} {
4123 . config -cursor watch
4129 proc notbusy {what} {
4130 global isbusy maincursor textcursor
4132 catch {unset isbusy($what)}
4133 if {[array names isbusy] eq {}} {
4134 . config -cursor $maincursor
4135 settextcursor $textcursor
4139 proc findmatches {f} {
4140 global findtype findstring
4141 if {$findtype == "Regexp"} {
4142 set matches [regexp -indices -all -inline $findstring $f]
4145 if {$findtype == "IgnCase"} {
4146 set f [string tolower $f]
4147 set fs [string tolower $fs]
4151 set l [string length $fs]
4152 while {[set j [string first $fs $f $i]] >= 0} {
4153 lappend matches [list $j [expr {$j+$l-1}]]
4154 set i [expr {$j + $l}]
4160 proc dofind {{rev 0}} {
4161 global findstring findstartline findcurline selectedline numcommits
4164 cancel_next_highlight
4166 if {$findstring eq {} || $numcommits == 0} return
4167 if {![info exists selectedline]} {
4168 set findstartline [lindex [visiblerows] $rev]
4170 set findstartline $selectedline
4172 set findcurline $findstartline
4177 if {$findcurline == 0} {
4178 set findcurline $numcommits
4185 proc findnext {restart} {
4187 if {![info exists findcurline]} {
4201 if {![info exists findcurline]} {
4210 global commitdata commitinfo numcommits findstring findpattern findloc
4211 global findstartline findcurline displayorder
4213 set fldtypes {Headline Author Date Committer CDate Comments}
4214 set l [expr {$findcurline + 1}]
4215 if {$l >= $numcommits} {
4218 if {$l <= $findstartline} {
4219 set lim [expr {$findstartline + 1}]
4223 if {$lim - $l > 500} {
4224 set lim [expr {$l + 500}]
4227 for {} {$l < $lim} {incr l} {
4228 set id [lindex $displayorder $l]
4229 # shouldn't happen unless git log doesn't give all the commits...
4230 if {![info exists commitdata($id)]} continue
4231 if {![doesmatch $commitdata($id)]} continue
4232 if {![info exists commitinfo($id)]} {
4235 set info $commitinfo($id)
4236 foreach f $info ty $fldtypes {
4237 if {($findloc eq "All fields" || $findloc eq $ty) &&
4245 if {$l == $findstartline + 1} {
4251 set findcurline [expr {$l - 1}]
4255 proc findmorerev {} {
4256 global commitdata commitinfo numcommits findstring findpattern findloc
4257 global findstartline findcurline displayorder
4259 set fldtypes {Headline Author Date Committer CDate Comments}
4265 if {$l >= $findstartline} {
4266 set lim [expr {$findstartline - 1}]
4270 if {$l - $lim > 500} {
4271 set lim [expr {$l - 500}]
4274 for {} {$l > $lim} {incr l -1} {
4275 set id [lindex $displayorder $l]
4276 if {![doesmatch $commitdata($id)]} continue
4277 if {![info exists commitinfo($id)]} {
4280 set info $commitinfo($id)
4281 foreach f $info ty $fldtypes {
4282 if {($findloc eq "All fields" || $findloc eq $ty) &&
4296 set findcurline [expr {$l + 1}]
4300 proc findselectline {l} {
4301 global findloc commentend ctext findcurline markingmatches
4303 set markingmatches 1
4306 if {$findloc == "All fields" || $findloc == "Comments"} {
4307 # highlight the matches in the comments
4308 set f [$ctext get 1.0 $commentend]
4309 set matches [findmatches $f]
4310 foreach match $matches {
4311 set start [lindex $match 0]
4312 set end [expr {[lindex $match 1] + 1}]
4313 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4319 # mark the bits of a headline or author that match a find string
4320 proc markmatches {canv l str tag matches font row} {
4323 set bbox [$canv bbox $tag]
4324 set x0 [lindex $bbox 0]
4325 set y0 [lindex $bbox 1]
4326 set y1 [lindex $bbox 3]
4327 foreach match $matches {
4328 set start [lindex $match 0]
4329 set end [lindex $match 1]
4330 if {$start > $end} continue
4331 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4332 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4333 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4334 [expr {$x0+$xlen+2}] $y1 \
4335 -outline {} -tags [list match$l matches] -fill yellow]
4337 if {[info exists selectedline] && $row == $selectedline} {
4338 $canv raise $t secsel
4343 proc unmarkmatches {} {
4344 global findids markingmatches findcurline
4346 allcanvs delete matches
4347 catch {unset findids}
4348 set markingmatches 0
4349 catch {unset findcurline}
4352 proc selcanvline {w x y} {
4353 global canv canvy0 ctext linespc
4355 set ymax [lindex [$canv cget -scrollregion] 3]
4356 if {$ymax == {}} return
4357 set yfrac [lindex [$canv yview] 0]
4358 set y [expr {$y + $yfrac * $ymax}]
4359 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4364 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4370 proc commit_descriptor {p} {
4372 if {![info exists commitinfo($p)]} {
4376 if {[llength $commitinfo($p)] > 1} {
4377 set l [lindex $commitinfo($p) 0]
4382 # append some text to the ctext widget, and make any SHA1 ID
4383 # that we know about be a clickable link.
4384 proc appendwithlinks {text tags} {
4385 global ctext commitrow linknum curview
4387 set start [$ctext index "end - 1c"]
4388 $ctext insert end $text $tags
4389 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4393 set linkid [string range $text $s $e]
4394 if {![info exists commitrow($curview,$linkid)]} continue
4396 $ctext tag add link "$start + $s c" "$start + $e c"
4397 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4398 $ctext tag bind link$linknum <1> \
4399 [list selectline $commitrow($curview,$linkid) 1]
4402 $ctext tag conf link -foreground blue -underline 1
4403 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4404 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4407 proc viewnextline {dir} {
4411 set ymax [lindex [$canv cget -scrollregion] 3]
4412 set wnow [$canv yview]
4413 set wtop [expr {[lindex $wnow 0] * $ymax}]
4414 set newtop [expr {$wtop + $dir * $linespc}]
4417 } elseif {$newtop > $ymax} {
4420 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4423 # add a list of tag or branch names at position pos
4424 # returns the number of names inserted
4425 proc appendrefs {pos ids var} {
4426 global ctext commitrow linknum curview $var maxrefs
4428 if {[catch {$ctext index $pos}]} {
4431 $ctext conf -state normal
4432 $ctext delete $pos "$pos lineend"
4435 foreach tag [set $var\($id\)] {
4436 lappend tags [list $tag $id]
4439 if {[llength $tags] > $maxrefs} {
4440 $ctext insert $pos "many ([llength $tags])"
4442 set tags [lsort -index 0 -decreasing $tags]
4445 set id [lindex $ti 1]
4448 $ctext tag delete $lk
4449 $ctext insert $pos $sep
4450 $ctext insert $pos [lindex $ti 0] $lk
4451 if {[info exists commitrow($curview,$id)]} {
4452 $ctext tag conf $lk -foreground blue
4453 $ctext tag bind $lk <1> \
4454 [list selectline $commitrow($curview,$id) 1]
4455 $ctext tag conf $lk -underline 1
4456 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4457 $ctext tag bind $lk <Leave> \
4458 { %W configure -cursor $curtextcursor }
4463 $ctext conf -state disabled
4464 return [llength $tags]
4467 # called when we have finished computing the nearby tags
4468 proc dispneartags {delay} {
4469 global selectedline currentid showneartags tagphase
4471 if {![info exists selectedline] || !$showneartags} return
4472 after cancel dispnexttag
4474 after 200 dispnexttag
4477 after idle dispnexttag
4482 proc dispnexttag {} {
4483 global selectedline currentid showneartags tagphase ctext
4485 if {![info exists selectedline] || !$showneartags} return
4486 switch -- $tagphase {
4488 set dtags [desctags $currentid]
4490 appendrefs precedes $dtags idtags
4494 set atags [anctags $currentid]
4496 appendrefs follows $atags idtags
4500 set dheads [descheads $currentid]
4501 if {$dheads ne {}} {
4502 if {[appendrefs branch $dheads idheads] > 1
4503 && [$ctext get "branch -3c"] eq "h"} {
4504 # turn "Branch" into "Branches"
4505 $ctext conf -state normal
4506 $ctext insert "branch -2c" "es"
4507 $ctext conf -state disabled
4512 if {[incr tagphase] <= 2} {
4513 after idle dispnexttag
4517 proc selectline {l isnew} {
4518 global canv canv2 canv3 ctext commitinfo selectedline
4519 global displayorder linehtag linentag linedtag
4520 global canvy0 linespc parentlist children curview
4521 global currentid sha1entry
4522 global commentend idtags linknum
4523 global mergemax numcommits pending_select
4524 global cmitmode showneartags allcommits
4526 catch {unset pending_select}
4529 cancel_next_highlight
4531 if {$l < 0 || $l >= $numcommits} return
4532 set y [expr {$canvy0 + $l * $linespc}]
4533 set ymax [lindex [$canv cget -scrollregion] 3]
4534 set ytop [expr {$y - $linespc - 1}]
4535 set ybot [expr {$y + $linespc + 1}]
4536 set wnow [$canv yview]
4537 set wtop [expr {[lindex $wnow 0] * $ymax}]
4538 set wbot [expr {[lindex $wnow 1] * $ymax}]
4539 set wh [expr {$wbot - $wtop}]
4541 if {$ytop < $wtop} {
4542 if {$ybot < $wtop} {
4543 set newtop [expr {$y - $wh / 2.0}]
4546 if {$newtop > $wtop - $linespc} {
4547 set newtop [expr {$wtop - $linespc}]
4550 } elseif {$ybot > $wbot} {
4551 if {$ytop > $wbot} {
4552 set newtop [expr {$y - $wh / 2.0}]
4554 set newtop [expr {$ybot - $wh}]
4555 if {$newtop < $wtop + $linespc} {
4556 set newtop [expr {$wtop + $linespc}]
4560 if {$newtop != $wtop} {
4564 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4568 if {![info exists linehtag($l)]} return
4570 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4571 -tags secsel -fill [$canv cget -selectbackground]]
4573 $canv2 delete secsel
4574 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4575 -tags secsel -fill [$canv2 cget -selectbackground]]
4577 $canv3 delete secsel
4578 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4579 -tags secsel -fill [$canv3 cget -selectbackground]]
4583 addtohistory [list selectline $l 0]
4588 set id [lindex $displayorder $l]
4590 $sha1entry delete 0 end
4591 $sha1entry insert 0 $id
4592 $sha1entry selection from 0
4593 $sha1entry selection to end
4596 $ctext conf -state normal
4599 set info $commitinfo($id)
4600 set date [formatdate [lindex $info 2]]
4601 $ctext insert end "Author: [lindex $info 1] $date\n"
4602 set date [formatdate [lindex $info 4]]
4603 $ctext insert end "Committer: [lindex $info 3] $date\n"
4604 if {[info exists idtags($id)]} {
4605 $ctext insert end "Tags:"
4606 foreach tag $idtags($id) {
4607 $ctext insert end " $tag"
4609 $ctext insert end "\n"
4613 set olds [lindex $parentlist $l]
4614 if {[llength $olds] > 1} {
4617 if {$np >= $mergemax} {
4622 $ctext insert end "Parent: " $tag
4623 appendwithlinks [commit_descriptor $p] {}
4628 append headers "Parent: [commit_descriptor $p]"
4632 foreach c $children($curview,$id) {
4633 append headers "Child: [commit_descriptor $c]"
4636 # make anything that looks like a SHA1 ID be a clickable link
4637 appendwithlinks $headers {}
4638 if {$showneartags} {
4639 if {![info exists allcommits]} {
4642 $ctext insert end "Branch: "
4643 $ctext mark set branch "end -1c"
4644 $ctext mark gravity branch left
4645 $ctext insert end "\nFollows: "
4646 $ctext mark set follows "end -1c"
4647 $ctext mark gravity follows left
4648 $ctext insert end "\nPrecedes: "
4649 $ctext mark set precedes "end -1c"
4650 $ctext mark gravity precedes left
4651 $ctext insert end "\n"
4654 $ctext insert end "\n"
4655 set comment [lindex $info 5]
4656 if {[string first "\r" $comment] >= 0} {
4657 set comment [string map {"\r" "\n "} $comment]
4659 appendwithlinks $comment {comment}
4661 $ctext tag remove found 1.0 end
4662 $ctext conf -state disabled
4663 set commentend [$ctext index "end - 1c"]
4665 init_flist "Comments"
4666 if {$cmitmode eq "tree"} {
4668 } elseif {[llength $olds] <= 1} {
4675 proc selfirstline {} {
4680 proc sellastline {} {
4683 set l [expr {$numcommits - 1}]
4687 proc selnextline {dir} {
4690 if {![info exists selectedline]} return
4691 set l [expr {$selectedline + $dir}]
4696 proc selnextpage {dir} {
4697 global canv linespc selectedline numcommits
4699 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4703 allcanvs yview scroll [expr {$dir * $lpp}] units
4705 if {![info exists selectedline]} return
4706 set l [expr {$selectedline + $dir * $lpp}]
4709 } elseif {$l >= $numcommits} {
4710 set l [expr $numcommits - 1]
4716 proc unselectline {} {
4717 global selectedline currentid
4719 catch {unset selectedline}
4720 catch {unset currentid}
4721 allcanvs delete secsel
4723 cancel_next_highlight
4726 proc reselectline {} {
4729 if {[info exists selectedline]} {
4730 selectline $selectedline 0
4734 proc addtohistory {cmd} {
4735 global history historyindex curview
4737 set elt [list $curview $cmd]
4738 if {$historyindex > 0
4739 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4743 if {$historyindex < [llength $history]} {
4744 set history [lreplace $history $historyindex end $elt]
4746 lappend history $elt
4749 if {$historyindex > 1} {
4750 .tf.bar.leftbut conf -state normal
4752 .tf.bar.leftbut conf -state disabled
4754 .tf.bar.rightbut conf -state disabled
4760 set view [lindex $elt 0]
4761 set cmd [lindex $elt 1]
4762 if {$curview != $view} {
4769 global history historyindex
4772 if {$historyindex > 1} {
4773 incr historyindex -1
4774 godo [lindex $history [expr {$historyindex - 1}]]
4775 .tf.bar.rightbut conf -state normal
4777 if {$historyindex <= 1} {
4778 .tf.bar.leftbut conf -state disabled
4783 global history historyindex
4786 if {$historyindex < [llength $history]} {
4787 set cmd [lindex $history $historyindex]
4790 .tf.bar.leftbut conf -state normal
4792 if {$historyindex >= [llength $history]} {
4793 .tf.bar.rightbut conf -state disabled
4798 global treefilelist treeidlist diffids diffmergeid treepending
4799 global nullid nullid2
4802 catch {unset diffmergeid}
4803 if {![info exists treefilelist($id)]} {
4804 if {![info exists treepending]} {
4805 if {$id eq $nullid} {
4806 set cmd [list | git ls-files]
4807 } elseif {$id eq $nullid2} {
4808 set cmd [list | git ls-files --stage -t]
4810 set cmd [list | git ls-tree -r $id]
4812 if {[catch {set gtf [open $cmd r]}]} {
4816 set treefilelist($id) {}
4817 set treeidlist($id) {}
4818 fconfigure $gtf -blocking 0
4819 filerun $gtf [list gettreeline $gtf $id]
4826 proc gettreeline {gtf id} {
4827 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4830 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4831 if {$diffids eq $nullid} {
4834 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4835 set i [string first "\t" $line]
4836 if {$i < 0} continue
4837 set sha1 [lindex $line 2]
4838 set fname [string range $line [expr {$i+1}] end]
4839 if {[string index $fname 0] eq "\""} {
4840 set fname [lindex $fname 0]
4842 lappend treeidlist($id) $sha1
4844 lappend treefilelist($id) $fname
4847 return [expr {$nl >= 1000? 2: 1}]
4851 if {$cmitmode ne "tree"} {
4852 if {![info exists diffmergeid]} {
4853 gettreediffs $diffids
4855 } elseif {$id ne $diffids} {
4864 global treefilelist treeidlist diffids nullid nullid2
4865 global ctext commentend
4867 set i [lsearch -exact $treefilelist($diffids) $f]
4869 puts "oops, $f not in list for id $diffids"
4872 if {$diffids eq $nullid} {
4873 if {[catch {set bf [open $f r]} err]} {
4874 puts "oops, can't read $f: $err"
4878 set blob [lindex $treeidlist($diffids) $i]
4879 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4880 puts "oops, error reading blob $blob: $err"
4884 fconfigure $bf -blocking 0
4885 filerun $bf [list getblobline $bf $diffids]
4886 $ctext config -state normal
4887 clear_ctext $commentend
4888 $ctext insert end "\n"
4889 $ctext insert end "$f\n" filesep
4890 $ctext config -state disabled
4891 $ctext yview $commentend
4894 proc getblobline {bf id} {
4895 global diffids cmitmode ctext
4897 if {$id ne $diffids || $cmitmode ne "tree"} {
4901 $ctext config -state normal
4903 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4904 $ctext insert end "$line\n"
4907 # delete last newline
4908 $ctext delete "end - 2c" "end - 1c"
4912 $ctext config -state disabled
4913 return [expr {$nl >= 1000? 2: 1}]
4916 proc mergediff {id l} {
4917 global diffmergeid diffopts mdifffd
4923 # this doesn't seem to actually affect anything...
4924 set env(GIT_DIFF_OPTS) $diffopts
4925 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4926 if {[catch {set mdf [open $cmd r]} err]} {
4927 error_popup "Error getting merge diffs: $err"
4930 fconfigure $mdf -blocking 0
4931 set mdifffd($id) $mdf
4932 set np [llength [lindex $parentlist $l]]
4933 filerun $mdf [list getmergediffline $mdf $id $np]
4936 proc getmergediffline {mdf id np} {
4937 global diffmergeid ctext cflist mergemax
4938 global difffilestart mdifffd
4940 $ctext conf -state normal
4942 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4943 if {![info exists diffmergeid] || $id != $diffmergeid
4944 || $mdf != $mdifffd($id)} {
4948 if {[regexp {^diff --cc (.*)} $line match fname]} {
4949 # start of a new file
4950 $ctext insert end "\n"
4951 set here [$ctext index "end - 1c"]
4952 lappend difffilestart $here
4953 add_flist [list $fname]
4954 set l [expr {(78 - [string length $fname]) / 2}]
4955 set pad [string range "----------------------------------------" 1 $l]
4956 $ctext insert end "$pad $fname $pad\n" filesep
4957 } elseif {[regexp {^@@} $line]} {
4958 $ctext insert end "$line\n" hunksep
4959 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4962 # parse the prefix - one ' ', '-' or '+' for each parent
4967 for {set j 0} {$j < $np} {incr j} {
4968 set c [string range $line $j $j]
4971 } elseif {$c == "-"} {
4973 } elseif {$c == "+"} {
4982 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4983 # line doesn't appear in result, parents in $minuses have the line
4984 set num [lindex $minuses 0]
4985 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4986 # line appears in result, parents in $pluses don't have the line
4987 lappend tags mresult
4988 set num [lindex $spaces 0]
4991 if {$num >= $mergemax} {
4996 $ctext insert end "$line\n" $tags
4999 $ctext conf -state disabled
5004 return [expr {$nr >= 1000? 2: 1}]
5007 proc startdiff {ids} {
5008 global treediffs diffids treepending diffmergeid nullid nullid2
5011 catch {unset diffmergeid}
5012 if {![info exists treediffs($ids)] ||
5013 [lsearch -exact $ids $nullid] >= 0 ||
5014 [lsearch -exact $ids $nullid2] >= 0} {
5015 if {![info exists treepending]} {
5023 proc addtocflist {ids} {
5024 global treediffs cflist
5025 add_flist $treediffs($ids)
5029 proc diffcmd {ids flags} {
5030 global nullid nullid2
5032 set i [lsearch -exact $ids $nullid]
5033 set j [lsearch -exact $ids $nullid2]
5035 if {[llength $ids] > 1 && $j < 0} {
5036 # comparing working directory with some specific revision
5037 set cmd [concat | git diff-index $flags]
5039 lappend cmd -R [lindex $ids 1]
5041 lappend cmd [lindex $ids 0]
5044 # comparing working directory with index
5045 set cmd [concat | git diff-files $flags]
5050 } elseif {$j >= 0} {
5051 set cmd [concat | git diff-index --cached $flags]
5052 if {[llength $ids] > 1} {
5053 # comparing index with specific revision
5055 lappend cmd -R [lindex $ids 1]
5057 lappend cmd [lindex $ids 0]
5060 # comparing index with HEAD
5064 set cmd [concat | git diff-tree -r $flags $ids]
5069 proc gettreediffs {ids} {
5070 global treediff treepending
5072 set treepending $ids
5074 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5075 fconfigure $gdtf -blocking 0
5076 filerun $gdtf [list gettreediffline $gdtf $ids]
5079 proc gettreediffline {gdtf ids} {
5080 global treediff treediffs treepending diffids diffmergeid
5084 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5085 set i [string first "\t" $line]
5087 set file [string range $line [expr {$i+1}] end]
5088 if {[string index $file 0] eq "\""} {
5089 set file [lindex $file 0]
5091 lappend treediff $file
5095 return [expr {$nr >= 1000? 2: 1}]
5098 set treediffs($ids) $treediff
5100 if {$cmitmode eq "tree"} {
5102 } elseif {$ids != $diffids} {
5103 if {![info exists diffmergeid]} {
5104 gettreediffs $diffids
5112 # empty string or positive integer
5113 proc diffcontextvalidate {v} {
5114 return [regexp {^(|[1-9][0-9]*)$} $v]
5117 proc diffcontextchange {n1 n2 op} {
5118 global diffcontextstring diffcontext
5120 if {[string is integer -strict $diffcontextstring]} {
5121 if {$diffcontextstring > 0} {
5122 set diffcontext $diffcontextstring
5128 proc getblobdiffs {ids} {
5129 global diffopts blobdifffd diffids env
5130 global diffinhdr treediffs
5133 set env(GIT_DIFF_OPTS) $diffopts
5134 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5135 puts "error getting diffs: $err"
5139 fconfigure $bdf -blocking 0
5140 set blobdifffd($ids) $bdf
5141 filerun $bdf [list getblobdiffline $bdf $diffids]
5144 proc setinlist {var i val} {
5147 while {[llength [set $var]] < $i} {
5150 if {[llength [set $var]] == $i} {
5157 proc makediffhdr {fname ids} {
5158 global ctext curdiffstart treediffs
5160 set i [lsearch -exact $treediffs($ids) $fname]
5162 setinlist difffilestart $i $curdiffstart
5164 set l [expr {(78 - [string length $fname]) / 2}]
5165 set pad [string range "----------------------------------------" 1 $l]
5166 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5169 proc getblobdiffline {bdf ids} {
5170 global diffids blobdifffd ctext curdiffstart
5171 global diffnexthead diffnextnote difffilestart
5172 global diffinhdr treediffs
5175 $ctext conf -state normal
5176 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5177 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5181 if {![string compare -length 11 "diff --git " $line]} {
5182 # trim off "diff --git "
5183 set line [string range $line 11 end]
5185 # start of a new file
5186 $ctext insert end "\n"
5187 set curdiffstart [$ctext index "end - 1c"]
5188 $ctext insert end "\n" filesep
5189 # If the name hasn't changed the length will be odd,
5190 # the middle char will be a space, and the two bits either
5191 # side will be a/name and b/name, or "a/name" and "b/name".
5192 # If the name has changed we'll get "rename from" and
5193 # "rename to" or "copy from" and "copy to" lines following this,
5194 # and we'll use them to get the filenames.
5195 # This complexity is necessary because spaces in the filename(s)
5196 # don't get escaped.
5197 set l [string length $line]
5198 set i [expr {$l / 2}]
5199 if {!(($l & 1) && [string index $line $i] eq " " &&
5200 [string range $line 2 [expr {$i - 1}]] eq \
5201 [string range $line [expr {$i + 3}] end])} {
5204 # unescape if quoted and chop off the a/ from the front
5205 if {[string index $line 0] eq "\""} {
5206 set fname [string range [lindex $line 0] 2 end]
5208 set fname [string range $line 2 [expr {$i - 1}]]
5210 makediffhdr $fname $ids
5212 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5213 $line match f1l f1c f2l f2c rest]} {
5214 $ctext insert end "$line\n" hunksep
5217 } elseif {$diffinhdr} {
5218 if {![string compare -length 12 "rename from " $line] ||
5219 ![string compare -length 10 "copy from " $line]} {
5220 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5221 if {[string index $fname 0] eq "\""} {
5222 set fname [lindex $fname 0]
5224 set i [lsearch -exact $treediffs($ids) $fname]
5226 setinlist difffilestart $i $curdiffstart
5228 } elseif {![string compare -length 10 $line "rename to "] ||
5229 ![string compare -length 8 $line "copy to "]} {
5230 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5231 if {[string index $fname 0] eq "\""} {
5232 set fname [lindex $fname 0]
5234 makediffhdr $fname $ids
5235 } elseif {[string compare -length 3 $line "---"] == 0} {
5238 } elseif {[string compare -length 3 $line "+++"] == 0} {
5242 $ctext insert end "$line\n" filesep
5245 set x [string range $line 0 0]
5246 if {$x == "-" || $x == "+"} {
5247 set tag [expr {$x == "+"}]
5248 $ctext insert end "$line\n" d$tag
5249 } elseif {$x == " "} {
5250 $ctext insert end "$line\n"
5252 # "\ No newline at end of file",
5253 # or something else we don't recognize
5254 $ctext insert end "$line\n" hunksep
5258 $ctext conf -state disabled
5263 return [expr {$nr >= 1000? 2: 1}]
5266 proc changediffdisp {} {
5267 global ctext diffelide
5269 $ctext tag conf d0 -elide [lindex $diffelide 0]
5270 $ctext tag conf d1 -elide [lindex $diffelide 1]
5274 global difffilestart ctext
5275 set prev [lindex $difffilestart 0]
5276 set here [$ctext index @0,0]
5277 foreach loc $difffilestart {
5278 if {[$ctext compare $loc >= $here]} {
5288 global difffilestart ctext
5289 set here [$ctext index @0,0]
5290 foreach loc $difffilestart {
5291 if {[$ctext compare $loc > $here]} {
5298 proc clear_ctext {{first 1.0}} {
5299 global ctext smarktop smarkbot
5301 set l [lindex [split $first .] 0]
5302 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5305 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5308 $ctext delete $first end
5311 proc incrsearch {name ix op} {
5312 global ctext searchstring searchdirn
5314 $ctext tag remove found 1.0 end
5315 if {[catch {$ctext index anchor}]} {
5316 # no anchor set, use start of selection, or of visible area
5317 set sel [$ctext tag ranges sel]
5319 $ctext mark set anchor [lindex $sel 0]
5320 } elseif {$searchdirn eq "-forwards"} {
5321 $ctext mark set anchor @0,0
5323 $ctext mark set anchor @0,[winfo height $ctext]
5326 if {$searchstring ne {}} {
5327 set here [$ctext search $searchdirn -- $searchstring anchor]
5336 global sstring ctext searchstring searchdirn
5339 $sstring icursor end
5340 set searchdirn -forwards
5341 if {$searchstring ne {}} {
5342 set sel [$ctext tag ranges sel]
5344 set start "[lindex $sel 0] + 1c"
5345 } elseif {[catch {set start [$ctext index anchor]}]} {
5348 set match [$ctext search -count mlen -- $searchstring $start]
5349 $ctext tag remove sel 1.0 end
5355 set mend "$match + $mlen c"
5356 $ctext tag add sel $match $mend
5357 $ctext mark unset anchor
5361 proc dosearchback {} {
5362 global sstring ctext searchstring searchdirn
5365 $sstring icursor end
5366 set searchdirn -backwards
5367 if {$searchstring ne {}} {
5368 set sel [$ctext tag ranges sel]
5370 set start [lindex $sel 0]
5371 } elseif {[catch {set start [$ctext index anchor]}]} {
5372 set start @0,[winfo height $ctext]
5374 set match [$ctext search -backwards -count ml -- $searchstring $start]
5375 $ctext tag remove sel 1.0 end
5381 set mend "$match + $ml c"
5382 $ctext tag add sel $match $mend
5383 $ctext mark unset anchor
5387 proc searchmark {first last} {
5388 global ctext searchstring
5392 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5393 if {$match eq {}} break
5394 set mend "$match + $mlen c"
5395 $ctext tag add found $match $mend
5399 proc searchmarkvisible {doall} {
5400 global ctext smarktop smarkbot
5402 set topline [lindex [split [$ctext index @0,0] .] 0]
5403 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5404 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5405 # no overlap with previous
5406 searchmark $topline $botline
5407 set smarktop $topline
5408 set smarkbot $botline
5410 if {$topline < $smarktop} {
5411 searchmark $topline [expr {$smarktop-1}]
5412 set smarktop $topline
5414 if {$botline > $smarkbot} {
5415 searchmark [expr {$smarkbot+1}] $botline
5416 set smarkbot $botline
5421 proc scrolltext {f0 f1} {
5424 .bleft.sb set $f0 $f1
5425 if {$searchstring ne {}} {
5431 global linespc charspc canvx0 canvy0 mainfont
5432 global xspc1 xspc2 lthickness
5434 set linespc [font metrics $mainfont -linespace]
5435 set charspc [font measure $mainfont "m"]
5436 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5437 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5438 set lthickness [expr {int($linespc / 9) + 1}]
5439 set xspc1(0) $linespc
5447 set ymax [lindex [$canv cget -scrollregion] 3]
5448 if {$ymax eq {} || $ymax == 0} return
5449 set span [$canv yview]
5452 allcanvs yview moveto [lindex $span 0]
5454 if {[info exists selectedline]} {
5455 selectline $selectedline 0
5456 allcanvs yview moveto [lindex $span 0]
5460 proc incrfont {inc} {
5461 global mainfont textfont ctext canv phase cflist showrefstop
5462 global charspc tabstop
5463 global stopped entries
5465 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5466 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5468 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5469 $cflist conf -font $textfont
5470 $ctext tag conf filesep -font [concat $textfont bold]
5471 foreach e $entries {
5472 $e conf -font $mainfont
5474 if {$phase eq "getcommits"} {
5475 $canv itemconf textitems -font $mainfont
5477 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5478 $showrefstop.list conf -font $mainfont
5484 global sha1entry sha1string
5485 if {[string length $sha1string] == 40} {
5486 $sha1entry delete 0 end
5490 proc sha1change {n1 n2 op} {
5491 global sha1string currentid sha1but
5492 if {$sha1string == {}
5493 || ([info exists currentid] && $sha1string == $currentid)} {
5498 if {[$sha1but cget -state] == $state} return
5499 if {$state == "normal"} {
5500 $sha1but conf -state normal -relief raised -text "Goto: "
5502 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5506 proc gotocommit {} {
5507 global sha1string currentid commitrow tagids headids
5508 global displayorder numcommits curview
5510 if {$sha1string == {}
5511 || ([info exists currentid] && $sha1string == $currentid)} return
5512 if {[info exists tagids($sha1string)]} {
5513 set id $tagids($sha1string)
5514 } elseif {[info exists headids($sha1string)]} {
5515 set id $headids($sha1string)
5517 set id [string tolower $sha1string]
5518 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5520 foreach i $displayorder {
5521 if {[string match $id* $i]} {
5525 if {$matches ne {}} {
5526 if {[llength $matches] > 1} {
5527 error_popup "Short SHA1 id $id is ambiguous"
5530 set id [lindex $matches 0]
5534 if {[info exists commitrow($curview,$id)]} {
5535 selectline $commitrow($curview,$id) 1
5538 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5543 error_popup "$type $sha1string is not known"
5546 proc lineenter {x y id} {
5547 global hoverx hovery hoverid hovertimer
5548 global commitinfo canv
5550 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5554 if {[info exists hovertimer]} {
5555 after cancel $hovertimer
5557 set hovertimer [after 500 linehover]
5561 proc linemotion {x y id} {
5562 global hoverx hovery hoverid hovertimer
5564 if {[info exists hoverid] && $id == $hoverid} {
5567 if {[info exists hovertimer]} {
5568 after cancel $hovertimer
5570 set hovertimer [after 500 linehover]
5574 proc lineleave {id} {
5575 global hoverid hovertimer canv
5577 if {[info exists hoverid] && $id == $hoverid} {
5579 if {[info exists hovertimer]} {
5580 after cancel $hovertimer
5588 global hoverx hovery hoverid hovertimer
5589 global canv linespc lthickness
5590 global commitinfo mainfont
5592 set text [lindex $commitinfo($hoverid) 0]
5593 set ymax [lindex [$canv cget -scrollregion] 3]
5594 if {$ymax == {}} return
5595 set yfrac [lindex [$canv yview] 0]
5596 set x [expr {$hoverx + 2 * $linespc}]
5597 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5598 set x0 [expr {$x - 2 * $lthickness}]
5599 set y0 [expr {$y - 2 * $lthickness}]
5600 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5601 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5602 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5603 -fill \#ffff80 -outline black -width 1 -tags hover]
5605 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5610 proc clickisonarrow {id y} {
5613 set ranges [rowranges $id]
5614 set thresh [expr {2 * $lthickness + 6}]
5615 set n [expr {[llength $ranges] - 1}]
5616 for {set i 1} {$i < $n} {incr i} {
5617 set row [lindex $ranges $i]
5618 if {abs([yc $row] - $y) < $thresh} {
5625 proc arrowjump {id n y} {
5628 # 1 <-> 2, 3 <-> 4, etc...
5629 set n [expr {(($n - 1) ^ 1) + 1}]
5630 set row [lindex [rowranges $id] $n]
5632 set ymax [lindex [$canv cget -scrollregion] 3]
5633 if {$ymax eq {} || $ymax <= 0} return
5634 set view [$canv yview]
5635 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5636 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5640 allcanvs yview moveto $yfrac
5643 proc lineclick {x y id isnew} {
5644 global ctext commitinfo children canv thickerline curview
5646 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5651 # draw this line thicker than normal
5655 set ymax [lindex [$canv cget -scrollregion] 3]
5656 if {$ymax eq {}} return
5657 set yfrac [lindex [$canv yview] 0]
5658 set y [expr {$y + $yfrac * $ymax}]
5660 set dirn [clickisonarrow $id $y]
5662 arrowjump $id $dirn $y
5667 addtohistory [list lineclick $x $y $id 0]
5669 # fill the details pane with info about this line
5670 $ctext conf -state normal
5672 $ctext tag conf link -foreground blue -underline 1
5673 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5674 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5675 $ctext insert end "Parent:\t"
5676 $ctext insert end $id [list link link0]
5677 $ctext tag bind link0 <1> [list selbyid $id]
5678 set info $commitinfo($id)
5679 $ctext insert end "\n\t[lindex $info 0]\n"
5680 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5681 set date [formatdate [lindex $info 2]]
5682 $ctext insert end "\tDate:\t$date\n"
5683 set kids $children($curview,$id)
5685 $ctext insert end "\nChildren:"
5687 foreach child $kids {
5689 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5690 set info $commitinfo($child)
5691 $ctext insert end "\n\t"
5692 $ctext insert end $child [list link link$i]
5693 $ctext tag bind link$i <1> [list selbyid $child]
5694 $ctext insert end "\n\t[lindex $info 0]"
5695 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5696 set date [formatdate [lindex $info 2]]
5697 $ctext insert end "\n\tDate:\t$date\n"
5700 $ctext conf -state disabled
5704 proc normalline {} {
5706 if {[info exists thickerline]} {
5714 global commitrow curview
5715 if {[info exists commitrow($curview,$id)]} {
5716 selectline $commitrow($curview,$id) 1
5722 if {![info exists startmstime]} {
5723 set startmstime [clock clicks -milliseconds]
5725 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5728 proc rowmenu {x y id} {
5729 global rowctxmenu commitrow selectedline rowmenuid curview
5730 global nullid nullid2 fakerowmenu mainhead
5733 if {![info exists selectedline]
5734 || $commitrow($curview,$id) eq $selectedline} {
5739 if {$id ne $nullid && $id ne $nullid2} {
5740 set menu $rowctxmenu
5741 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5743 set menu $fakerowmenu
5745 $menu entryconfigure "Diff this*" -state $state
5746 $menu entryconfigure "Diff selected*" -state $state
5747 $menu entryconfigure "Make patch" -state $state
5748 tk_popup $menu $x $y
5751 proc diffvssel {dirn} {
5752 global rowmenuid selectedline displayorder
5754 if {![info exists selectedline]} return
5756 set oldid [lindex $displayorder $selectedline]
5757 set newid $rowmenuid
5759 set oldid $rowmenuid
5760 set newid [lindex $displayorder $selectedline]
5762 addtohistory [list doseldiff $oldid $newid]
5763 doseldiff $oldid $newid
5766 proc doseldiff {oldid newid} {
5770 $ctext conf -state normal
5773 $ctext insert end "From "
5774 $ctext tag conf link -foreground blue -underline 1
5775 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5776 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5777 $ctext tag bind link0 <1> [list selbyid $oldid]
5778 $ctext insert end $oldid [list link link0]
5779 $ctext insert end "\n "
5780 $ctext insert end [lindex $commitinfo($oldid) 0]
5781 $ctext insert end "\n\nTo "
5782 $ctext tag bind link1 <1> [list selbyid $newid]
5783 $ctext insert end $newid [list link link1]
5784 $ctext insert end "\n "
5785 $ctext insert end [lindex $commitinfo($newid) 0]
5786 $ctext insert end "\n"
5787 $ctext conf -state disabled
5788 $ctext tag remove found 1.0 end
5789 startdiff [list $oldid $newid]
5793 global rowmenuid currentid commitinfo patchtop patchnum
5795 if {![info exists currentid]} return
5796 set oldid $currentid
5797 set oldhead [lindex $commitinfo($oldid) 0]
5798 set newid $rowmenuid
5799 set newhead [lindex $commitinfo($newid) 0]
5802 catch {destroy $top}
5804 label $top.title -text "Generate patch"
5805 grid $top.title - -pady 10
5806 label $top.from -text "From:"
5807 entry $top.fromsha1 -width 40 -relief flat
5808 $top.fromsha1 insert 0 $oldid
5809 $top.fromsha1 conf -state readonly
5810 grid $top.from $top.fromsha1 -sticky w
5811 entry $top.fromhead -width 60 -relief flat
5812 $top.fromhead insert 0 $oldhead
5813 $top.fromhead conf -state readonly
5814 grid x $top.fromhead -sticky w
5815 label $top.to -text "To:"
5816 entry $top.tosha1 -width 40 -relief flat
5817 $top.tosha1 insert 0 $newid
5818 $top.tosha1 conf -state readonly
5819 grid $top.to $top.tosha1 -sticky w
5820 entry $top.tohead -width 60 -relief flat
5821 $top.tohead insert 0 $newhead
5822 $top.tohead conf -state readonly
5823 grid x $top.tohead -sticky w
5824 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5825 grid $top.rev x -pady 10
5826 label $top.flab -text "Output file:"
5827 entry $top.fname -width 60
5828 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5830 grid $top.flab $top.fname -sticky w
5832 button $top.buts.gen -text "Generate" -command mkpatchgo
5833 button $top.buts.can -text "Cancel" -command mkpatchcan
5834 grid $top.buts.gen $top.buts.can
5835 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5836 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5837 grid $top.buts - -pady 10 -sticky ew
5841 proc mkpatchrev {} {
5844 set oldid [$patchtop.fromsha1 get]
5845 set oldhead [$patchtop.fromhead get]
5846 set newid [$patchtop.tosha1 get]
5847 set newhead [$patchtop.tohead get]
5848 foreach e [list fromsha1 fromhead tosha1 tohead] \
5849 v [list $newid $newhead $oldid $oldhead] {
5850 $patchtop.$e conf -state normal
5851 $patchtop.$e delete 0 end
5852 $patchtop.$e insert 0 $v
5853 $patchtop.$e conf -state readonly
5858 global patchtop nullid nullid2
5860 set oldid [$patchtop.fromsha1 get]
5861 set newid [$patchtop.tosha1 get]
5862 set fname [$patchtop.fname get]
5863 set cmd [diffcmd [list $oldid $newid] -p]
5864 lappend cmd >$fname &
5865 if {[catch {eval exec $cmd} err]} {
5866 error_popup "Error creating patch: $err"
5868 catch {destroy $patchtop}
5872 proc mkpatchcan {} {
5875 catch {destroy $patchtop}
5880 global rowmenuid mktagtop commitinfo
5884 catch {destroy $top}
5886 label $top.title -text "Create tag"
5887 grid $top.title - -pady 10
5888 label $top.id -text "ID:"
5889 entry $top.sha1 -width 40 -relief flat
5890 $top.sha1 insert 0 $rowmenuid
5891 $top.sha1 conf -state readonly
5892 grid $top.id $top.sha1 -sticky w
5893 entry $top.head -width 60 -relief flat
5894 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5895 $top.head conf -state readonly
5896 grid x $top.head -sticky w
5897 label $top.tlab -text "Tag name:"
5898 entry $top.tag -width 60
5899 grid $top.tlab $top.tag -sticky w
5901 button $top.buts.gen -text "Create" -command mktaggo
5902 button $top.buts.can -text "Cancel" -command mktagcan
5903 grid $top.buts.gen $top.buts.can
5904 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5905 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5906 grid $top.buts - -pady 10 -sticky ew
5911 global mktagtop env tagids idtags
5913 set id [$mktagtop.sha1 get]
5914 set tag [$mktagtop.tag get]
5916 error_popup "No tag name specified"
5919 if {[info exists tagids($tag)]} {
5920 error_popup "Tag \"$tag\" already exists"
5925 set fname [file join $dir "refs/tags" $tag]
5926 set f [open $fname w]
5930 error_popup "Error creating tag: $err"
5934 set tagids($tag) $id
5935 lappend idtags($id) $tag
5942 proc redrawtags {id} {
5943 global canv linehtag commitrow idpos selectedline curview
5944 global mainfont canvxmax iddrawn
5946 if {![info exists commitrow($curview,$id)]} return
5947 if {![info exists iddrawn($id)]} return
5948 drawcommits $commitrow($curview,$id)
5949 $canv delete tag.$id
5950 set xt [eval drawtags $id $idpos($id)]
5951 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5952 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5953 set xr [expr {$xt + [font measure $mainfont $text]}]
5954 if {$xr > $canvxmax} {
5958 if {[info exists selectedline]
5959 && $selectedline == $commitrow($curview,$id)} {
5960 selectline $selectedline 0
5967 catch {destroy $mktagtop}
5976 proc writecommit {} {
5977 global rowmenuid wrcomtop commitinfo wrcomcmd
5979 set top .writecommit
5981 catch {destroy $top}
5983 label $top.title -text "Write commit to file"
5984 grid $top.title - -pady 10
5985 label $top.id -text "ID:"
5986 entry $top.sha1 -width 40 -relief flat
5987 $top.sha1 insert 0 $rowmenuid
5988 $top.sha1 conf -state readonly
5989 grid $top.id $top.sha1 -sticky w
5990 entry $top.head -width 60 -relief flat
5991 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5992 $top.head conf -state readonly
5993 grid x $top.head -sticky w
5994 label $top.clab -text "Command:"
5995 entry $top.cmd -width 60 -textvariable wrcomcmd
5996 grid $top.clab $top.cmd -sticky w -pady 10
5997 label $top.flab -text "Output file:"
5998 entry $top.fname -width 60
5999 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6000 grid $top.flab $top.fname -sticky w
6002 button $top.buts.gen -text "Write" -command wrcomgo
6003 button $top.buts.can -text "Cancel" -command wrcomcan
6004 grid $top.buts.gen $top.buts.can
6005 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6006 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6007 grid $top.buts - -pady 10 -sticky ew
6014 set id [$wrcomtop.sha1 get]
6015 set cmd "echo $id | [$wrcomtop.cmd get]"
6016 set fname [$wrcomtop.fname get]
6017 if {[catch {exec sh -c $cmd >$fname &} err]} {
6018 error_popup "Error writing commit: $err"
6020 catch {destroy $wrcomtop}
6027 catch {destroy $wrcomtop}
6032 global rowmenuid mkbrtop
6035 catch {destroy $top}
6037 label $top.title -text "Create new branch"
6038 grid $top.title - -pady 10
6039 label $top.id -text "ID:"
6040 entry $top.sha1 -width 40 -relief flat
6041 $top.sha1 insert 0 $rowmenuid
6042 $top.sha1 conf -state readonly
6043 grid $top.id $top.sha1 -sticky w
6044 label $top.nlab -text "Name:"
6045 entry $top.name -width 40
6046 grid $top.nlab $top.name -sticky w
6048 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6049 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6050 grid $top.buts.go $top.buts.can
6051 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6052 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6053 grid $top.buts - -pady 10 -sticky ew
6058 global headids idheads
6060 set name [$top.name get]
6061 set id [$top.sha1 get]
6063 error_popup "Please specify a name for the new branch"
6066 catch {destroy $top}
6070 exec git branch $name $id
6075 set headids($name) $id
6076 lappend idheads($id) $name
6085 proc cherrypick {} {
6086 global rowmenuid curview commitrow
6089 set oldhead [exec git rev-parse HEAD]
6090 set dheads [descheads $rowmenuid]
6091 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6092 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6093 included in branch $mainhead -- really re-apply it?"]
6098 # Unfortunately git-cherry-pick writes stuff to stderr even when
6099 # no error occurs, and exec takes that as an indication of error...
6100 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6105 set newhead [exec git rev-parse HEAD]
6106 if {$newhead eq $oldhead} {
6108 error_popup "No changes committed"
6111 addnewchild $newhead $oldhead
6112 if {[info exists commitrow($curview,$oldhead)]} {
6113 insertrow $commitrow($curview,$oldhead) $newhead
6114 if {$mainhead ne {}} {
6115 movehead $newhead $mainhead
6116 movedhead $newhead $mainhead
6125 global mainheadid mainhead rowmenuid confirm_ok resettype
6126 global showlocalchanges
6129 set w ".confirmreset"
6132 wm title $w "Confirm reset"
6133 message $w.m -text \
6134 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6135 -justify center -aspect 1000
6136 pack $w.m -side top -fill x -padx 20 -pady 20
6137 frame $w.f -relief sunken -border 2
6138 message $w.f.rt -text "Reset type:" -aspect 1000
6139 grid $w.f.rt -sticky w
6141 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6142 -text "Soft: Leave working tree and index untouched"
6143 grid $w.f.soft -sticky w
6144 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6145 -text "Mixed: Leave working tree untouched, reset index"
6146 grid $w.f.mixed -sticky w
6147 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6148 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6149 grid $w.f.hard -sticky w
6150 pack $w.f -side top -fill x
6151 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6152 pack $w.ok -side left -fill x -padx 20 -pady 20
6153 button $w.cancel -text Cancel -command "destroy $w"
6154 pack $w.cancel -side right -fill x -padx 20 -pady 20
6155 bind $w <Visibility> "grab $w; focus $w"
6157 if {!$confirm_ok} return
6158 if {[catch {set fd [open \
6159 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6163 set w ".resetprogress"
6164 filerun $fd [list readresetstat $fd $w]
6167 wm title $w "Reset progress"
6168 message $w.m -text "Reset in progress, please wait..." \
6169 -justify center -aspect 1000
6170 pack $w.m -side top -fill x -padx 20 -pady 5
6171 canvas $w.c -width 150 -height 20 -bg white
6172 $w.c create rect 0 0 0 20 -fill green -tags rect
6173 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6178 proc readresetstat {fd w} {
6179 global mainhead mainheadid showlocalchanges
6181 if {[gets $fd line] >= 0} {
6182 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6183 set x [expr {($m * 150) / $n}]
6184 $w.c coords rect 0 0 $x 20
6190 if {[catch {close $fd} err]} {
6193 set oldhead $mainheadid
6194 set newhead [exec git rev-parse HEAD]
6195 if {$newhead ne $oldhead} {
6196 movehead $newhead $mainhead
6197 movedhead $newhead $mainhead
6198 set mainheadid $newhead
6202 if {$showlocalchanges} {
6208 # context menu for a head
6209 proc headmenu {x y id head} {
6210 global headmenuid headmenuhead headctxmenu mainhead
6213 set headmenuhead $head
6215 if {$head eq $mainhead} {
6218 $headctxmenu entryconfigure 0 -state $state
6219 $headctxmenu entryconfigure 1 -state $state
6220 tk_popup $headctxmenu $x $y
6224 global headmenuid headmenuhead mainhead headids
6225 global showlocalchanges mainheadid
6227 # check the tree is clean first??
6228 set oldmainhead $mainhead
6233 exec git checkout -q $headmenuhead
6239 set mainhead $headmenuhead
6240 set mainheadid $headmenuid
6241 if {[info exists headids($oldmainhead)]} {
6242 redrawtags $headids($oldmainhead)
6244 redrawtags $headmenuid
6246 if {$showlocalchanges} {
6252 global headmenuid headmenuhead mainhead
6255 set head $headmenuhead
6257 # this check shouldn't be needed any more...
6258 if {$head eq $mainhead} {
6259 error_popup "Cannot delete the currently checked-out branch"
6262 set dheads [descheads $id]
6263 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6264 # the stuff on this branch isn't on any other branch
6265 if {![confirm_popup "The commits on branch $head aren't on any other\
6266 branch.\nReally delete branch $head?"]} return
6270 if {[catch {exec git branch -D $head} err]} {
6275 removehead $id $head
6276 removedhead $id $head
6283 # Display a list of tags and heads
6285 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6286 global bglist fglist uifont reflistfilter reflist maincursor
6289 set showrefstop $top
6290 if {[winfo exists $top]} {
6296 wm title $top "Tags and heads: [file tail [pwd]]"
6297 text $top.list -background $bgcolor -foreground $fgcolor \
6298 -selectbackground $selectbgcolor -font $mainfont \
6299 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6300 -width 30 -height 20 -cursor $maincursor \
6301 -spacing1 1 -spacing3 1 -state disabled
6302 $top.list tag configure highlight -background $selectbgcolor
6303 lappend bglist $top.list
6304 lappend fglist $top.list
6305 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6306 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6307 grid $top.list $top.ysb -sticky nsew
6308 grid $top.xsb x -sticky ew
6310 label $top.f.l -text "Filter: " -font $uifont
6311 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6312 set reflistfilter "*"
6313 trace add variable reflistfilter write reflistfilter_change
6314 pack $top.f.e -side right -fill x -expand 1
6315 pack $top.f.l -side left
6316 grid $top.f - -sticky ew -pady 2
6317 button $top.close -command [list destroy $top] -text "Close" \
6320 grid columnconfigure $top 0 -weight 1
6321 grid rowconfigure $top 0 -weight 1
6322 bind $top.list <1> {break}
6323 bind $top.list <B1-Motion> {break}
6324 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6329 proc sel_reflist {w x y} {
6330 global showrefstop reflist headids tagids otherrefids
6332 if {![winfo exists $showrefstop]} return
6333 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6334 set ref [lindex $reflist [expr {$l-1}]]
6335 set n [lindex $ref 0]
6336 switch -- [lindex $ref 1] {
6337 "H" {selbyid $headids($n)}
6338 "T" {selbyid $tagids($n)}
6339 "o" {selbyid $otherrefids($n)}
6341 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6344 proc unsel_reflist {} {
6347 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6348 $showrefstop.list tag remove highlight 0.0 end
6351 proc reflistfilter_change {n1 n2 op} {
6352 global reflistfilter
6354 after cancel refill_reflist
6355 after 200 refill_reflist
6358 proc refill_reflist {} {
6359 global reflist reflistfilter showrefstop headids tagids otherrefids
6360 global commitrow curview commitinterest
6362 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6364 foreach n [array names headids] {
6365 if {[string match $reflistfilter $n]} {
6366 if {[info exists commitrow($curview,$headids($n))]} {
6367 lappend refs [list $n H]
6369 set commitinterest($headids($n)) {run refill_reflist}
6373 foreach n [array names tagids] {
6374 if {[string match $reflistfilter $n]} {
6375 if {[info exists commitrow($curview,$tagids($n))]} {
6376 lappend refs [list $n T]
6378 set commitinterest($tagids($n)) {run refill_reflist}
6382 foreach n [array names otherrefids] {
6383 if {[string match $reflistfilter $n]} {
6384 if {[info exists commitrow($curview,$otherrefids($n))]} {
6385 lappend refs [list $n o]
6387 set commitinterest($otherrefids($n)) {run refill_reflist}
6391 set refs [lsort -index 0 $refs]
6392 if {$refs eq $reflist} return
6394 # Update the contents of $showrefstop.list according to the
6395 # differences between $reflist (old) and $refs (new)
6396 $showrefstop.list conf -state normal
6397 $showrefstop.list insert end "\n"
6400 while {$i < [llength $reflist] || $j < [llength $refs]} {
6401 if {$i < [llength $reflist]} {
6402 if {$j < [llength $refs]} {
6403 set cmp [string compare [lindex $reflist $i 0] \
6404 [lindex $refs $j 0]]
6406 set cmp [string compare [lindex $reflist $i 1] \
6407 [lindex $refs $j 1]]
6417 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6425 set l [expr {$j + 1}]
6426 $showrefstop.list image create $l.0 -align baseline \
6427 -image reficon-[lindex $refs $j 1] -padx 2
6428 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6434 # delete last newline
6435 $showrefstop.list delete end-2c end-1c
6436 $showrefstop.list conf -state disabled
6439 # Stuff for finding nearby tags
6440 proc getallcommits {} {
6441 global allcommits allids nbmp nextarc seeds
6443 if {![info exists allcommits]} {
6451 set cmd [concat | git rev-list --all --parents]
6455 set fd [open $cmd r]
6456 fconfigure $fd -blocking 0
6459 filerun $fd [list getallclines $fd]
6462 # Since most commits have 1 parent and 1 child, we group strings of
6463 # such commits into "arcs" joining branch/merge points (BMPs), which
6464 # are commits that either don't have 1 parent or don't have 1 child.
6466 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6467 # arcout(id) - outgoing arcs for BMP
6468 # arcids(a) - list of IDs on arc including end but not start
6469 # arcstart(a) - BMP ID at start of arc
6470 # arcend(a) - BMP ID at end of arc
6471 # growing(a) - arc a is still growing
6472 # arctags(a) - IDs out of arcids (excluding end) that have tags
6473 # archeads(a) - IDs out of arcids (excluding end) that have heads
6474 # The start of an arc is at the descendent end, so "incoming" means
6475 # coming from descendents, and "outgoing" means going towards ancestors.
6477 proc getallclines {fd} {
6478 global allids allparents allchildren idtags idheads nextarc nbmp
6479 global arcnos arcids arctags arcout arcend arcstart archeads growing
6480 global seeds allcommits
6483 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6484 set id [lindex $line 0]
6485 if {[info exists allparents($id)]} {
6490 set olds [lrange $line 1 end]
6491 set allparents($id) $olds
6492 if {![info exists allchildren($id)]} {
6493 set allchildren($id) {}
6498 if {[llength $olds] == 1 && [llength $a] == 1} {
6499 lappend arcids($a) $id
6500 if {[info exists idtags($id)]} {
6501 lappend arctags($a) $id
6503 if {[info exists idheads($id)]} {
6504 lappend archeads($a) $id
6506 if {[info exists allparents($olds)]} {
6507 # seen parent already
6508 if {![info exists arcout($olds)]} {
6511 lappend arcids($a) $olds
6512 set arcend($a) $olds
6515 lappend allchildren($olds) $id
6516 lappend arcnos($olds) $a
6521 foreach a $arcnos($id) {
6522 lappend arcids($a) $id
6529 lappend allchildren($p) $id
6530 set a [incr nextarc]
6531 set arcstart($a) $id
6538 if {[info exists allparents($p)]} {
6539 # seen it already, may need to make a new branch
6540 if {![info exists arcout($p)]} {
6543 lappend arcids($a) $p
6547 lappend arcnos($p) $a
6552 global cached_dheads cached_dtags cached_atags
6553 catch {unset cached_dheads}
6554 catch {unset cached_dtags}
6555 catch {unset cached_atags}
6558 return [expr {$nid >= 1000? 2: 1}]
6561 if {[incr allcommits -1] == 0} {
6568 proc recalcarc {a} {
6569 global arctags archeads arcids idtags idheads
6573 foreach id [lrange $arcids($a) 0 end-1] {
6574 if {[info exists idtags($id)]} {
6577 if {[info exists idheads($id)]} {
6582 set archeads($a) $ah
6586 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6587 global arcstart arcend arcout allparents growing
6590 if {[llength $a] != 1} {
6591 puts "oops splitarc called but [llength $a] arcs already"
6595 set i [lsearch -exact $arcids($a) $p]
6597 puts "oops splitarc $p not in arc $a"
6600 set na [incr nextarc]
6601 if {[info exists arcend($a)]} {
6602 set arcend($na) $arcend($a)
6604 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6605 set j [lsearch -exact $arcnos($l) $a]
6606 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6608 set tail [lrange $arcids($a) [expr {$i+1}] end]
6609 set arcids($a) [lrange $arcids($a) 0 $i]
6611 set arcstart($na) $p
6613 set arcids($na) $tail
6614 if {[info exists growing($a)]} {
6621 if {[llength $arcnos($id)] == 1} {
6624 set j [lsearch -exact $arcnos($id) $a]
6625 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6629 # reconstruct tags and heads lists
6630 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6635 set archeads($na) {}
6639 # Update things for a new commit added that is a child of one
6640 # existing commit. Used when cherry-picking.
6641 proc addnewchild {id p} {
6642 global allids allparents allchildren idtags nextarc nbmp
6643 global arcnos arcids arctags arcout arcend arcstart archeads growing
6644 global seeds allcommits
6646 if {![info exists allcommits]} return
6648 set allparents($id) [list $p]
6649 set allchildren($id) {}
6653 lappend allchildren($p) $id
6654 set a [incr nextarc]
6655 set arcstart($a) $id
6658 set arcids($a) [list $p]
6660 if {![info exists arcout($p)]} {
6663 lappend arcnos($p) $a
6664 set arcout($id) [list $a]
6667 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6668 # or 0 if neither is true.
6669 proc anc_or_desc {a b} {
6670 global arcout arcstart arcend arcnos cached_isanc
6672 if {$arcnos($a) eq $arcnos($b)} {
6673 # Both are on the same arc(s); either both are the same BMP,
6674 # or if one is not a BMP, the other is also not a BMP or is
6675 # the BMP at end of the arc (and it only has 1 incoming arc).
6676 # Or both can be BMPs with no incoming arcs.
6677 if {$a eq $b || $arcnos($a) eq {}} {
6680 # assert {[llength $arcnos($a)] == 1}
6681 set arc [lindex $arcnos($a) 0]
6682 set i [lsearch -exact $arcids($arc) $a]
6683 set j [lsearch -exact $arcids($arc) $b]
6684 if {$i < 0 || $i > $j} {
6691 if {![info exists arcout($a)]} {
6692 set arc [lindex $arcnos($a) 0]
6693 if {[info exists arcend($arc)]} {
6694 set aend $arcend($arc)
6698 set a $arcstart($arc)
6702 if {![info exists arcout($b)]} {
6703 set arc [lindex $arcnos($b) 0]
6704 if {[info exists arcend($arc)]} {
6705 set bend $arcend($arc)
6709 set b $arcstart($arc)
6719 if {[info exists cached_isanc($a,$bend)]} {
6720 if {$cached_isanc($a,$bend)} {
6724 if {[info exists cached_isanc($b,$aend)]} {
6725 if {$cached_isanc($b,$aend)} {
6728 if {[info exists cached_isanc($a,$bend)]} {
6733 set todo [list $a $b]
6736 for {set i 0} {$i < [llength $todo]} {incr i} {
6737 set x [lindex $todo $i]
6738 if {$anc($x) eq {}} {
6741 foreach arc $arcnos($x) {
6742 set xd $arcstart($arc)
6744 set cached_isanc($a,$bend) 1
6745 set cached_isanc($b,$aend) 0
6747 } elseif {$xd eq $aend} {
6748 set cached_isanc($b,$aend) 1
6749 set cached_isanc($a,$bend) 0
6752 if {![info exists anc($xd)]} {
6753 set anc($xd) $anc($x)
6755 } elseif {$anc($xd) ne $anc($x)} {
6760 set cached_isanc($a,$bend) 0
6761 set cached_isanc($b,$aend) 0
6765 # This identifies whether $desc has an ancestor that is
6766 # a growing tip of the graph and which is not an ancestor of $anc
6767 # and returns 0 if so and 1 if not.
6768 # If we subsequently discover a tag on such a growing tip, and that
6769 # turns out to be a descendent of $anc (which it could, since we
6770 # don't necessarily see children before parents), then $desc
6771 # isn't a good choice to display as a descendent tag of
6772 # $anc (since it is the descendent of another tag which is
6773 # a descendent of $anc). Similarly, $anc isn't a good choice to
6774 # display as a ancestor tag of $desc.
6776 proc is_certain {desc anc} {
6777 global arcnos arcout arcstart arcend growing problems
6780 if {[llength $arcnos($anc)] == 1} {
6781 # tags on the same arc are certain
6782 if {$arcnos($desc) eq $arcnos($anc)} {
6785 if {![info exists arcout($anc)]} {
6786 # if $anc is partway along an arc, use the start of the arc instead
6787 set a [lindex $arcnos($anc) 0]
6788 set anc $arcstart($a)
6791 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6794 set a [lindex $arcnos($desc) 0]
6800 set anclist [list $x]
6804 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6805 set x [lindex $anclist $i]
6810 foreach a $arcout($x) {
6811 if {[info exists growing($a)]} {
6812 if {![info exists growanc($x)] && $dl($x)} {
6818 if {[info exists dl($y)]} {
6822 if {![info exists done($y)]} {
6825 if {[info exists growanc($x)]} {
6829 for {set k 0} {$k < [llength $xl]} {incr k} {
6830 set z [lindex $xl $k]
6831 foreach c $arcout($z) {
6832 if {[info exists arcend($c)]} {
6834 if {[info exists dl($v)] && $dl($v)} {
6836 if {![info exists done($v)]} {
6839 if {[info exists growanc($v)]} {
6849 } elseif {$y eq $anc || !$dl($x)} {
6860 foreach x [array names growanc] {
6869 proc validate_arctags {a} {
6870 global arctags idtags
6874 foreach id $arctags($a) {
6876 if {![info exists idtags($id)]} {
6877 set na [lreplace $na $i $i]
6884 proc validate_archeads {a} {
6885 global archeads idheads
6888 set na $archeads($a)
6889 foreach id $archeads($a) {
6891 if {![info exists idheads($id)]} {
6892 set na [lreplace $na $i $i]
6896 set archeads($a) $na
6899 # Return the list of IDs that have tags that are descendents of id,
6900 # ignoring IDs that are descendents of IDs already reported.
6901 proc desctags {id} {
6902 global arcnos arcstart arcids arctags idtags allparents
6903 global growing cached_dtags
6905 if {![info exists allparents($id)]} {
6908 set t1 [clock clicks -milliseconds]
6910 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6911 # part-way along an arc; check that arc first
6912 set a [lindex $arcnos($id) 0]
6913 if {$arctags($a) ne {}} {
6915 set i [lsearch -exact $arcids($a) $id]
6917 foreach t $arctags($a) {
6918 set j [lsearch -exact $arcids($a) $t]
6926 set id $arcstart($a)
6927 if {[info exists idtags($id)]} {
6931 if {[info exists cached_dtags($id)]} {
6932 return $cached_dtags($id)
6939 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6940 set id [lindex $todo $i]
6942 set ta [info exists hastaggedancestor($id)]
6946 # ignore tags on starting node
6947 if {!$ta && $i > 0} {
6948 if {[info exists idtags($id)]} {
6951 } elseif {[info exists cached_dtags($id)]} {
6952 set tagloc($id) $cached_dtags($id)
6956 foreach a $arcnos($id) {
6958 if {!$ta && $arctags($a) ne {}} {
6960 if {$arctags($a) ne {}} {
6961 lappend tagloc($id) [lindex $arctags($a) end]
6964 if {$ta || $arctags($a) ne {}} {
6965 set tomark [list $d]
6966 for {set j 0} {$j < [llength $tomark]} {incr j} {
6967 set dd [lindex $tomark $j]
6968 if {![info exists hastaggedancestor($dd)]} {
6969 if {[info exists done($dd)]} {
6970 foreach b $arcnos($dd) {
6971 lappend tomark $arcstart($b)
6973 if {[info exists tagloc($dd)]} {
6976 } elseif {[info exists queued($dd)]} {
6979 set hastaggedancestor($dd) 1
6983 if {![info exists queued($d)]} {
6986 if {![info exists hastaggedancestor($d)]} {
6993 foreach id [array names tagloc] {
6994 if {![info exists hastaggedancestor($id)]} {
6995 foreach t $tagloc($id) {
6996 if {[lsearch -exact $tags $t] < 0} {
7002 set t2 [clock clicks -milliseconds]
7005 # remove tags that are descendents of other tags
7006 for {set i 0} {$i < [llength $tags]} {incr i} {
7007 set a [lindex $tags $i]
7008 for {set j 0} {$j < $i} {incr j} {
7009 set b [lindex $tags $j]
7010 set r [anc_or_desc $a $b]
7012 set tags [lreplace $tags $j $j]
7015 } elseif {$r == -1} {
7016 set tags [lreplace $tags $i $i]
7023 if {[array names growing] ne {}} {
7024 # graph isn't finished, need to check if any tag could get
7025 # eclipsed by another tag coming later. Simply ignore any
7026 # tags that could later get eclipsed.
7029 if {[is_certain $t $origid]} {
7033 if {$tags eq $ctags} {
7034 set cached_dtags($origid) $tags
7039 set cached_dtags($origid) $tags
7041 set t3 [clock clicks -milliseconds]
7042 if {0 && $t3 - $t1 >= 100} {
7043 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7044 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7050 global arcnos arcids arcout arcend arctags idtags allparents
7051 global growing cached_atags
7053 if {![info exists allparents($id)]} {
7056 set t1 [clock clicks -milliseconds]
7058 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7059 # part-way along an arc; check that arc first
7060 set a [lindex $arcnos($id) 0]
7061 if {$arctags($a) ne {}} {
7063 set i [lsearch -exact $arcids($a) $id]
7064 foreach t $arctags($a) {
7065 set j [lsearch -exact $arcids($a) $t]
7071 if {![info exists arcend($a)]} {
7075 if {[info exists idtags($id)]} {
7079 if {[info exists cached_atags($id)]} {
7080 return $cached_atags($id)
7088 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7089 set id [lindex $todo $i]
7091 set td [info exists hastaggeddescendent($id)]
7095 # ignore tags on starting node
7096 if {!$td && $i > 0} {
7097 if {[info exists idtags($id)]} {
7100 } elseif {[info exists cached_atags($id)]} {
7101 set tagloc($id) $cached_atags($id)
7105 foreach a $arcout($id) {
7106 if {!$td && $arctags($a) ne {}} {
7108 if {$arctags($a) ne {}} {
7109 lappend tagloc($id) [lindex $arctags($a) 0]
7112 if {![info exists arcend($a)]} continue
7114 if {$td || $arctags($a) ne {}} {
7115 set tomark [list $d]
7116 for {set j 0} {$j < [llength $tomark]} {incr j} {
7117 set dd [lindex $tomark $j]
7118 if {![info exists hastaggeddescendent($dd)]} {
7119 if {[info exists done($dd)]} {
7120 foreach b $arcout($dd) {
7121 if {[info exists arcend($b)]} {
7122 lappend tomark $arcend($b)
7125 if {[info exists tagloc($dd)]} {
7128 } elseif {[info exists queued($dd)]} {
7131 set hastaggeddescendent($dd) 1
7135 if {![info exists queued($d)]} {
7138 if {![info exists hastaggeddescendent($d)]} {
7144 set t2 [clock clicks -milliseconds]
7147 foreach id [array names tagloc] {
7148 if {![info exists hastaggeddescendent($id)]} {
7149 foreach t $tagloc($id) {
7150 if {[lsearch -exact $tags $t] < 0} {
7157 # remove tags that are ancestors of other tags
7158 for {set i 0} {$i < [llength $tags]} {incr i} {
7159 set a [lindex $tags $i]
7160 for {set j 0} {$j < $i} {incr j} {
7161 set b [lindex $tags $j]
7162 set r [anc_or_desc $a $b]
7164 set tags [lreplace $tags $j $j]
7167 } elseif {$r == 1} {
7168 set tags [lreplace $tags $i $i]
7175 if {[array names growing] ne {}} {
7176 # graph isn't finished, need to check if any tag could get
7177 # eclipsed by another tag coming later. Simply ignore any
7178 # tags that could later get eclipsed.
7181 if {[is_certain $origid $t]} {
7185 if {$tags eq $ctags} {
7186 set cached_atags($origid) $tags
7191 set cached_atags($origid) $tags
7193 set t3 [clock clicks -milliseconds]
7194 if {0 && $t3 - $t1 >= 100} {
7195 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7196 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7201 # Return the list of IDs that have heads that are descendents of id,
7202 # including id itself if it has a head.
7203 proc descheads {id} {
7204 global arcnos arcstart arcids archeads idheads cached_dheads
7207 if {![info exists allparents($id)]} {
7211 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7212 # part-way along an arc; check it first
7213 set a [lindex $arcnos($id) 0]
7214 if {$archeads($a) ne {}} {
7215 validate_archeads $a
7216 set i [lsearch -exact $arcids($a) $id]
7217 foreach t $archeads($a) {
7218 set j [lsearch -exact $arcids($a) $t]
7223 set id $arcstart($a)
7229 for {set i 0} {$i < [llength $todo]} {incr i} {
7230 set id [lindex $todo $i]
7231 if {[info exists cached_dheads($id)]} {
7232 set ret [concat $ret $cached_dheads($id)]
7234 if {[info exists idheads($id)]} {
7237 foreach a $arcnos($id) {
7238 if {$archeads($a) ne {}} {
7239 validate_archeads $a
7240 if {$archeads($a) ne {}} {
7241 set ret [concat $ret $archeads($a)]
7245 if {![info exists seen($d)]} {
7252 set ret [lsort -unique $ret]
7253 set cached_dheads($origid) $ret
7254 return [concat $ret $aret]
7257 proc addedtag {id} {
7258 global arcnos arcout cached_dtags cached_atags
7260 if {![info exists arcnos($id)]} return
7261 if {![info exists arcout($id)]} {
7262 recalcarc [lindex $arcnos($id) 0]
7264 catch {unset cached_dtags}
7265 catch {unset cached_atags}
7268 proc addedhead {hid head} {
7269 global arcnos arcout cached_dheads
7271 if {![info exists arcnos($hid)]} return
7272 if {![info exists arcout($hid)]} {
7273 recalcarc [lindex $arcnos($hid) 0]
7275 catch {unset cached_dheads}
7278 proc removedhead {hid head} {
7279 global cached_dheads
7281 catch {unset cached_dheads}
7284 proc movedhead {hid head} {
7285 global arcnos arcout cached_dheads
7287 if {![info exists arcnos($hid)]} return
7288 if {![info exists arcout($hid)]} {
7289 recalcarc [lindex $arcnos($hid) 0]
7291 catch {unset cached_dheads}
7294 proc changedrefs {} {
7295 global cached_dheads cached_dtags cached_atags
7296 global arctags archeads arcnos arcout idheads idtags
7298 foreach id [concat [array names idheads] [array names idtags]] {
7299 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7300 set a [lindex $arcnos($id) 0]
7301 if {![info exists donearc($a)]} {
7307 catch {unset cached_dtags}
7308 catch {unset cached_atags}
7309 catch {unset cached_dheads}
7312 proc rereadrefs {} {
7313 global idtags idheads idotherrefs mainhead
7315 set refids [concat [array names idtags] \
7316 [array names idheads] [array names idotherrefs]]
7317 foreach id $refids {
7318 if {![info exists ref($id)]} {
7319 set ref($id) [listrefs $id]
7322 set oldmainhead $mainhead
7325 set refids [lsort -unique [concat $refids [array names idtags] \
7326 [array names idheads] [array names idotherrefs]]]
7327 foreach id $refids {
7328 set v [listrefs $id]
7329 if {![info exists ref($id)] || $ref($id) != $v ||
7330 ($id eq $oldmainhead && $id ne $mainhead) ||
7331 ($id eq $mainhead && $id ne $oldmainhead)} {
7338 proc listrefs {id} {
7339 global idtags idheads idotherrefs
7342 if {[info exists idtags($id)]} {
7346 if {[info exists idheads($id)]} {
7350 if {[info exists idotherrefs($id)]} {
7351 set z $idotherrefs($id)
7353 return [list $x $y $z]
7356 proc showtag {tag isnew} {
7357 global ctext tagcontents tagids linknum tagobjid
7360 addtohistory [list showtag $tag 0]
7362 $ctext conf -state normal
7365 if {![info exists tagcontents($tag)]} {
7367 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7370 if {[info exists tagcontents($tag)]} {
7371 set text $tagcontents($tag)
7373 set text "Tag: $tag\nId: $tagids($tag)"
7375 appendwithlinks $text {}
7376 $ctext conf -state disabled
7388 global maxwidth maxgraphpct diffopts
7389 global oldprefs prefstop showneartags showlocalchanges
7390 global bgcolor fgcolor ctext diffcolors selectbgcolor
7391 global uifont tabstop
7395 if {[winfo exists $top]} {
7399 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7400 set oldprefs($v) [set $v]
7403 wm title $top "Gitk preferences"
7404 label $top.ldisp -text "Commit list display options"
7405 $top.ldisp configure -font $uifont
7406 grid $top.ldisp - -sticky w -pady 10
7407 label $top.spacer -text " "
7408 label $top.maxwidthl -text "Maximum graph width (lines)" \
7410 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7411 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7412 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7414 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7415 grid x $top.maxpctl $top.maxpct -sticky w
7416 frame $top.showlocal
7417 label $top.showlocal.l -text "Show local changes" -font optionfont
7418 checkbutton $top.showlocal.b -variable showlocalchanges
7419 pack $top.showlocal.b $top.showlocal.l -side left
7420 grid x $top.showlocal -sticky w
7422 label $top.ddisp -text "Diff display options"
7423 $top.ddisp configure -font $uifont
7424 grid $top.ddisp - -sticky w -pady 10
7425 label $top.diffoptl -text "Options for diff program" \
7427 entry $top.diffopt -width 20 -textvariable diffopts
7428 grid x $top.diffoptl $top.diffopt -sticky w
7430 label $top.ntag.l -text "Display nearby tags" -font optionfont
7431 checkbutton $top.ntag.b -variable showneartags
7432 pack $top.ntag.b $top.ntag.l -side left
7433 grid x $top.ntag -sticky w
7434 label $top.tabstopl -text "tabstop" -font optionfont
7435 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7436 grid x $top.tabstopl $top.tabstop -sticky w
7438 label $top.cdisp -text "Colors: press to choose"
7439 $top.cdisp configure -font $uifont
7440 grid $top.cdisp - -sticky w -pady 10
7441 label $top.bg -padx 40 -relief sunk -background $bgcolor
7442 button $top.bgbut -text "Background" -font optionfont \
7443 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7444 grid x $top.bgbut $top.bg -sticky w
7445 label $top.fg -padx 40 -relief sunk -background $fgcolor
7446 button $top.fgbut -text "Foreground" -font optionfont \
7447 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7448 grid x $top.fgbut $top.fg -sticky w
7449 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7450 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7451 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7452 [list $ctext tag conf d0 -foreground]]
7453 grid x $top.diffoldbut $top.diffold -sticky w
7454 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7455 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7456 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7457 [list $ctext tag conf d1 -foreground]]
7458 grid x $top.diffnewbut $top.diffnew -sticky w
7459 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7460 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7461 -command [list choosecolor diffcolors 2 $top.hunksep \
7462 "diff hunk header" \
7463 [list $ctext tag conf hunksep -foreground]]
7464 grid x $top.hunksepbut $top.hunksep -sticky w
7465 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7466 button $top.selbgbut -text "Select bg" -font optionfont \
7467 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7468 grid x $top.selbgbut $top.selbgsep -sticky w
7471 button $top.buts.ok -text "OK" -command prefsok -default active
7472 $top.buts.ok configure -font $uifont
7473 button $top.buts.can -text "Cancel" -command prefscan -default normal
7474 $top.buts.can configure -font $uifont
7475 grid $top.buts.ok $top.buts.can
7476 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7477 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7478 grid $top.buts - - -pady 10 -sticky ew
7479 bind $top <Visibility> "focus $top.buts.ok"
7482 proc choosecolor {v vi w x cmd} {
7485 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7486 -title "Gitk: choose color for $x"]
7487 if {$c eq {}} return
7488 $w conf -background $c
7494 global bglist cflist
7496 $w configure -selectbackground $c
7498 $cflist tag configure highlight \
7499 -background [$cflist cget -selectbackground]
7500 allcanvs itemconf secsel -fill $c
7507 $w conf -background $c
7515 $w conf -foreground $c
7517 allcanvs itemconf text -fill $c
7518 $canv itemconf circle -outline $c
7522 global maxwidth maxgraphpct diffopts
7523 global oldprefs prefstop showneartags showlocalchanges
7525 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7526 set $v $oldprefs($v)
7528 catch {destroy $prefstop}
7533 global maxwidth maxgraphpct
7534 global oldprefs prefstop showneartags showlocalchanges
7535 global charspc ctext tabstop
7537 catch {destroy $prefstop}
7539 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7540 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7541 if {$showlocalchanges} {
7547 if {$maxwidth != $oldprefs(maxwidth)
7548 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7550 } elseif {$showneartags != $oldprefs(showneartags)} {
7555 proc formatdate {d} {
7556 global datetimeformat
7558 set d [clock format $d -format $datetimeformat]
7563 # This list of encoding names and aliases is distilled from
7564 # http://www.iana.org/assignments/character-sets.
7565 # Not all of them are supported by Tcl.
7566 set encoding_aliases {
7567 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7568 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7569 { ISO-10646-UTF-1 csISO10646UTF1 }
7570 { ISO_646.basic:1983 ref csISO646basic1983 }
7571 { INVARIANT csINVARIANT }
7572 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7573 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7574 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7575 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7576 { NATS-DANO iso-ir-9-1 csNATSDANO }
7577 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7578 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7579 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7580 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7581 { ISO-2022-KR csISO2022KR }
7583 { ISO-2022-JP csISO2022JP }
7584 { ISO-2022-JP-2 csISO2022JP2 }
7585 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7587 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7588 { IT iso-ir-15 ISO646-IT csISO15Italian }
7589 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7590 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7591 { greek7-old iso-ir-18 csISO18Greek7Old }
7592 { latin-greek iso-ir-19 csISO19LatinGreek }
7593 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7594 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7595 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7596 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7597 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7598 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7599 { INIS iso-ir-49 csISO49INIS }
7600 { INIS-8 iso-ir-50 csISO50INIS8 }
7601 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7602 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7603 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7604 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7605 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7606 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7608 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7609 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7610 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7611 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7612 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7613 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7614 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7615 { greek7 iso-ir-88 csISO88Greek7 }
7616 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7617 { iso-ir-90 csISO90 }
7618 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7619 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7620 csISO92JISC62991984b }
7621 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7622 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7623 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7624 csISO95JIS62291984handadd }
7625 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7626 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7627 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7628 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7630 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7631 { T.61-7bit iso-ir-102 csISO102T617bit }
7632 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7633 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7634 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7635 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7636 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7637 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7638 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7639 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7640 arabic csISOLatinArabic }
7641 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7642 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7643 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7644 greek greek8 csISOLatinGreek }
7645 { T.101-G2 iso-ir-128 csISO128T101G2 }
7646 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7648 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7649 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7650 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7651 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7652 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7653 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7654 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7655 csISOLatinCyrillic }
7656 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7657 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7658 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7659 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7660 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7661 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7662 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7663 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7664 { ISO_10367-box iso-ir-155 csISO10367Box }
7665 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7666 { latin-lap lap iso-ir-158 csISO158Lap }
7667 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7668 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7671 { JIS_X0201 X0201 csHalfWidthKatakana }
7672 { KSC5636 ISO646-KR csKSC5636 }
7673 { ISO-10646-UCS-2 csUnicode }
7674 { ISO-10646-UCS-4 csUCS4 }
7675 { DEC-MCS dec csDECMCS }
7676 { hp-roman8 roman8 r8 csHPRoman8 }
7677 { macintosh mac csMacintosh }
7678 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7680 { IBM038 EBCDIC-INT cp038 csIBM038 }
7681 { IBM273 CP273 csIBM273 }
7682 { IBM274 EBCDIC-BE CP274 csIBM274 }
7683 { IBM275 EBCDIC-BR cp275 csIBM275 }
7684 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7685 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7686 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7687 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7688 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7689 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7690 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7691 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7692 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7693 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7694 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7695 { IBM437 cp437 437 csPC8CodePage437 }
7696 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7697 { IBM775 cp775 csPC775Baltic }
7698 { IBM850 cp850 850 csPC850Multilingual }
7699 { IBM851 cp851 851 csIBM851 }
7700 { IBM852 cp852 852 csPCp852 }
7701 { IBM855 cp855 855 csIBM855 }
7702 { IBM857 cp857 857 csIBM857 }
7703 { IBM860 cp860 860 csIBM860 }
7704 { IBM861 cp861 861 cp-is csIBM861 }
7705 { IBM862 cp862 862 csPC862LatinHebrew }
7706 { IBM863 cp863 863 csIBM863 }
7707 { IBM864 cp864 csIBM864 }
7708 { IBM865 cp865 865 csIBM865 }
7709 { IBM866 cp866 866 csIBM866 }
7710 { IBM868 CP868 cp-ar csIBM868 }
7711 { IBM869 cp869 869 cp-gr csIBM869 }
7712 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7713 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7714 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7715 { IBM891 cp891 csIBM891 }
7716 { IBM903 cp903 csIBM903 }
7717 { IBM904 cp904 904 csIBBM904 }
7718 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7719 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7720 { IBM1026 CP1026 csIBM1026 }
7721 { EBCDIC-AT-DE csIBMEBCDICATDE }
7722 { EBCDIC-AT-DE-A csEBCDICATDEA }
7723 { EBCDIC-CA-FR csEBCDICCAFR }
7724 { EBCDIC-DK-NO csEBCDICDKNO }
7725 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7726 { EBCDIC-FI-SE csEBCDICFISE }
7727 { EBCDIC-FI-SE-A csEBCDICFISEA }
7728 { EBCDIC-FR csEBCDICFR }
7729 { EBCDIC-IT csEBCDICIT }
7730 { EBCDIC-PT csEBCDICPT }
7731 { EBCDIC-ES csEBCDICES }
7732 { EBCDIC-ES-A csEBCDICESA }
7733 { EBCDIC-ES-S csEBCDICESS }
7734 { EBCDIC-UK csEBCDICUK }
7735 { EBCDIC-US csEBCDICUS }
7736 { UNKNOWN-8BIT csUnknown8BiT }
7737 { MNEMONIC csMnemonic }
7742 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7743 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7744 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7745 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7746 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7747 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7748 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7749 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7750 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7751 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7752 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7753 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7754 { IBM1047 IBM-1047 }
7755 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7756 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7757 { UNICODE-1-1 csUnicode11 }
7760 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7761 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7763 { ISO-8859-15 ISO_8859-15 Latin-9 }
7764 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7765 { GBK CP936 MS936 windows-936 }
7766 { JIS_Encoding csJISEncoding }
7767 { Shift_JIS MS_Kanji csShiftJIS }
7768 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7770 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7771 { ISO-10646-UCS-Basic csUnicodeASCII }
7772 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7773 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7774 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7775 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7776 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7777 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7778 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7779 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7780 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7781 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7782 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7783 { Ventura-US csVenturaUS }
7784 { Ventura-International csVenturaInternational }
7785 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7786 { PC8-Turkish csPC8Turkish }
7787 { IBM-Symbols csIBMSymbols }
7788 { IBM-Thai csIBMThai }
7789 { HP-Legal csHPLegal }
7790 { HP-Pi-font csHPPiFont }
7791 { HP-Math8 csHPMath8 }
7792 { Adobe-Symbol-Encoding csHPPSMath }
7793 { HP-DeskTop csHPDesktop }
7794 { Ventura-Math csVenturaMath }
7795 { Microsoft-Publishing csMicrosoftPublishing }
7796 { Windows-31J csWindows31J }
7801 proc tcl_encoding {enc} {
7802 global encoding_aliases
7803 set names [encoding names]
7804 set lcnames [string tolower $names]
7805 set enc [string tolower $enc]
7806 set i [lsearch -exact $lcnames $enc]
7808 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7809 if {[regsub {^iso[-_]} $enc iso encx]} {
7810 set i [lsearch -exact $lcnames $encx]
7814 foreach l $encoding_aliases {
7815 set ll [string tolower $l]
7816 if {[lsearch -exact $ll $enc] < 0} continue
7817 # look through the aliases for one that tcl knows about
7819 set i [lsearch -exact $lcnames $e]
7821 if {[regsub {^iso[-_]} $e iso ex]} {
7822 set i [lsearch -exact $lcnames $ex]
7831 return [lindex $names $i]
7838 set diffopts "-U 5 -p"
7839 set wrcomcmd "git diff-tree --stdin -p --pretty"
7843 set gitencoding [exec git config --get i18n.commitencoding]
7845 if {$gitencoding == ""} {
7846 set gitencoding "utf-8"
7848 set tclencoding [tcl_encoding $gitencoding]
7849 if {$tclencoding == {}} {
7850 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7853 set mainfont {Helvetica 9}
7854 set textfont {Courier 9}
7855 set uifont {Helvetica 9 bold}
7857 set findmergefiles 0
7865 set cmitmode "patch"
7866 set wrapcomment "none"
7870 set showlocalchanges 1
7871 set datetimeformat "%Y-%m-%d %H:%M:%S"
7873 set colors {green red blue magenta darkgrey brown orange}
7876 set diffcolors {red "#00a000" blue}
7878 set selectbgcolor gray85
7880 catch {source ~/.gitk}
7882 font create optionfont -family sans-serif -size -12
7884 # check that we can find a .git directory somewhere...
7885 if {[catch {set gitdir [gitdir]}]} {
7886 show_error {} . "Cannot find a git repository here."
7889 if {![file isdirectory $gitdir]} {
7890 show_error {} . "Cannot find the git directory \"$gitdir\"."
7895 set cmdline_files {}
7900 "-d" { set datemode 1 }
7902 set cmdline_files [lrange $argv [expr {$i + 1}] end]
7906 lappend revtreeargs $arg
7912 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7913 # no -- on command line, but some arguments (other than -d)
7915 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7916 set cmdline_files [split $f "\n"]
7917 set n [llength $cmdline_files]
7918 set revtreeargs [lrange $revtreeargs 0 end-$n]
7919 # Unfortunately git rev-parse doesn't produce an error when
7920 # something is both a revision and a filename. To be consistent
7921 # with git log and git rev-list, check revtreeargs for filenames.
7922 foreach arg $revtreeargs {
7923 if {[file exists $arg]} {
7924 show_error {} . "Ambiguous argument '$arg': both revision\
7930 # unfortunately we get both stdout and stderr in $err,
7931 # so look for "fatal:".
7932 set i [string first "fatal:" $err]
7934 set err [string range $err [expr {$i + 6}] end]
7936 show_error {} . "Bad arguments to gitk:\n$err"
7941 set nullid "0000000000000000000000000000000000000000"
7942 set nullid2 "0000000000000000000000000000000000000001"
7950 set highlight_paths {}
7951 set searchdirn -forwards
7955 set markingmatches 0
7962 set selectedhlview None
7971 set lookingforhead 0
7977 # wait for the window to become visible
7979 wm title . "[file tail $argv0]: [file tail [pwd]]"
7982 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7983 # create a view for the files/dirs specified on the command line
7987 set viewname(1) "Command line"
7988 set viewfiles(1) $cmdline_files
7989 set viewargs(1) $revtreeargs
7992 .bar.view entryconf Edit* -state normal
7993 .bar.view entryconf Delete* -state normal
7996 if {[info exists permviews]} {
7997 foreach v $permviews {
8000 set viewname($n) [lindex $v 0]
8001 set viewfiles($n) [lindex $v 1]
8002 set viewargs($n) [lindex $v 2]