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 --no-color -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"
846 if {[tk windowingsystem] eq "aqua"} {
847 bindall <MouseWheel> {
848 set delta [expr {- (%D)}]
849 allcanvs yview scroll $delta units
853 bindall <2> "canvscan mark %W %x %y"
854 bindall <B2-Motion> "canvscan dragto %W %x %y"
855 bindkey <Home> selfirstline
856 bindkey <End> sellastline
857 bind . <Key-Up> "selnextline -1"
858 bind . <Key-Down> "selnextline 1"
859 bind . <Shift-Key-Up> "next_highlight -1"
860 bind . <Shift-Key-Down> "next_highlight 1"
861 bindkey <Key-Right> "goforw"
862 bindkey <Key-Left> "goback"
863 bind . <Key-Prior> "selnextpage -1"
864 bind . <Key-Next> "selnextpage 1"
865 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
866 bind . <$M1B-End> "allcanvs yview moveto 1.0"
867 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
868 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
869 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
870 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
871 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
872 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
873 bindkey <Key-space> "$ctext yview scroll 1 pages"
874 bindkey p "selnextline -1"
875 bindkey n "selnextline 1"
878 bindkey i "selnextline -1"
879 bindkey k "selnextline 1"
882 bindkey b "$ctext yview scroll -1 pages"
883 bindkey d "$ctext yview scroll 18 units"
884 bindkey u "$ctext yview scroll -18 units"
885 bindkey / {findnext 1}
886 bindkey <Key-Return> {findnext 0}
889 bindkey <F5> updatecommits
890 bind . <$M1B-q> doquit
891 bind . <$M1B-f> dofind
892 bind . <$M1B-g> {findnext 0}
893 bind . <$M1B-r> dosearchback
894 bind . <$M1B-s> dosearch
895 bind . <$M1B-equal> {incrfont 1}
896 bind . <$M1B-KP_Add> {incrfont 1}
897 bind . <$M1B-minus> {incrfont -1}
898 bind . <$M1B-KP_Subtract> {incrfont -1}
899 wm protocol . WM_DELETE_WINDOW doquit
900 bind . <Button-1> "click %W"
901 bind $fstring <Key-Return> dofind
902 bind $sha1entry <Key-Return> gotocommit
903 bind $sha1entry <<PasteSelection>> clearsha1
904 bind $cflist <1> {sel_flist %W %x %y; break}
905 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
906 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
907 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
909 set maincursor [. cget -cursor]
910 set textcursor [$ctext cget -cursor]
911 set curtextcursor $textcursor
913 set rowctxmenu .rowctxmenu
914 menu $rowctxmenu -tearoff 0
915 $rowctxmenu add command -label "Diff this -> selected" \
916 -command {diffvssel 0}
917 $rowctxmenu add command -label "Diff selected -> this" \
918 -command {diffvssel 1}
919 $rowctxmenu add command -label "Make patch" -command mkpatch
920 $rowctxmenu add command -label "Create tag" -command mktag
921 $rowctxmenu add command -label "Write commit to file" -command writecommit
922 $rowctxmenu add command -label "Create new branch" -command mkbranch
923 $rowctxmenu add command -label "Cherry-pick this commit" \
925 $rowctxmenu add command -label "Reset HEAD branch to here" \
928 set fakerowmenu .fakerowmenu
929 menu $fakerowmenu -tearoff 0
930 $fakerowmenu add command -label "Diff this -> selected" \
931 -command {diffvssel 0}
932 $fakerowmenu add command -label "Diff selected -> this" \
933 -command {diffvssel 1}
934 $fakerowmenu add command -label "Make patch" -command mkpatch
935 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
936 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
937 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
939 set headctxmenu .headctxmenu
940 menu $headctxmenu -tearoff 0
941 $headctxmenu add command -label "Check out this branch" \
943 $headctxmenu add command -label "Remove this branch" \
947 set flist_menu .flistctxmenu
948 menu $flist_menu -tearoff 0
949 $flist_menu add command -label "Highlight this too" \
950 -command {flist_hl 0}
951 $flist_menu add command -label "Highlight this only" \
952 -command {flist_hl 1}
955 # Windows sends all mouse wheel events to the current focused window, not
956 # the one where the mouse hovers, so bind those events here and redirect
957 # to the correct window
958 proc windows_mousewheel_redirector {W X Y D} {
959 global canv canv2 canv3
960 set w [winfo containing -displayof $W $X $Y]
962 set u [expr {$D < 0 ? 5 : -5}]
963 if {$w == $canv || $w == $canv2 || $w == $canv3} {
964 allcanvs yview scroll $u units
967 $w yview scroll $u units
973 # mouse-2 makes all windows scan vertically, but only the one
974 # the cursor is in scans horizontally
975 proc canvscan {op w x y} {
976 global canv canv2 canv3
977 foreach c [list $canv $canv2 $canv3] {
986 proc scrollcanv {cscroll f0 f1} {
992 # when we make a key binding for the toplevel, make sure
993 # it doesn't get triggered when that key is pressed in the
994 # find string entry widget.
995 proc bindkey {ev script} {
998 set escript [bind Entry $ev]
999 if {$escript == {}} {
1000 set escript [bind Entry <Key>]
1002 foreach e $entries {
1003 bind $e $ev "$escript; break"
1007 # set the focus back to the toplevel for any click outside
1010 global ctext entries
1011 foreach e [concat $entries $ctext] {
1012 if {$w == $e} return
1017 proc savestuff {w} {
1018 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1019 global stuffsaved findmergefiles maxgraphpct
1020 global maxwidth showneartags showlocalchanges
1021 global viewname viewfiles viewargs viewperm nextviewnum
1022 global cmitmode wrapcomment datetimeformat limitdiffs
1023 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1025 if {$stuffsaved} return
1026 if {![winfo viewable .]} return
1028 set f [open "~/.gitk-new" w]
1029 puts $f [list set mainfont $mainfont]
1030 puts $f [list set textfont $textfont]
1031 puts $f [list set uifont $uifont]
1032 puts $f [list set tabstop $tabstop]
1033 puts $f [list set findmergefiles $findmergefiles]
1034 puts $f [list set maxgraphpct $maxgraphpct]
1035 puts $f [list set maxwidth $maxwidth]
1036 puts $f [list set cmitmode $cmitmode]
1037 puts $f [list set wrapcomment $wrapcomment]
1038 puts $f [list set showneartags $showneartags]
1039 puts $f [list set showlocalchanges $showlocalchanges]
1040 puts $f [list set datetimeformat $datetimeformat]
1041 puts $f [list set limitdiffs $limitdiffs]
1042 puts $f [list set bgcolor $bgcolor]
1043 puts $f [list set fgcolor $fgcolor]
1044 puts $f [list set colors $colors]
1045 puts $f [list set diffcolors $diffcolors]
1046 puts $f [list set diffcontext $diffcontext]
1047 puts $f [list set selectbgcolor $selectbgcolor]
1049 puts $f "set geometry(main) [wm geometry .]"
1050 puts $f "set geometry(topwidth) [winfo width .tf]"
1051 puts $f "set geometry(topheight) [winfo height .tf]"
1052 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1053 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1054 puts $f "set geometry(botwidth) [winfo width .bleft]"
1055 puts $f "set geometry(botheight) [winfo height .bleft]"
1057 puts -nonewline $f "set permviews {"
1058 for {set v 0} {$v < $nextviewnum} {incr v} {
1059 if {$viewperm($v)} {
1060 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1065 file rename -force "~/.gitk-new" "~/.gitk"
1070 proc resizeclistpanes {win w} {
1072 if {[info exists oldwidth($win)]} {
1073 set s0 [$win sash coord 0]
1074 set s1 [$win sash coord 1]
1076 set sash0 [expr {int($w/2 - 2)}]
1077 set sash1 [expr {int($w*5/6 - 2)}]
1079 set factor [expr {1.0 * $w / $oldwidth($win)}]
1080 set sash0 [expr {int($factor * [lindex $s0 0])}]
1081 set sash1 [expr {int($factor * [lindex $s1 0])}]
1085 if {$sash1 < $sash0 + 20} {
1086 set sash1 [expr {$sash0 + 20}]
1088 if {$sash1 > $w - 10} {
1089 set sash1 [expr {$w - 10}]
1090 if {$sash0 > $sash1 - 20} {
1091 set sash0 [expr {$sash1 - 20}]
1095 $win sash place 0 $sash0 [lindex $s0 1]
1096 $win sash place 1 $sash1 [lindex $s1 1]
1098 set oldwidth($win) $w
1101 proc resizecdetpanes {win w} {
1103 if {[info exists oldwidth($win)]} {
1104 set s0 [$win sash coord 0]
1106 set sash0 [expr {int($w*3/4 - 2)}]
1108 set factor [expr {1.0 * $w / $oldwidth($win)}]
1109 set sash0 [expr {int($factor * [lindex $s0 0])}]
1113 if {$sash0 > $w - 15} {
1114 set sash0 [expr {$w - 15}]
1117 $win sash place 0 $sash0 [lindex $s0 1]
1119 set oldwidth($win) $w
1122 proc allcanvs args {
1123 global canv canv2 canv3
1129 proc bindall {event action} {
1130 global canv canv2 canv3
1131 bind $canv $event $action
1132 bind $canv2 $event $action
1133 bind $canv3 $event $action
1139 if {[winfo exists $w]} {
1144 wm title $w "About gitk"
1145 message $w.m -text {
1146 Gitk - a commit viewer for git
1148 Copyright © 2005-2006 Paul Mackerras
1150 Use and redistribute under the terms of the GNU General Public License} \
1151 -justify center -aspect 400 -border 2 -bg white -relief groove
1152 pack $w.m -side top -fill x -padx 2 -pady 2
1153 $w.m configure -font $uifont
1154 button $w.ok -text Close -command "destroy $w" -default active
1155 pack $w.ok -side bottom
1156 $w.ok configure -font $uifont
1157 bind $w <Visibility> "focus $w.ok"
1158 bind $w <Key-Escape> "destroy $w"
1159 bind $w <Key-Return> "destroy $w"
1165 if {[winfo exists $w]} {
1169 if {[tk windowingsystem] eq {aqua}} {
1175 wm title $w "Gitk key bindings"
1176 message $w.m -text "
1180 <Home> Move to first commit
1181 <End> Move to last commit
1182 <Up>, p, i Move up one commit
1183 <Down>, n, k Move down one commit
1184 <Left>, z, j Go back in history list
1185 <Right>, x, l Go forward in history list
1186 <PageUp> Move up one page in commit list
1187 <PageDown> Move down one page in commit list
1188 <$M1T-Home> Scroll to top of commit list
1189 <$M1T-End> Scroll to bottom of commit list
1190 <$M1T-Up> Scroll commit list up one line
1191 <$M1T-Down> Scroll commit list down one line
1192 <$M1T-PageUp> Scroll commit list up one page
1193 <$M1T-PageDown> Scroll commit list down one page
1194 <Shift-Up> Move to previous highlighted line
1195 <Shift-Down> Move to next highlighted line
1196 <Delete>, b Scroll diff view up one page
1197 <Backspace> Scroll diff view up one page
1198 <Space> Scroll diff view down one page
1199 u Scroll diff view up 18 lines
1200 d Scroll diff view down 18 lines
1202 <$M1T-G> Move to next find hit
1203 <Return> Move to next find hit
1204 / Move to next find hit, or redo find
1205 ? Move to previous find hit
1206 f Scroll diff view to next file
1207 <$M1T-S> Search for next hit in diff view
1208 <$M1T-R> Search for previous hit in diff view
1209 <$M1T-KP+> Increase font size
1210 <$M1T-plus> Increase font size
1211 <$M1T-KP-> Decrease font size
1212 <$M1T-minus> Decrease font size
1215 -justify left -bg white -border 2 -relief groove
1216 pack $w.m -side top -fill both -padx 2 -pady 2
1217 $w.m configure -font $uifont
1218 button $w.ok -text Close -command "destroy $w" -default active
1219 pack $w.ok -side bottom
1220 $w.ok configure -font $uifont
1221 bind $w <Visibility> "focus $w.ok"
1222 bind $w <Key-Escape> "destroy $w"
1223 bind $w <Key-Return> "destroy $w"
1226 # Procedures for manipulating the file list window at the
1227 # bottom right of the overall window.
1229 proc treeview {w l openlevs} {
1230 global treecontents treediropen treeheight treeparent treeindex
1240 set treecontents() {}
1241 $w conf -state normal
1243 while {[string range $f 0 $prefixend] ne $prefix} {
1244 if {$lev <= $openlevs} {
1245 $w mark set e:$treeindex($prefix) "end -1c"
1246 $w mark gravity e:$treeindex($prefix) left
1248 set treeheight($prefix) $ht
1249 incr ht [lindex $htstack end]
1250 set htstack [lreplace $htstack end end]
1251 set prefixend [lindex $prefendstack end]
1252 set prefendstack [lreplace $prefendstack end end]
1253 set prefix [string range $prefix 0 $prefixend]
1256 set tail [string range $f [expr {$prefixend+1}] end]
1257 while {[set slash [string first "/" $tail]] >= 0} {
1260 lappend prefendstack $prefixend
1261 incr prefixend [expr {$slash + 1}]
1262 set d [string range $tail 0 $slash]
1263 lappend treecontents($prefix) $d
1264 set oldprefix $prefix
1266 set treecontents($prefix) {}
1267 set treeindex($prefix) [incr ix]
1268 set treeparent($prefix) $oldprefix
1269 set tail [string range $tail [expr {$slash+1}] end]
1270 if {$lev <= $openlevs} {
1272 set treediropen($prefix) [expr {$lev < $openlevs}]
1273 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1274 $w mark set d:$ix "end -1c"
1275 $w mark gravity d:$ix left
1277 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1279 $w image create end -align center -image $bm -padx 1 \
1281 $w insert end $d [highlight_tag $prefix]
1282 $w mark set s:$ix "end -1c"
1283 $w mark gravity s:$ix left
1288 if {$lev <= $openlevs} {
1291 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1293 $w insert end $tail [highlight_tag $f]
1295 lappend treecontents($prefix) $tail
1298 while {$htstack ne {}} {
1299 set treeheight($prefix) $ht
1300 incr ht [lindex $htstack end]
1301 set htstack [lreplace $htstack end end]
1302 set prefixend [lindex $prefendstack end]
1303 set prefendstack [lreplace $prefendstack end end]
1304 set prefix [string range $prefix 0 $prefixend]
1306 $w conf -state disabled
1309 proc linetoelt {l} {
1310 global treeheight treecontents
1315 foreach e $treecontents($prefix) {
1320 if {[string index $e end] eq "/"} {
1321 set n $treeheight($prefix$e)
1333 proc highlight_tree {y prefix} {
1334 global treeheight treecontents cflist
1336 foreach e $treecontents($prefix) {
1338 if {[highlight_tag $path] ne {}} {
1339 $cflist tag add bold $y.0 "$y.0 lineend"
1342 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1343 set y [highlight_tree $y $path]
1349 proc treeclosedir {w dir} {
1350 global treediropen treeheight treeparent treeindex
1352 set ix $treeindex($dir)
1353 $w conf -state normal
1354 $w delete s:$ix e:$ix
1355 set treediropen($dir) 0
1356 $w image configure a:$ix -image tri-rt
1357 $w conf -state disabled
1358 set n [expr {1 - $treeheight($dir)}]
1359 while {$dir ne {}} {
1360 incr treeheight($dir) $n
1361 set dir $treeparent($dir)
1365 proc treeopendir {w dir} {
1366 global treediropen treeheight treeparent treecontents treeindex
1368 set ix $treeindex($dir)
1369 $w conf -state normal
1370 $w image configure a:$ix -image tri-dn
1371 $w mark set e:$ix s:$ix
1372 $w mark gravity e:$ix right
1375 set n [llength $treecontents($dir)]
1376 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1379 incr treeheight($x) $n
1381 foreach e $treecontents($dir) {
1383 if {[string index $e end] eq "/"} {
1384 set iy $treeindex($de)
1385 $w mark set d:$iy e:$ix
1386 $w mark gravity d:$iy left
1387 $w insert e:$ix $str
1388 set treediropen($de) 0
1389 $w image create e:$ix -align center -image tri-rt -padx 1 \
1391 $w insert e:$ix $e [highlight_tag $de]
1392 $w mark set s:$iy e:$ix
1393 $w mark gravity s:$iy left
1394 set treeheight($de) 1
1396 $w insert e:$ix $str
1397 $w insert e:$ix $e [highlight_tag $de]
1400 $w mark gravity e:$ix left
1401 $w conf -state disabled
1402 set treediropen($dir) 1
1403 set top [lindex [split [$w index @0,0] .] 0]
1404 set ht [$w cget -height]
1405 set l [lindex [split [$w index s:$ix] .] 0]
1408 } elseif {$l + $n + 1 > $top + $ht} {
1409 set top [expr {$l + $n + 2 - $ht}]
1417 proc treeclick {w x y} {
1418 global treediropen cmitmode ctext cflist cflist_top
1420 if {$cmitmode ne "tree"} return
1421 if {![info exists cflist_top]} return
1422 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1423 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1424 $cflist tag add highlight $l.0 "$l.0 lineend"
1430 set e [linetoelt $l]
1431 if {[string index $e end] ne "/"} {
1433 } elseif {$treediropen($e)} {
1440 proc setfilelist {id} {
1441 global treefilelist cflist
1443 treeview $cflist $treefilelist($id) 0
1446 image create bitmap tri-rt -background black -foreground blue -data {
1447 #define tri-rt_width 13
1448 #define tri-rt_height 13
1449 static unsigned char tri-rt_bits[] = {
1450 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1451 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1454 #define tri-rt-mask_width 13
1455 #define tri-rt-mask_height 13
1456 static unsigned char tri-rt-mask_bits[] = {
1457 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1458 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1461 image create bitmap tri-dn -background black -foreground blue -data {
1462 #define tri-dn_width 13
1463 #define tri-dn_height 13
1464 static unsigned char tri-dn_bits[] = {
1465 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1466 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1469 #define tri-dn-mask_width 13
1470 #define tri-dn-mask_height 13
1471 static unsigned char tri-dn-mask_bits[] = {
1472 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1473 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1477 image create bitmap reficon-T -background black -foreground yellow -data {
1478 #define tagicon_width 13
1479 #define tagicon_height 9
1480 static unsigned char tagicon_bits[] = {
1481 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1482 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1484 #define tagicon-mask_width 13
1485 #define tagicon-mask_height 9
1486 static unsigned char tagicon-mask_bits[] = {
1487 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1488 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1491 #define headicon_width 13
1492 #define headicon_height 9
1493 static unsigned char headicon_bits[] = {
1494 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1495 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1498 #define headicon-mask_width 13
1499 #define headicon-mask_height 9
1500 static unsigned char headicon-mask_bits[] = {
1501 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1502 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1504 image create bitmap reficon-H -background black -foreground green \
1505 -data $rectdata -maskdata $rectmask
1506 image create bitmap reficon-o -background black -foreground "#ddddff" \
1507 -data $rectdata -maskdata $rectmask
1509 proc init_flist {first} {
1510 global cflist cflist_top selectedline difffilestart
1512 $cflist conf -state normal
1513 $cflist delete 0.0 end
1515 $cflist insert end $first
1517 $cflist tag add highlight 1.0 "1.0 lineend"
1519 catch {unset cflist_top}
1521 $cflist conf -state disabled
1522 set difffilestart {}
1525 proc highlight_tag {f} {
1526 global highlight_paths
1528 foreach p $highlight_paths {
1529 if {[string match $p $f]} {
1536 proc highlight_filelist {} {
1537 global cmitmode cflist
1539 $cflist conf -state normal
1540 if {$cmitmode ne "tree"} {
1541 set end [lindex [split [$cflist index end] .] 0]
1542 for {set l 2} {$l < $end} {incr l} {
1543 set line [$cflist get $l.0 "$l.0 lineend"]
1544 if {[highlight_tag $line] ne {}} {
1545 $cflist tag add bold $l.0 "$l.0 lineend"
1551 $cflist conf -state disabled
1554 proc unhighlight_filelist {} {
1557 $cflist conf -state normal
1558 $cflist tag remove bold 1.0 end
1559 $cflist conf -state disabled
1562 proc add_flist {fl} {
1565 $cflist conf -state normal
1567 $cflist insert end "\n"
1568 $cflist insert end $f [highlight_tag $f]
1570 $cflist conf -state disabled
1573 proc sel_flist {w x y} {
1574 global ctext difffilestart cflist cflist_top cmitmode
1576 if {$cmitmode eq "tree"} return
1577 if {![info exists cflist_top]} return
1578 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1579 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1580 $cflist tag add highlight $l.0 "$l.0 lineend"
1585 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1589 proc pop_flist_menu {w X Y x y} {
1590 global ctext cflist cmitmode flist_menu flist_menu_file
1591 global treediffs diffids
1593 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1595 if {$cmitmode eq "tree"} {
1596 set e [linetoelt $l]
1597 if {[string index $e end] eq "/"} return
1599 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1601 set flist_menu_file $e
1602 tk_popup $flist_menu $X $Y
1605 proc flist_hl {only} {
1606 global flist_menu_file highlight_files
1608 set x [shellquote $flist_menu_file]
1609 if {$only || $highlight_files eq {}} {
1610 set highlight_files $x
1612 append highlight_files " " $x
1616 # Functions for adding and removing shell-type quoting
1618 proc shellquote {str} {
1619 if {![string match "*\['\"\\ \t]*" $str]} {
1622 if {![string match "*\['\"\\]*" $str]} {
1625 if {![string match "*'*" $str]} {
1628 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1631 proc shellarglist {l} {
1637 append str [shellquote $a]
1642 proc shelldequote {str} {
1647 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1648 append ret [string range $str $used end]
1649 set used [string length $str]
1652 set first [lindex $first 0]
1653 set ch [string index $str $first]
1654 if {$first > $used} {
1655 append ret [string range $str $used [expr {$first - 1}]]
1658 if {$ch eq " " || $ch eq "\t"} break
1661 set first [string first "'" $str $used]
1663 error "unmatched single-quote"
1665 append ret [string range $str $used [expr {$first - 1}]]
1670 if {$used >= [string length $str]} {
1671 error "trailing backslash"
1673 append ret [string index $str $used]
1678 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1679 error "unmatched double-quote"
1681 set first [lindex $first 0]
1682 set ch [string index $str $first]
1683 if {$first > $used} {
1684 append ret [string range $str $used [expr {$first - 1}]]
1687 if {$ch eq "\""} break
1689 append ret [string index $str $used]
1693 return [list $used $ret]
1696 proc shellsplit {str} {
1699 set str [string trimleft $str]
1700 if {$str eq {}} break
1701 set dq [shelldequote $str]
1702 set n [lindex $dq 0]
1703 set word [lindex $dq 1]
1704 set str [string range $str $n end]
1710 # Code to implement multiple views
1712 proc newview {ishighlight} {
1713 global nextviewnum newviewname newviewperm uifont newishighlight
1714 global newviewargs revtreeargs
1716 set newishighlight $ishighlight
1718 if {[winfo exists $top]} {
1722 set newviewname($nextviewnum) "View $nextviewnum"
1723 set newviewperm($nextviewnum) 0
1724 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1725 vieweditor $top $nextviewnum "Gitk view definition"
1730 global viewname viewperm newviewname newviewperm
1731 global viewargs newviewargs
1733 set top .gitkvedit-$curview
1734 if {[winfo exists $top]} {
1738 set newviewname($curview) $viewname($curview)
1739 set newviewperm($curview) $viewperm($curview)
1740 set newviewargs($curview) [shellarglist $viewargs($curview)]
1741 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1744 proc vieweditor {top n title} {
1745 global newviewname newviewperm viewfiles
1749 wm title $top $title
1750 label $top.nl -text "Name" -font $uifont
1751 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1752 grid $top.nl $top.name -sticky w -pady 5
1753 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1755 grid $top.perm - -pady 5 -sticky w
1756 message $top.al -aspect 1000 -font $uifont \
1757 -text "Commits to include (arguments to git rev-list):"
1758 grid $top.al - -sticky w -pady 5
1759 entry $top.args -width 50 -textvariable newviewargs($n) \
1760 -background white -font $uifont
1761 grid $top.args - -sticky ew -padx 5
1762 message $top.l -aspect 1000 -font $uifont \
1763 -text "Enter files and directories to include, one per line:"
1764 grid $top.l - -sticky w
1765 text $top.t -width 40 -height 10 -background white -font $uifont
1766 if {[info exists viewfiles($n)]} {
1767 foreach f $viewfiles($n) {
1768 $top.t insert end $f
1769 $top.t insert end "\n"
1771 $top.t delete {end - 1c} end
1772 $top.t mark set insert 0.0
1774 grid $top.t - -sticky ew -padx 5
1776 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1778 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1780 grid $top.buts.ok $top.buts.can
1781 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1782 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1783 grid $top.buts - -pady 10 -sticky ew
1787 proc doviewmenu {m first cmd op argv} {
1788 set nmenu [$m index end]
1789 for {set i $first} {$i <= $nmenu} {incr i} {
1790 if {[$m entrycget $i -command] eq $cmd} {
1791 eval $m $op $i $argv
1797 proc allviewmenus {n op args} {
1800 doviewmenu .bar.view 5 [list showview $n] $op $args
1801 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1804 proc newviewok {top n} {
1805 global nextviewnum newviewperm newviewname newishighlight
1806 global viewname viewfiles viewperm selectedview curview
1807 global viewargs newviewargs viewhlmenu
1810 set newargs [shellsplit $newviewargs($n)]
1812 error_popup "Error in commit selection arguments: $err"
1818 foreach f [split [$top.t get 0.0 end] "\n"] {
1819 set ft [string trim $f]
1824 if {![info exists viewfiles($n)]} {
1825 # creating a new view
1827 set viewname($n) $newviewname($n)
1828 set viewperm($n) $newviewperm($n)
1829 set viewfiles($n) $files
1830 set viewargs($n) $newargs
1832 if {!$newishighlight} {
1835 run addvhighlight $n
1838 # editing an existing view
1839 set viewperm($n) $newviewperm($n)
1840 if {$newviewname($n) ne $viewname($n)} {
1841 set viewname($n) $newviewname($n)
1842 doviewmenu .bar.view 5 [list showview $n] \
1843 entryconf [list -label $viewname($n)]
1844 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1845 entryconf [list -label $viewname($n) -value $viewname($n)]
1847 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1848 set viewfiles($n) $files
1849 set viewargs($n) $newargs
1850 if {$curview == $n} {
1855 catch {destroy $top}
1859 global curview viewdata viewperm hlview selectedhlview
1861 if {$curview == 0} return
1862 if {[info exists hlview] && $hlview == $curview} {
1863 set selectedhlview None
1866 allviewmenus $curview delete
1867 set viewdata($curview) {}
1868 set viewperm($curview) 0
1872 proc addviewmenu {n} {
1873 global viewname viewhlmenu
1875 .bar.view add radiobutton -label $viewname($n) \
1876 -command [list showview $n] -variable selectedview -value $n
1877 $viewhlmenu add radiobutton -label $viewname($n) \
1878 -command [list addvhighlight $n] -variable selectedhlview
1881 proc flatten {var} {
1885 foreach i [array names $var] {
1886 lappend ret $i [set $var\($i\)]
1891 proc unflatten {var l} {
1901 global curview viewdata viewfiles
1902 global displayorder parentlist rowidlist rowoffsets
1903 global colormap rowtextx commitrow nextcolor canvxmax
1904 global numcommits rowrangelist commitlisted idrowranges rowchk
1905 global selectedline currentid canv canvy0
1907 global pending_select phase
1908 global commitidx rowlaidout rowoptim
1910 global selectedview selectfirst
1911 global vparentlist vdisporder vcmitlisted
1912 global hlview selectedhlview
1914 if {$n == $curview} return
1916 if {[info exists selectedline]} {
1917 set selid $currentid
1918 set y [yc $selectedline]
1919 set ymax [lindex [$canv cget -scrollregion] 3]
1920 set span [$canv yview]
1921 set ytop [expr {[lindex $span 0] * $ymax}]
1922 set ybot [expr {[lindex $span 1] * $ymax}]
1923 if {$ytop < $y && $y < $ybot} {
1924 set yscreen [expr {$y - $ytop}]
1926 set yscreen [expr {($ybot - $ytop) / 2}]
1928 } elseif {[info exists pending_select]} {
1929 set selid $pending_select
1930 unset pending_select
1934 if {$curview >= 0} {
1935 set vparentlist($curview) $parentlist
1936 set vdisporder($curview) $displayorder
1937 set vcmitlisted($curview) $commitlisted
1939 set viewdata($curview) \
1940 [list $phase $rowidlist $rowoffsets $rowrangelist \
1941 [flatten idrowranges] [flatten idinlist] \
1942 $rowlaidout $rowoptim $numcommits]
1943 } elseif {![info exists viewdata($curview)]
1944 || [lindex $viewdata($curview) 0] ne {}} {
1945 set viewdata($curview) \
1946 [list {} $rowidlist $rowoffsets $rowrangelist]
1949 catch {unset treediffs}
1951 if {[info exists hlview] && $hlview == $n} {
1953 set selectedhlview None
1958 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1959 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1961 if {![info exists viewdata($n)]} {
1963 set pending_select $selid
1970 set phase [lindex $v 0]
1971 set displayorder $vdisporder($n)
1972 set parentlist $vparentlist($n)
1973 set commitlisted $vcmitlisted($n)
1974 set rowidlist [lindex $v 1]
1975 set rowoffsets [lindex $v 2]
1976 set rowrangelist [lindex $v 3]
1978 set numcommits [llength $displayorder]
1979 catch {unset idrowranges}
1981 unflatten idrowranges [lindex $v 4]
1982 unflatten idinlist [lindex $v 5]
1983 set rowlaidout [lindex $v 6]
1984 set rowoptim [lindex $v 7]
1985 set numcommits [lindex $v 8]
1986 catch {unset rowchk}
1989 catch {unset colormap}
1990 catch {unset rowtextx}
1992 set canvxmax [$canv cget -width]
1999 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2000 set row $commitrow($n,$selid)
2001 # try to get the selected row in the same position on the screen
2002 set ymax [lindex [$canv cget -scrollregion] 3]
2003 set ytop [expr {[yc $row] - $yscreen}]
2007 set yf [expr {$ytop * 1.0 / $ymax}]
2009 allcanvs yview moveto $yf
2013 } elseif {$selid ne {}} {
2014 set pending_select $selid
2016 set row [first_real_row]
2017 if {$row < $numcommits} {
2024 if {$phase eq "getcommits"} {
2025 show_status "Reading commits..."
2028 } elseif {$numcommits == 0} {
2029 show_status "No commits selected"
2034 # Stuff relating to the highlighting facility
2036 proc ishighlighted {row} {
2037 global vhighlights fhighlights nhighlights rhighlights
2039 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2040 return $nhighlights($row)
2042 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2043 return $vhighlights($row)
2045 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2046 return $fhighlights($row)
2048 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2049 return $rhighlights($row)
2054 proc bolden {row font} {
2055 global canv linehtag selectedline boldrows
2057 lappend boldrows $row
2058 $canv itemconf $linehtag($row) -font $font
2059 if {[info exists selectedline] && $row == $selectedline} {
2061 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2062 -outline {{}} -tags secsel \
2063 -fill [$canv cget -selectbackground]]
2068 proc bolden_name {row font} {
2069 global canv2 linentag selectedline boldnamerows
2071 lappend boldnamerows $row
2072 $canv2 itemconf $linentag($row) -font $font
2073 if {[info exists selectedline] && $row == $selectedline} {
2074 $canv2 delete secsel
2075 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2076 -outline {{}} -tags secsel \
2077 -fill [$canv2 cget -selectbackground]]
2083 global mainfont boldrows
2086 foreach row $boldrows {
2087 if {![ishighlighted $row]} {
2088 bolden $row $mainfont
2090 lappend stillbold $row
2093 set boldrows $stillbold
2096 proc addvhighlight {n} {
2097 global hlview curview viewdata vhl_done vhighlights commitidx
2099 if {[info exists hlview]} {
2103 if {$n != $curview && ![info exists viewdata($n)]} {
2104 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
2105 set vparentlist($n) {}
2106 set vdisporder($n) {}
2107 set vcmitlisted($n) {}
2110 set vhl_done $commitidx($hlview)
2111 if {$vhl_done > 0} {
2116 proc delvhighlight {} {
2117 global hlview vhighlights
2119 if {![info exists hlview]} return
2121 catch {unset vhighlights}
2125 proc vhighlightmore {} {
2126 global hlview vhl_done commitidx vhighlights
2127 global displayorder vdisporder curview mainfont
2129 set font [concat $mainfont bold]
2130 set max $commitidx($hlview)
2131 if {$hlview == $curview} {
2132 set disp $displayorder
2134 set disp $vdisporder($hlview)
2136 set vr [visiblerows]
2137 set r0 [lindex $vr 0]
2138 set r1 [lindex $vr 1]
2139 for {set i $vhl_done} {$i < $max} {incr i} {
2140 set id [lindex $disp $i]
2141 if {[info exists commitrow($curview,$id)]} {
2142 set row $commitrow($curview,$id)
2143 if {$r0 <= $row && $row <= $r1} {
2144 if {![highlighted $row]} {
2147 set vhighlights($row) 1
2154 proc askvhighlight {row id} {
2155 global hlview vhighlights commitrow iddrawn mainfont
2157 if {[info exists commitrow($hlview,$id)]} {
2158 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2159 bolden $row [concat $mainfont bold]
2161 set vhighlights($row) 1
2163 set vhighlights($row) 0
2167 proc hfiles_change {name ix op} {
2168 global highlight_files filehighlight fhighlights fh_serial
2169 global mainfont highlight_paths
2171 if {[info exists filehighlight]} {
2172 # delete previous highlights
2173 catch {close $filehighlight}
2175 catch {unset fhighlights}
2177 unhighlight_filelist
2179 set highlight_paths {}
2180 after cancel do_file_hl $fh_serial
2182 if {$highlight_files ne {}} {
2183 after 300 do_file_hl $fh_serial
2187 proc makepatterns {l} {
2190 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2191 if {[string index $ee end] eq "/"} {
2201 proc do_file_hl {serial} {
2202 global highlight_files filehighlight highlight_paths gdttype fhl_list
2204 if {$gdttype eq "touching paths:"} {
2205 if {[catch {set paths [shellsplit $highlight_files]}]} return
2206 set highlight_paths [makepatterns $paths]
2208 set gdtargs [concat -- $paths]
2210 set gdtargs [list "-S$highlight_files"]
2212 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2213 set filehighlight [open $cmd r+]
2214 fconfigure $filehighlight -blocking 0
2215 filerun $filehighlight readfhighlight
2221 proc flushhighlights {} {
2222 global filehighlight fhl_list
2224 if {[info exists filehighlight]} {
2226 puts $filehighlight ""
2227 flush $filehighlight
2231 proc askfilehighlight {row id} {
2232 global filehighlight fhighlights fhl_list
2234 lappend fhl_list $id
2235 set fhighlights($row) -1
2236 puts $filehighlight $id
2239 proc readfhighlight {} {
2240 global filehighlight fhighlights commitrow curview mainfont iddrawn
2243 if {![info exists filehighlight]} {
2247 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2248 set line [string trim $line]
2249 set i [lsearch -exact $fhl_list $line]
2250 if {$i < 0} continue
2251 for {set j 0} {$j < $i} {incr j} {
2252 set id [lindex $fhl_list $j]
2253 if {[info exists commitrow($curview,$id)]} {
2254 set fhighlights($commitrow($curview,$id)) 0
2257 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2258 if {$line eq {}} continue
2259 if {![info exists commitrow($curview,$line)]} continue
2260 set row $commitrow($curview,$line)
2261 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2262 bolden $row [concat $mainfont bold]
2264 set fhighlights($row) 1
2266 if {[eof $filehighlight]} {
2268 puts "oops, git diff-tree died"
2269 catch {close $filehighlight}
2277 proc find_change {name ix op} {
2278 global nhighlights mainfont boldnamerows
2279 global findstring findpattern findtype
2281 # delete previous highlights, if any
2282 foreach row $boldnamerows {
2283 bolden_name $row $mainfont
2286 catch {unset nhighlights}
2289 if {$findtype ne "Regexp"} {
2290 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2292 set findpattern "*$e*"
2297 proc doesmatch {f} {
2298 global findtype findstring findpattern
2300 if {$findtype eq "Regexp"} {
2301 return [regexp $findstring $f]
2302 } elseif {$findtype eq "IgnCase"} {
2303 return [string match -nocase $findpattern $f]
2305 return [string match $findpattern $f]
2309 proc askfindhighlight {row id} {
2310 global nhighlights commitinfo iddrawn mainfont
2312 global markingmatches
2314 if {![info exists commitinfo($id)]} {
2317 set info $commitinfo($id)
2319 set fldtypes {Headline Author Date Committer CDate Comments}
2320 foreach f $info ty $fldtypes {
2321 if {($findloc eq "All fields" || $findloc eq $ty) &&
2323 if {$ty eq "Author"} {
2330 if {$isbold && [info exists iddrawn($id)]} {
2331 set f [concat $mainfont bold]
2332 if {![ishighlighted $row]} {
2338 if {$markingmatches} {
2339 markrowmatches $row $id
2342 set nhighlights($row) $isbold
2345 proc markrowmatches {row id} {
2346 global canv canv2 linehtag linentag commitinfo findloc
2348 set headline [lindex $commitinfo($id) 0]
2349 set author [lindex $commitinfo($id) 1]
2350 $canv delete match$row
2351 $canv2 delete match$row
2352 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2353 set m [findmatches $headline]
2355 markmatches $canv $row $headline $linehtag($row) $m \
2356 [$canv itemcget $linehtag($row) -font] $row
2359 if {$findloc eq "All fields" || $findloc eq "Author"} {
2360 set m [findmatches $author]
2362 markmatches $canv2 $row $author $linentag($row) $m \
2363 [$canv2 itemcget $linentag($row) -font] $row
2368 proc vrel_change {name ix op} {
2369 global highlight_related
2372 if {$highlight_related ne "None"} {
2377 # prepare for testing whether commits are descendents or ancestors of a
2378 proc rhighlight_sel {a} {
2379 global descendent desc_todo ancestor anc_todo
2380 global highlight_related rhighlights
2382 catch {unset descendent}
2383 set desc_todo [list $a]
2384 catch {unset ancestor}
2385 set anc_todo [list $a]
2386 if {$highlight_related ne "None"} {
2392 proc rhighlight_none {} {
2395 catch {unset rhighlights}
2399 proc is_descendent {a} {
2400 global curview children commitrow descendent desc_todo
2403 set la $commitrow($v,$a)
2407 for {set i 0} {$i < [llength $todo]} {incr i} {
2408 set do [lindex $todo $i]
2409 if {$commitrow($v,$do) < $la} {
2410 lappend leftover $do
2413 foreach nk $children($v,$do) {
2414 if {![info exists descendent($nk)]} {
2415 set descendent($nk) 1
2423 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2427 set descendent($a) 0
2428 set desc_todo $leftover
2431 proc is_ancestor {a} {
2432 global curview parentlist commitrow ancestor anc_todo
2435 set la $commitrow($v,$a)
2439 for {set i 0} {$i < [llength $todo]} {incr i} {
2440 set do [lindex $todo $i]
2441 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2442 lappend leftover $do
2445 foreach np [lindex $parentlist $commitrow($v,$do)] {
2446 if {![info exists ancestor($np)]} {
2455 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2460 set anc_todo $leftover
2463 proc askrelhighlight {row id} {
2464 global descendent highlight_related iddrawn mainfont rhighlights
2465 global selectedline ancestor
2467 if {![info exists selectedline]} return
2469 if {$highlight_related eq "Descendent" ||
2470 $highlight_related eq "Not descendent"} {
2471 if {![info exists descendent($id)]} {
2474 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2477 } elseif {$highlight_related eq "Ancestor" ||
2478 $highlight_related eq "Not ancestor"} {
2479 if {![info exists ancestor($id)]} {
2482 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2486 if {[info exists iddrawn($id)]} {
2487 if {$isbold && ![ishighlighted $row]} {
2488 bolden $row [concat $mainfont bold]
2491 set rhighlights($row) $isbold
2494 proc next_hlcont {} {
2495 global fhl_row fhl_dirn displayorder numcommits
2496 global vhighlights fhighlights nhighlights rhighlights
2497 global hlview filehighlight findstring highlight_related
2499 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2502 if {$row < 0 || $row >= $numcommits} {
2507 set id [lindex $displayorder $row]
2508 if {[info exists hlview]} {
2509 if {![info exists vhighlights($row)]} {
2510 askvhighlight $row $id
2512 if {$vhighlights($row) > 0} break
2514 if {$findstring ne {}} {
2515 if {![info exists nhighlights($row)]} {
2516 askfindhighlight $row $id
2518 if {$nhighlights($row) > 0} break
2520 if {$highlight_related ne "None"} {
2521 if {![info exists rhighlights($row)]} {
2522 askrelhighlight $row $id
2524 if {$rhighlights($row) > 0} break
2526 if {[info exists filehighlight]} {
2527 if {![info exists fhighlights($row)]} {
2528 # ask for a few more while we're at it...
2530 for {set n 0} {$n < 100} {incr n} {
2531 if {![info exists fhighlights($r)]} {
2532 askfilehighlight $r [lindex $displayorder $r]
2535 if {$r < 0 || $r >= $numcommits} break
2539 if {$fhighlights($row) < 0} {
2543 if {$fhighlights($row) > 0} break
2551 proc next_highlight {dirn} {
2552 global selectedline fhl_row fhl_dirn
2553 global hlview filehighlight findstring highlight_related
2555 if {![info exists selectedline]} return
2556 if {!([info exists hlview] || $findstring ne {} ||
2557 $highlight_related ne "None" || [info exists filehighlight])} return
2558 set fhl_row [expr {$selectedline + $dirn}]
2563 proc cancel_next_highlight {} {
2569 # Graph layout functions
2571 proc shortids {ids} {
2574 if {[llength $id] > 1} {
2575 lappend res [shortids $id]
2576 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2577 lappend res [string range $id 0 7]
2585 proc incrange {l x o} {
2588 set e [lindex $l $x]
2590 lset l $x [expr {$e + $o}]
2599 for {} {$n > 0} {incr n -1} {
2605 proc usedinrange {id l1 l2} {
2606 global children commitrow curview
2608 if {[info exists commitrow($curview,$id)]} {
2609 set r $commitrow($curview,$id)
2610 if {$l1 <= $r && $r <= $l2} {
2611 return [expr {$r - $l1 + 1}]
2614 set kids $children($curview,$id)
2616 set r $commitrow($curview,$c)
2617 if {$l1 <= $r && $r <= $l2} {
2618 return [expr {$r - $l1 + 1}]
2624 proc sanity {row {full 0}} {
2625 global rowidlist rowoffsets
2628 set ids [lindex $rowidlist $row]
2631 if {$id eq {}} continue
2632 if {$col < [llength $ids] - 1 &&
2633 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2634 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2636 set o [lindex $rowoffsets $row $col]
2642 if {[lindex $rowidlist $y $x] != $id} {
2643 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2644 puts " id=[shortids $id] check started at row $row"
2645 for {set i $row} {$i >= $y} {incr i -1} {
2646 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2651 set o [lindex $rowoffsets $y $x]
2656 proc makeuparrow {oid x y z} {
2657 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2659 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2662 set off0 [lindex $rowoffsets $y]
2663 for {set x0 $x} {1} {incr x0} {
2664 if {$x0 >= [llength $off0]} {
2665 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2668 set z [lindex $off0 $x0]
2674 set z [expr {$x0 - $x}]
2675 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2676 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2678 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2679 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2680 lappend idrowranges($oid) [lindex $displayorder $y]
2683 proc initlayout {} {
2684 global rowidlist rowoffsets displayorder commitlisted
2685 global rowlaidout rowoptim
2686 global idinlist rowchk rowrangelist idrowranges
2687 global numcommits canvxmax canv
2690 global colormap rowtextx
2701 catch {unset idinlist}
2702 catch {unset rowchk}
2705 set canvxmax [$canv cget -width]
2706 catch {unset colormap}
2707 catch {unset rowtextx}
2708 catch {unset idrowranges}
2712 proc setcanvscroll {} {
2713 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2715 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2716 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2717 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2718 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2721 proc visiblerows {} {
2722 global canv numcommits linespc
2724 set ymax [lindex [$canv cget -scrollregion] 3]
2725 if {$ymax eq {} || $ymax == 0} return
2727 set y0 [expr {int([lindex $f 0] * $ymax)}]
2728 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2732 set y1 [expr {int([lindex $f 1] * $ymax)}]
2733 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2734 if {$r1 >= $numcommits} {
2735 set r1 [expr {$numcommits - 1}]
2737 return [list $r0 $r1]
2740 proc layoutmore {tmax allread} {
2741 global rowlaidout rowoptim commitidx numcommits optim_delay
2742 global uparrowlen curview rowidlist idinlist
2745 set showdelay $optim_delay
2746 set optdelay [expr {$uparrowlen + 1}]
2748 if {$rowoptim - $showdelay > $numcommits} {
2749 showstuff [expr {$rowoptim - $showdelay}] $showlast
2750 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2751 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2755 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2757 } elseif {$commitidx($curview) > $rowlaidout} {
2758 set nr [expr {$commitidx($curview) - $rowlaidout}]
2759 # may need to increase this threshold if uparrowlen or
2760 # mingaplen are increased...
2765 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2766 if {$rowlaidout == $row} {
2769 } elseif {$allread} {
2771 set nrows $commitidx($curview)
2772 if {[lindex $rowidlist $nrows] ne {} ||
2773 [array names idinlist] ne {}} {
2775 set rowlaidout $commitidx($curview)
2776 } elseif {$rowoptim == $nrows} {
2779 if {$numcommits == $nrows} {
2786 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2792 proc showstuff {canshow last} {
2793 global numcommits commitrow pending_select selectedline curview
2794 global lookingforhead mainheadid displayorder selectfirst
2795 global lastscrollset commitinterest
2797 if {$numcommits == 0} {
2799 set phase "incrdraw"
2802 for {set l $numcommits} {$l < $canshow} {incr l} {
2803 set id [lindex $displayorder $l]
2804 if {[info exists commitinterest($id)]} {
2805 foreach script $commitinterest($id) {
2806 eval [string map [list "%I" $id] $script]
2808 unset commitinterest($id)
2812 set prev $numcommits
2813 set numcommits $canshow
2814 set t [clock clicks -milliseconds]
2815 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2816 set lastscrollset $t
2819 set rows [visiblerows]
2820 set r1 [lindex $rows 1]
2821 if {$r1 >= $canshow} {
2822 set r1 [expr {$canshow - 1}]
2827 if {[info exists pending_select] &&
2828 [info exists commitrow($curview,$pending_select)] &&
2829 $commitrow($curview,$pending_select) < $numcommits} {
2830 selectline $commitrow($curview,$pending_select) 1
2833 if {[info exists selectedline] || [info exists pending_select]} {
2836 set l [first_real_row]
2841 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2842 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2843 set lookingforhead 0
2848 proc doshowlocalchanges {} {
2849 global lookingforhead curview mainheadid phase commitrow
2851 if {[info exists commitrow($curview,$mainheadid)] &&
2852 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2854 } elseif {$phase ne {}} {
2855 set lookingforhead 1
2859 proc dohidelocalchanges {} {
2860 global lookingforhead localfrow localirow lserial
2862 set lookingforhead 0
2863 if {$localfrow >= 0} {
2864 removerow $localfrow
2866 if {$localirow > 0} {
2870 if {$localirow >= 0} {
2871 removerow $localirow
2877 # spawn off a process to do git diff-index --cached HEAD
2878 proc dodiffindex {} {
2879 global localirow localfrow lserial
2884 set fd [open "|git diff-index --cached HEAD" r]
2885 fconfigure $fd -blocking 0
2886 filerun $fd [list readdiffindex $fd $lserial]
2889 proc readdiffindex {fd serial} {
2890 global localirow commitrow mainheadid nullid2 curview
2891 global commitinfo commitdata lserial
2894 if {[gets $fd line] < 0} {
2900 # we only need to see one line and we don't really care what it says...
2903 # now see if there are any local changes not checked in to the index
2904 if {$serial == $lserial} {
2905 set fd [open "|git diff-files" r]
2906 fconfigure $fd -blocking 0
2907 filerun $fd [list readdifffiles $fd $serial]
2910 if {$isdiff && $serial == $lserial && $localirow == -1} {
2911 # add the line for the changes in the index to the graph
2912 set localirow $commitrow($curview,$mainheadid)
2913 set hl "Local changes checked in to index but not committed"
2914 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2915 set commitdata($nullid2) "\n $hl\n"
2916 insertrow $localirow $nullid2
2921 proc readdifffiles {fd serial} {
2922 global localirow localfrow commitrow mainheadid nullid curview
2923 global commitinfo commitdata lserial
2926 if {[gets $fd line] < 0} {
2932 # we only need to see one line and we don't really care what it says...
2935 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2936 # add the line for the local diff to the graph
2937 if {$localirow >= 0} {
2938 set localfrow $localirow
2941 set localfrow $commitrow($curview,$mainheadid)
2943 set hl "Local uncommitted changes, not checked in to index"
2944 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2945 set commitdata($nullid) "\n $hl\n"
2946 insertrow $localfrow $nullid
2951 proc layoutrows {row endrow last} {
2952 global rowidlist rowoffsets displayorder
2953 global uparrowlen downarrowlen maxwidth mingaplen
2954 global children parentlist
2956 global commitidx curview
2957 global idinlist rowchk rowrangelist
2959 set idlist [lindex $rowidlist $row]
2960 set offs [lindex $rowoffsets $row]
2961 while {$row < $endrow} {
2962 set id [lindex $displayorder $row]
2963 set nev [expr {[llength $idlist] - $maxwidth + 1}]
2964 foreach p [lindex $parentlist $row] {
2965 if {![info exists idinlist($p)] || !$idinlist($p)} {
2971 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2972 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2973 set i [lindex $idlist $x]
2974 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2975 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2976 [expr {$row + $uparrowlen + $mingaplen}]]
2978 set idlist [lreplace $idlist $x $x]
2979 set offs [lreplace $offs $x $x]
2980 set offs [incrange $offs $x 1]
2982 set rm1 [expr {$row - 1}]
2983 lappend idrowranges($i) [lindex $displayorder $rm1]
2984 if {[incr nev -1] <= 0} break
2987 set rowchk($i) [expr {$row + $r}]
2990 lset rowidlist $row $idlist
2991 lset rowoffsets $row $offs
2995 foreach p [lindex $parentlist $row] {
2996 if {![info exists idinlist($p)]} {
2998 } elseif {!$idinlist($p)} {
3003 set col [lsearch -exact $idlist $id]
3005 set col [llength $idlist]
3007 lset rowidlist $row $idlist
3009 if {$children($curview,$id) ne {}} {
3010 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
3014 lset rowoffsets $row $offs
3016 makeuparrow $id $col $row $z
3022 if {[info exists idrowranges($id)]} {
3023 set ranges $idrowranges($id)
3025 unset idrowranges($id)
3027 lappend rowrangelist $ranges
3029 set offs [ntimes [llength $idlist] 0]
3030 set l [llength $newolds]
3031 set idlist [eval lreplace \$idlist $col $col $newolds]
3034 set offs [lrange $offs 0 [expr {$col - 1}]]
3035 foreach x $newolds {
3040 set tmp [expr {[llength $idlist] - [llength $offs]}]
3042 set offs [concat $offs [ntimes $tmp $o]]
3047 foreach i $newolds {
3048 set idrowranges($i) $id
3051 foreach oid $oldolds {
3052 set idlist [linsert $idlist $col $oid]
3053 set offs [linsert $offs $col $o]
3054 makeuparrow $oid $col $row $o
3057 lappend rowidlist $idlist
3058 lappend rowoffsets $offs
3063 proc addextraid {id row} {
3064 global displayorder commitrow commitinfo
3065 global commitidx commitlisted
3066 global parentlist children curview
3068 incr commitidx($curview)
3069 lappend displayorder $id
3070 lappend commitlisted 0
3071 lappend parentlist {}
3072 set commitrow($curview,$id) $row
3074 if {![info exists commitinfo($id)]} {
3075 set commitinfo($id) {"No commit information available"}
3077 if {![info exists children($curview,$id)]} {
3078 set children($curview,$id) {}
3082 proc layouttail {} {
3083 global rowidlist rowoffsets idinlist commitidx curview
3084 global idrowranges rowrangelist
3086 set row $commitidx($curview)
3087 set idlist [lindex $rowidlist $row]
3088 while {$idlist ne {}} {
3089 set col [expr {[llength $idlist] - 1}]
3090 set id [lindex $idlist $col]
3092 catch {unset idinlist($id)}
3093 lappend idrowranges($id) $id
3094 lappend rowrangelist $idrowranges($id)
3095 unset idrowranges($id)
3097 set offs [ntimes $col 0]
3098 set idlist [lreplace $idlist $col $col]
3099 lappend rowidlist $idlist
3100 lappend rowoffsets $offs
3103 foreach id [array names idinlist] {
3106 lset rowidlist $row [list $id]
3107 lset rowoffsets $row 0
3108 makeuparrow $id 0 $row 0
3109 lappend idrowranges($id) $id
3110 lappend rowrangelist $idrowranges($id)
3111 unset idrowranges($id)
3113 lappend rowidlist {}
3114 lappend rowoffsets {}
3118 proc insert_pad {row col npad} {
3119 global rowidlist rowoffsets
3121 set pad [ntimes $npad {}]
3122 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
3123 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
3124 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
3127 proc optimize_rows {row col endrow} {
3128 global rowidlist rowoffsets displayorder
3130 for {} {$row < $endrow} {incr row} {
3131 set idlist [lindex $rowidlist $row]
3132 set offs [lindex $rowoffsets $row]
3134 for {} {$col < [llength $offs]} {incr col} {
3135 if {[lindex $idlist $col] eq {}} {
3139 set z [lindex $offs $col]
3140 if {$z eq {}} continue
3142 set x0 [expr {$col + $z}]
3143 set y0 [expr {$row - 1}]
3144 set z0 [lindex $rowoffsets $y0 $x0]
3146 set id [lindex $idlist $col]
3147 set ranges [rowranges $id]
3148 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
3152 # Looking at lines from this row to the previous row,
3153 # make them go straight up if they end in an arrow on
3154 # the previous row; otherwise make them go straight up
3156 if {$z < -1 || ($z < 0 && $isarrow)} {
3157 # Line currently goes left too much;
3158 # insert pads in the previous row, then optimize it
3159 set npad [expr {-1 - $z + $isarrow}]
3160 set offs [incrange $offs $col $npad]
3161 insert_pad $y0 $x0 $npad
3163 optimize_rows $y0 $x0 $row
3165 set z [lindex $offs $col]
3166 set x0 [expr {$col + $z}]
3167 set z0 [lindex $rowoffsets $y0 $x0]
3168 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3169 # Line currently goes right too much;
3170 # insert pads in this line and adjust the next's rowoffsets
3171 set npad [expr {$z - 1 + $isarrow}]
3172 set y1 [expr {$row + 1}]
3173 set offs2 [lindex $rowoffsets $y1]
3177 if {$z eq {} || $x1 + $z < $col} continue
3178 if {$x1 + $z > $col} {
3181 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
3184 set pad [ntimes $npad {}]
3185 set idlist [eval linsert \$idlist $col $pad]
3186 set tmp [eval linsert \$offs $col $pad]
3188 set offs [incrange $tmp $col [expr {-$npad}]]
3189 set z [lindex $offs $col]
3192 if {$z0 eq {} && !$isarrow} {
3193 # this line links to its first child on row $row-2
3194 set rm2 [expr {$row - 2}]
3195 set id [lindex $displayorder $rm2]
3196 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
3198 set z0 [expr {$xc - $x0}]
3201 # avoid lines jigging left then immediately right
3202 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3203 insert_pad $y0 $x0 1
3204 set offs [incrange $offs $col 1]
3205 optimize_rows $y0 [expr {$x0 + 1}] $row
3210 # Find the first column that doesn't have a line going right
3211 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3212 set o [lindex $offs $col]
3214 # check if this is the link to the first child
3215 set id [lindex $idlist $col]
3216 set ranges [rowranges $id]
3217 if {$ranges ne {} && $row == [lindex $ranges 0]} {
3218 # it is, work out offset to child
3219 set y0 [expr {$row - 1}]
3220 set id [lindex $displayorder $y0]
3221 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3223 set o [expr {$x0 - $col}]
3227 if {$o eq {} || $o <= 0} break
3229 # Insert a pad at that column as long as it has a line and
3230 # isn't the last column, and adjust the next row' offsets
3231 if {$o ne {} && [incr col] < [llength $idlist]} {
3232 set y1 [expr {$row + 1}]
3233 set offs2 [lindex $rowoffsets $y1]
3237 if {$z eq {} || $x1 + $z < $col} continue
3238 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3241 set idlist [linsert $idlist $col {}]
3242 set tmp [linsert $offs $col {}]
3244 set offs [incrange $tmp $col -1]
3247 lset rowidlist $row $idlist
3248 lset rowoffsets $row $offs
3254 global canvx0 linespc
3255 return [expr {$canvx0 + $col * $linespc}]
3259 global canvy0 linespc
3260 return [expr {$canvy0 + $row * $linespc}]
3263 proc linewidth {id} {
3264 global thickerline lthickness
3267 if {[info exists thickerline] && $id eq $thickerline} {
3268 set wid [expr {2 * $lthickness}]
3273 proc rowranges {id} {
3274 global phase idrowranges commitrow rowlaidout rowrangelist curview
3278 ([info exists commitrow($curview,$id)]
3279 && $commitrow($curview,$id) < $rowlaidout)} {
3280 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3281 } elseif {[info exists idrowranges($id)]} {
3282 set ranges $idrowranges($id)
3285 foreach rid $ranges {
3286 lappend linenos $commitrow($curview,$rid)
3288 if {$linenos ne {}} {
3289 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3294 # work around tk8.4 refusal to draw arrows on diagonal segments
3295 proc adjarrowhigh {coords} {
3298 set x0 [lindex $coords 0]
3299 set x1 [lindex $coords 2]
3301 set y0 [lindex $coords 1]
3302 set y1 [lindex $coords 3]
3303 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3304 # we have a nearby vertical segment, just trim off the diag bit
3305 set coords [lrange $coords 2 end]
3307 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3308 set xi [expr {$x0 - $slope * $linespc / 2}]
3309 set yi [expr {$y0 - $linespc / 2}]
3310 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3316 proc drawlineseg {id row endrow arrowlow} {
3317 global rowidlist displayorder iddrawn linesegs
3318 global canv colormap linespc curview maxlinelen
3320 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3321 set le [expr {$row + 1}]
3324 set c [lsearch -exact [lindex $rowidlist $le] $id]
3330 set x [lindex $displayorder $le]
3335 if {[info exists iddrawn($x)] || $le == $endrow} {
3336 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3352 if {[info exists linesegs($id)]} {
3353 set lines $linesegs($id)
3355 set r0 [lindex $li 0]
3357 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3367 set li [lindex $lines [expr {$i-1}]]
3368 set r1 [lindex $li 1]
3369 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3374 set x [lindex $cols [expr {$le - $row}]]
3375 set xp [lindex $cols [expr {$le - 1 - $row}]]
3376 set dir [expr {$xp - $x}]
3378 set ith [lindex $lines $i 2]
3379 set coords [$canv coords $ith]
3380 set ah [$canv itemcget $ith -arrow]
3381 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3382 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3383 if {$x2 ne {} && $x - $x2 == $dir} {
3384 set coords [lrange $coords 0 end-2]
3387 set coords [list [xc $le $x] [yc $le]]
3390 set itl [lindex $lines [expr {$i-1}] 2]
3391 set al [$canv itemcget $itl -arrow]
3392 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3393 } elseif {$arrowlow &&
3394 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3397 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3398 for {set y $le} {[incr y -1] > $row} {} {
3400 set xp [lindex $cols [expr {$y - 1 - $row}]]
3401 set ndir [expr {$xp - $x}]
3402 if {$dir != $ndir || $xp < 0} {
3403 lappend coords [xc $y $x] [yc $y]
3409 # join parent line to first child
3410 set ch [lindex $displayorder $row]
3411 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3413 puts "oops: drawlineseg: child $ch not on row $row"
3416 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3417 } elseif {$xc > $x + 1} {
3418 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3422 lappend coords [xc $row $x] [yc $row]
3424 set xn [xc $row $xp]
3426 # work around tk8.4 refusal to draw arrows on diagonal segments
3427 if {$arrowlow && $xn != [lindex $coords end-1]} {
3428 if {[llength $coords] < 4 ||
3429 [lindex $coords end-3] != [lindex $coords end-1] ||
3430 [lindex $coords end] - $yn > 2 * $linespc} {
3431 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3432 set yo [yc [expr {$row + 0.5}]]
3433 lappend coords $xn $yo $xn $yn
3436 lappend coords $xn $yn
3441 set coords [adjarrowhigh $coords]
3444 set t [$canv create line $coords -width [linewidth $id] \
3445 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3448 set lines [linsert $lines $i [list $row $le $t]]
3450 $canv coords $ith $coords
3451 if {$arrow ne $ah} {
3452 $canv itemconf $ith -arrow $arrow
3454 lset lines $i 0 $row
3457 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3458 set ndir [expr {$xo - $xp}]
3459 set clow [$canv coords $itl]
3460 if {$dir == $ndir} {
3461 set clow [lrange $clow 2 end]
3463 set coords [concat $coords $clow]
3465 lset lines [expr {$i-1}] 1 $le
3467 set coords [adjarrowhigh $coords]
3470 # coalesce two pieces
3472 set b [lindex $lines [expr {$i-1}] 0]
3473 set e [lindex $lines $i 1]
3474 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3476 $canv coords $itl $coords
3477 if {$arrow ne $al} {
3478 $canv itemconf $itl -arrow $arrow
3482 set linesegs($id) $lines
3486 proc drawparentlinks {id row} {
3487 global rowidlist canv colormap curview parentlist
3490 set rowids [lindex $rowidlist $row]
3491 set col [lsearch -exact $rowids $id]
3492 if {$col < 0} return
3493 set olds [lindex $parentlist $row]
3494 set row2 [expr {$row + 1}]
3495 set x [xc $row $col]
3498 set ids [lindex $rowidlist $row2]
3499 # rmx = right-most X coord used
3502 set i [lsearch -exact $ids $p]
3504 puts "oops, parent $p of $id not in list"
3507 set x2 [xc $row2 $i]
3511 if {[lsearch -exact $rowids $p] < 0} {
3512 # drawlineseg will do this one for us
3516 # should handle duplicated parents here...
3517 set coords [list $x $y]
3518 if {$i < $col - 1} {
3519 lappend coords [xc $row [expr {$i + 1}]] $y
3520 } elseif {$i > $col + 1} {
3521 lappend coords [xc $row [expr {$i - 1}]] $y
3523 lappend coords $x2 $y2
3524 set t [$canv create line $coords -width [linewidth $p] \
3525 -fill $colormap($p) -tags lines.$p]
3529 if {$rmx > [lindex $idpos($id) 1]} {
3530 lset idpos($id) 1 $rmx
3535 proc drawlines {id} {
3538 $canv itemconf lines.$id -width [linewidth $id]
3541 proc drawcmittext {id row col} {
3542 global linespc canv canv2 canv3 canvy0 fgcolor curview
3543 global commitlisted commitinfo rowidlist parentlist
3544 global rowtextx idpos idtags idheads idotherrefs
3545 global linehtag linentag linedtag
3546 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3548 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3549 set listed [lindex $commitlisted $row]
3550 if {$id eq $nullid} {
3552 } elseif {$id eq $nullid2} {
3555 set ofill [expr {$listed != 0? "blue": "white"}]
3557 set x [xc $row $col]
3559 set orad [expr {$linespc / 3}]
3561 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3562 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3563 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3564 } elseif {$listed == 2} {
3565 # triangle pointing left for left-side commits
3566 set t [$canv create polygon \
3567 [expr {$x - $orad}] $y \
3568 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3569 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3570 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3572 # triangle pointing right for right-side commits
3573 set t [$canv create polygon \
3574 [expr {$x + $orad - 1}] $y \
3575 [expr {$x - $orad}] [expr {$y - $orad}] \
3576 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3577 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3580 $canv bind $t <1> {selcanvline {} %x %y}
3581 set rmx [llength [lindex $rowidlist $row]]
3582 set olds [lindex $parentlist $row]
3584 set nextids [lindex $rowidlist [expr {$row + 1}]]
3586 set i [lsearch -exact $nextids $p]
3592 set xt [xc $row $rmx]
3593 set rowtextx($row) $xt
3594 set idpos($id) [list $x $xt $y]
3595 if {[info exists idtags($id)] || [info exists idheads($id)]
3596 || [info exists idotherrefs($id)]} {
3597 set xt [drawtags $id $x $xt $y]
3599 set headline [lindex $commitinfo($id) 0]
3600 set name [lindex $commitinfo($id) 1]
3601 set date [lindex $commitinfo($id) 2]
3602 set date [formatdate $date]
3605 set isbold [ishighlighted $row]
3607 lappend boldrows $row
3610 lappend boldnamerows $row
3614 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3615 -text $headline -font $font -tags text]
3616 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3617 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3618 -text $name -font $nfont -tags text]
3619 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3620 -text $date -font $mainfont -tags text]
3621 set xr [expr {$xt + [font measure $mainfont $headline]}]
3622 if {$xr > $canvxmax} {
3628 proc drawcmitrow {row} {
3629 global displayorder rowidlist
3630 global iddrawn markingmatches
3631 global commitinfo parentlist numcommits
3632 global filehighlight fhighlights findstring nhighlights
3633 global hlview vhighlights
3634 global highlight_related rhighlights
3636 if {$row >= $numcommits} return
3638 set id [lindex $displayorder $row]
3639 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3640 askvhighlight $row $id
3642 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3643 askfilehighlight $row $id
3645 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3646 askfindhighlight $row $id
3648 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3649 askrelhighlight $row $id
3651 if {![info exists iddrawn($id)]} {
3652 set col [lsearch -exact [lindex $rowidlist $row] $id]
3654 puts "oops, row $row id $id not in list"
3657 if {![info exists commitinfo($id)]} {
3661 drawcmittext $id $row $col
3664 if {$markingmatches} {
3665 markrowmatches $row $id
3669 proc drawcommits {row {endrow {}}} {
3670 global numcommits iddrawn displayorder curview
3671 global parentlist rowidlist
3676 if {$endrow eq {}} {
3679 if {$endrow >= $numcommits} {
3680 set endrow [expr {$numcommits - 1}]
3683 # make the lines join to already-drawn rows either side
3684 set r [expr {$row - 1}]
3685 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3688 set er [expr {$endrow + 1}]
3689 if {$er >= $numcommits ||
3690 ![info exists iddrawn([lindex $displayorder $er])]} {
3693 for {} {$r <= $er} {incr r} {
3694 set id [lindex $displayorder $r]
3695 set wasdrawn [info exists iddrawn($id)]
3697 if {$r == $er} break
3698 set nextid [lindex $displayorder [expr {$r + 1}]]
3699 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3700 drawparentlinks $id $r
3702 set rowids [lindex $rowidlist $r]
3703 foreach lid $rowids {
3704 if {$lid eq {}} continue
3705 if {[info exists lineend($lid)] && $lineend($lid) > $r} 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 lineend($p) [drawlineseg $p $r $er 0]
3715 set lineend($lid) [drawlineseg $lid $r $er 1]
3721 proc drawfrac {f0 f1} {
3724 set ymax [lindex [$canv cget -scrollregion] 3]
3725 if {$ymax eq {} || $ymax == 0} return
3726 set y0 [expr {int($f0 * $ymax)}]
3727 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3728 set y1 [expr {int($f1 * $ymax)}]
3729 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3730 drawcommits $row $endrow
3733 proc drawvisible {} {
3735 eval drawfrac [$canv yview]
3738 proc clear_display {} {
3739 global iddrawn linesegs
3740 global vhighlights fhighlights nhighlights rhighlights
3743 catch {unset iddrawn}
3744 catch {unset linesegs}
3745 catch {unset vhighlights}
3746 catch {unset fhighlights}
3747 catch {unset nhighlights}
3748 catch {unset rhighlights}
3751 proc findcrossings {id} {
3752 global rowidlist parentlist numcommits rowoffsets displayorder
3756 foreach {s e} [rowranges $id] {
3757 if {$e >= $numcommits} {
3758 set e [expr {$numcommits - 1}]
3760 if {$e <= $s} continue
3761 set x [lsearch -exact [lindex $rowidlist $e] $id]
3763 puts "findcrossings: oops, no [shortids $id] in row $e"
3766 for {set row $e} {[incr row -1] >= $s} {} {
3767 set olds [lindex $parentlist $row]
3768 set kid [lindex $displayorder $row]
3769 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3770 if {$kidx < 0} continue
3771 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3773 set px [lsearch -exact $nextrow $p]
3774 if {$px < 0} continue
3775 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3776 if {[lsearch -exact $ccross $p] >= 0} continue
3777 if {$x == $px + ($kidx < $px? -1: 1)} {
3779 } elseif {[lsearch -exact $cross $p] < 0} {
3784 set inc [lindex $rowoffsets $row $x]
3785 if {$inc eq {}} break
3789 return [concat $ccross {{}} $cross]
3792 proc assigncolor {id} {
3793 global colormap colors nextcolor
3794 global commitrow parentlist children children curview
3796 if {[info exists colormap($id)]} return
3797 set ncolors [llength $colors]
3798 if {[info exists children($curview,$id)]} {
3799 set kids $children($curview,$id)
3803 if {[llength $kids] == 1} {
3804 set child [lindex $kids 0]
3805 if {[info exists colormap($child)]
3806 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3807 set colormap($id) $colormap($child)
3813 foreach x [findcrossings $id] {
3815 # delimiter between corner crossings and other crossings
3816 if {[llength $badcolors] >= $ncolors - 1} break
3817 set origbad $badcolors
3819 if {[info exists colormap($x)]
3820 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3821 lappend badcolors $colormap($x)
3824 if {[llength $badcolors] >= $ncolors} {
3825 set badcolors $origbad
3827 set origbad $badcolors
3828 if {[llength $badcolors] < $ncolors - 1} {
3829 foreach child $kids {
3830 if {[info exists colormap($child)]
3831 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3832 lappend badcolors $colormap($child)
3834 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3835 if {[info exists colormap($p)]
3836 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3837 lappend badcolors $colormap($p)
3841 if {[llength $badcolors] >= $ncolors} {
3842 set badcolors $origbad
3845 for {set i 0} {$i <= $ncolors} {incr i} {
3846 set c [lindex $colors $nextcolor]
3847 if {[incr nextcolor] >= $ncolors} {
3850 if {[lsearch -exact $badcolors $c]} break
3852 set colormap($id) $c
3855 proc bindline {t id} {
3858 $canv bind $t <Enter> "lineenter %x %y $id"
3859 $canv bind $t <Motion> "linemotion %x %y $id"
3860 $canv bind $t <Leave> "lineleave $id"
3861 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3864 proc drawtags {id x xt y1} {
3865 global idtags idheads idotherrefs mainhead
3866 global linespc lthickness
3867 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3872 if {[info exists idtags($id)]} {
3873 set marks $idtags($id)
3874 set ntags [llength $marks]
3876 if {[info exists idheads($id)]} {
3877 set marks [concat $marks $idheads($id)]
3878 set nheads [llength $idheads($id)]
3880 if {[info exists idotherrefs($id)]} {
3881 set marks [concat $marks $idotherrefs($id)]
3887 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3888 set yt [expr {$y1 - 0.5 * $linespc}]
3889 set yb [expr {$yt + $linespc - 1}]
3893 foreach tag $marks {
3895 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3896 set wid [font measure [concat $mainfont bold] $tag]
3898 set wid [font measure $mainfont $tag]
3902 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3904 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3905 -width $lthickness -fill black -tags tag.$id]
3907 foreach tag $marks x $xvals wid $wvals {
3908 set xl [expr {$x + $delta}]
3909 set xr [expr {$x + $delta + $wid + $lthickness}]
3911 if {[incr ntags -1] >= 0} {
3913 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3914 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3915 -width 1 -outline black -fill yellow -tags tag.$id]
3916 $canv bind $t <1> [list showtag $tag 1]
3917 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3919 # draw a head or other ref
3920 if {[incr nheads -1] >= 0} {
3922 if {$tag eq $mainhead} {
3928 set xl [expr {$xl - $delta/2}]
3929 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3930 -width 1 -outline black -fill $col -tags tag.$id
3931 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3932 set rwid [font measure $mainfont $remoteprefix]
3933 set xi [expr {$x + 1}]
3934 set yti [expr {$yt + 1}]
3935 set xri [expr {$x + $rwid}]
3936 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3937 -width 0 -fill "#ffddaa" -tags tag.$id
3940 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3941 -font $font -tags [list tag.$id text]]
3943 $canv bind $t <1> [list showtag $tag 1]
3944 } elseif {$nheads >= 0} {
3945 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3951 proc xcoord {i level ln} {
3952 global canvx0 xspc1 xspc2
3954 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3955 if {$i > 0 && $i == $level} {
3956 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3957 } elseif {$i > $level} {
3958 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3963 proc show_status {msg} {
3964 global canv mainfont fgcolor
3967 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3968 -tags text -fill $fgcolor
3971 # Insert a new commit as the child of the commit on row $row.
3972 # The new commit will be displayed on row $row and the commits
3973 # on that row and below will move down one row.
3974 proc insertrow {row newcmit} {
3975 global displayorder parentlist commitlisted children
3976 global commitrow curview rowidlist rowoffsets numcommits
3977 global rowrangelist rowlaidout rowoptim numcommits
3978 global selectedline rowchk commitidx
3980 if {$row >= $numcommits} {
3981 puts "oops, inserting new row $row but only have $numcommits rows"
3984 set p [lindex $displayorder $row]
3985 set displayorder [linsert $displayorder $row $newcmit]
3986 set parentlist [linsert $parentlist $row $p]
3987 set kids $children($curview,$p)
3988 lappend kids $newcmit
3989 set children($curview,$p) $kids
3990 set children($curview,$newcmit) {}
3991 set commitlisted [linsert $commitlisted $row 1]
3992 set l [llength $displayorder]
3993 for {set r $row} {$r < $l} {incr r} {
3994 set id [lindex $displayorder $r]
3995 set commitrow($curview,$id) $r
3997 incr commitidx($curview)
3999 set idlist [lindex $rowidlist $row]
4000 set offs [lindex $rowoffsets $row]
4003 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
4009 if {[llength $kids] == 1} {
4010 set col [lsearch -exact $idlist $p]
4011 lset idlist $col $newcmit
4013 set col [llength $idlist]
4014 lappend idlist $newcmit
4016 lset rowoffsets $row $offs
4018 set rowidlist [linsert $rowidlist $row $idlist]
4019 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
4021 set rowrangelist [linsert $rowrangelist $row {}]
4022 if {[llength $kids] > 1} {
4023 set rp1 [expr {$row + 1}]
4024 set ranges [lindex $rowrangelist $rp1]
4025 if {$ranges eq {}} {
4026 set ranges [list $newcmit $p]
4027 } elseif {[lindex $ranges end-1] eq $p} {
4028 lset ranges end-1 $newcmit
4030 lset rowrangelist $rp1 $ranges
4033 catch {unset rowchk}
4039 if {[info exists selectedline] && $selectedline >= $row} {
4045 # Remove a commit that was inserted with insertrow on row $row.
4046 proc removerow {row} {
4047 global displayorder parentlist commitlisted children
4048 global commitrow curview rowidlist rowoffsets numcommits
4049 global rowrangelist idrowranges rowlaidout rowoptim numcommits
4050 global linesegends selectedline rowchk commitidx
4052 if {$row >= $numcommits} {
4053 puts "oops, removing row $row but only have $numcommits rows"
4056 set rp1 [expr {$row + 1}]
4057 set id [lindex $displayorder $row]
4058 set p [lindex $parentlist $row]
4059 set displayorder [lreplace $displayorder $row $row]
4060 set parentlist [lreplace $parentlist $row $row]
4061 set commitlisted [lreplace $commitlisted $row $row]
4062 set kids $children($curview,$p)
4063 set i [lsearch -exact $kids $id]
4065 set kids [lreplace $kids $i $i]
4066 set children($curview,$p) $kids
4068 set l [llength $displayorder]
4069 for {set r $row} {$r < $l} {incr r} {
4070 set id [lindex $displayorder $r]
4071 set commitrow($curview,$id) $r
4073 incr commitidx($curview) -1
4075 set rowidlist [lreplace $rowidlist $row $row]
4076 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
4078 set offs [lindex $rowoffsets $row]
4079 set offs [lreplace $offs end end]
4080 lset rowoffsets $row $offs
4083 set rowrangelist [lreplace $rowrangelist $row $row]
4084 if {[llength $kids] > 0} {
4085 set ranges [lindex $rowrangelist $row]
4086 if {[lindex $ranges end-1] eq $id} {
4087 set ranges [lreplace $ranges end-1 end]
4088 lset rowrangelist $row $ranges
4092 catch {unset rowchk}
4098 if {[info exists selectedline] && $selectedline > $row} {
4099 incr selectedline -1
4104 # Don't change the text pane cursor if it is currently the hand cursor,
4105 # showing that we are over a sha1 ID link.
4106 proc settextcursor {c} {
4107 global ctext curtextcursor
4109 if {[$ctext cget -cursor] == $curtextcursor} {
4110 $ctext config -cursor $c
4112 set curtextcursor $c
4115 proc nowbusy {what} {
4118 if {[array names isbusy] eq {}} {
4119 . config -cursor watch
4125 proc notbusy {what} {
4126 global isbusy maincursor textcursor
4128 catch {unset isbusy($what)}
4129 if {[array names isbusy] eq {}} {
4130 . config -cursor $maincursor
4131 settextcursor $textcursor
4135 proc findmatches {f} {
4136 global findtype findstring
4137 if {$findtype == "Regexp"} {
4138 set matches [regexp -indices -all -inline $findstring $f]
4141 if {$findtype == "IgnCase"} {
4142 set f [string tolower $f]
4143 set fs [string tolower $fs]
4147 set l [string length $fs]
4148 while {[set j [string first $fs $f $i]] >= 0} {
4149 lappend matches [list $j [expr {$j+$l-1}]]
4150 set i [expr {$j + $l}]
4156 proc dofind {{rev 0}} {
4157 global findstring findstartline findcurline selectedline numcommits
4160 cancel_next_highlight
4162 if {$findstring eq {} || $numcommits == 0} return
4163 if {![info exists selectedline]} {
4164 set findstartline [lindex [visiblerows] $rev]
4166 set findstartline $selectedline
4168 set findcurline $findstartline
4173 if {$findcurline == 0} {
4174 set findcurline $numcommits
4181 proc findnext {restart} {
4183 if {![info exists findcurline]} {
4197 if {![info exists findcurline]} {
4206 global commitdata commitinfo numcommits findstring findpattern findloc
4207 global findstartline findcurline displayorder
4209 set fldtypes {Headline Author Date Committer CDate Comments}
4210 set l [expr {$findcurline + 1}]
4211 if {$l >= $numcommits} {
4214 if {$l <= $findstartline} {
4215 set lim [expr {$findstartline + 1}]
4219 if {$lim - $l > 500} {
4220 set lim [expr {$l + 500}]
4223 for {} {$l < $lim} {incr l} {
4224 set id [lindex $displayorder $l]
4225 # shouldn't happen unless git log doesn't give all the commits...
4226 if {![info exists commitdata($id)]} continue
4227 if {![doesmatch $commitdata($id)]} continue
4228 if {![info exists commitinfo($id)]} {
4231 set info $commitinfo($id)
4232 foreach f $info ty $fldtypes {
4233 if {($findloc eq "All fields" || $findloc eq $ty) &&
4241 if {$l == $findstartline + 1} {
4247 set findcurline [expr {$l - 1}]
4251 proc findmorerev {} {
4252 global commitdata commitinfo numcommits findstring findpattern findloc
4253 global findstartline findcurline displayorder
4255 set fldtypes {Headline Author Date Committer CDate Comments}
4261 if {$l >= $findstartline} {
4262 set lim [expr {$findstartline - 1}]
4266 if {$l - $lim > 500} {
4267 set lim [expr {$l - 500}]
4270 for {} {$l > $lim} {incr l -1} {
4271 set id [lindex $displayorder $l]
4272 if {![doesmatch $commitdata($id)]} continue
4273 if {![info exists commitinfo($id)]} {
4276 set info $commitinfo($id)
4277 foreach f $info ty $fldtypes {
4278 if {($findloc eq "All fields" || $findloc eq $ty) &&
4292 set findcurline [expr {$l + 1}]
4296 proc findselectline {l} {
4297 global findloc commentend ctext findcurline markingmatches
4299 set markingmatches 1
4302 if {$findloc == "All fields" || $findloc == "Comments"} {
4303 # highlight the matches in the comments
4304 set f [$ctext get 1.0 $commentend]
4305 set matches [findmatches $f]
4306 foreach match $matches {
4307 set start [lindex $match 0]
4308 set end [expr {[lindex $match 1] + 1}]
4309 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4315 # mark the bits of a headline or author that match a find string
4316 proc markmatches {canv l str tag matches font row} {
4319 set bbox [$canv bbox $tag]
4320 set x0 [lindex $bbox 0]
4321 set y0 [lindex $bbox 1]
4322 set y1 [lindex $bbox 3]
4323 foreach match $matches {
4324 set start [lindex $match 0]
4325 set end [lindex $match 1]
4326 if {$start > $end} continue
4327 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4328 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4329 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4330 [expr {$x0+$xlen+2}] $y1 \
4331 -outline {} -tags [list match$l matches] -fill yellow]
4333 if {[info exists selectedline] && $row == $selectedline} {
4334 $canv raise $t secsel
4339 proc unmarkmatches {} {
4340 global findids markingmatches findcurline
4342 allcanvs delete matches
4343 catch {unset findids}
4344 set markingmatches 0
4345 catch {unset findcurline}
4348 proc selcanvline {w x y} {
4349 global canv canvy0 ctext linespc
4351 set ymax [lindex [$canv cget -scrollregion] 3]
4352 if {$ymax == {}} return
4353 set yfrac [lindex [$canv yview] 0]
4354 set y [expr {$y + $yfrac * $ymax}]
4355 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4360 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4366 proc commit_descriptor {p} {
4368 if {![info exists commitinfo($p)]} {
4372 if {[llength $commitinfo($p)] > 1} {
4373 set l [lindex $commitinfo($p) 0]
4378 # append some text to the ctext widget, and make any SHA1 ID
4379 # that we know about be a clickable link.
4380 proc appendwithlinks {text tags} {
4381 global ctext commitrow linknum curview
4383 set start [$ctext index "end - 1c"]
4384 $ctext insert end $text $tags
4385 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4389 set linkid [string range $text $s $e]
4390 if {![info exists commitrow($curview,$linkid)]} continue
4392 $ctext tag add link "$start + $s c" "$start + $e c"
4393 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4394 $ctext tag bind link$linknum <1> \
4395 [list selectline $commitrow($curview,$linkid) 1]
4398 $ctext tag conf link -foreground blue -underline 1
4399 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4400 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4403 proc viewnextline {dir} {
4407 set ymax [lindex [$canv cget -scrollregion] 3]
4408 set wnow [$canv yview]
4409 set wtop [expr {[lindex $wnow 0] * $ymax}]
4410 set newtop [expr {$wtop + $dir * $linespc}]
4413 } elseif {$newtop > $ymax} {
4416 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4419 # add a list of tag or branch names at position pos
4420 # returns the number of names inserted
4421 proc appendrefs {pos ids var} {
4422 global ctext commitrow linknum curview $var maxrefs
4424 if {[catch {$ctext index $pos}]} {
4427 $ctext conf -state normal
4428 $ctext delete $pos "$pos lineend"
4431 foreach tag [set $var\($id\)] {
4432 lappend tags [list $tag $id]
4435 if {[llength $tags] > $maxrefs} {
4436 $ctext insert $pos "many ([llength $tags])"
4438 set tags [lsort -index 0 -decreasing $tags]
4441 set id [lindex $ti 1]
4444 $ctext tag delete $lk
4445 $ctext insert $pos $sep
4446 $ctext insert $pos [lindex $ti 0] $lk
4447 if {[info exists commitrow($curview,$id)]} {
4448 $ctext tag conf $lk -foreground blue
4449 $ctext tag bind $lk <1> \
4450 [list selectline $commitrow($curview,$id) 1]
4451 $ctext tag conf $lk -underline 1
4452 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4453 $ctext tag bind $lk <Leave> \
4454 { %W configure -cursor $curtextcursor }
4459 $ctext conf -state disabled
4460 return [llength $tags]
4463 # called when we have finished computing the nearby tags
4464 proc dispneartags {delay} {
4465 global selectedline currentid showneartags tagphase
4467 if {![info exists selectedline] || !$showneartags} return
4468 after cancel dispnexttag
4470 after 200 dispnexttag
4473 after idle dispnexttag
4478 proc dispnexttag {} {
4479 global selectedline currentid showneartags tagphase ctext
4481 if {![info exists selectedline] || !$showneartags} return
4482 switch -- $tagphase {
4484 set dtags [desctags $currentid]
4486 appendrefs precedes $dtags idtags
4490 set atags [anctags $currentid]
4492 appendrefs follows $atags idtags
4496 set dheads [descheads $currentid]
4497 if {$dheads ne {}} {
4498 if {[appendrefs branch $dheads idheads] > 1
4499 && [$ctext get "branch -3c"] eq "h"} {
4500 # turn "Branch" into "Branches"
4501 $ctext conf -state normal
4502 $ctext insert "branch -2c" "es"
4503 $ctext conf -state disabled
4508 if {[incr tagphase] <= 2} {
4509 after idle dispnexttag
4513 proc selectline {l isnew} {
4514 global canv canv2 canv3 ctext commitinfo selectedline
4515 global displayorder linehtag linentag linedtag
4516 global canvy0 linespc parentlist children curview
4517 global currentid sha1entry
4518 global commentend idtags linknum
4519 global mergemax numcommits pending_select
4520 global cmitmode showneartags allcommits
4522 catch {unset pending_select}
4525 cancel_next_highlight
4527 if {$l < 0 || $l >= $numcommits} return
4528 set y [expr {$canvy0 + $l * $linespc}]
4529 set ymax [lindex [$canv cget -scrollregion] 3]
4530 set ytop [expr {$y - $linespc - 1}]
4531 set ybot [expr {$y + $linespc + 1}]
4532 set wnow [$canv yview]
4533 set wtop [expr {[lindex $wnow 0] * $ymax}]
4534 set wbot [expr {[lindex $wnow 1] * $ymax}]
4535 set wh [expr {$wbot - $wtop}]
4537 if {$ytop < $wtop} {
4538 if {$ybot < $wtop} {
4539 set newtop [expr {$y - $wh / 2.0}]
4542 if {$newtop > $wtop - $linespc} {
4543 set newtop [expr {$wtop - $linespc}]
4546 } elseif {$ybot > $wbot} {
4547 if {$ytop > $wbot} {
4548 set newtop [expr {$y - $wh / 2.0}]
4550 set newtop [expr {$ybot - $wh}]
4551 if {$newtop < $wtop + $linespc} {
4552 set newtop [expr {$wtop + $linespc}]
4556 if {$newtop != $wtop} {
4560 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4564 if {![info exists linehtag($l)]} return
4566 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4567 -tags secsel -fill [$canv cget -selectbackground]]
4569 $canv2 delete secsel
4570 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4571 -tags secsel -fill [$canv2 cget -selectbackground]]
4573 $canv3 delete secsel
4574 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4575 -tags secsel -fill [$canv3 cget -selectbackground]]
4579 addtohistory [list selectline $l 0]
4584 set id [lindex $displayorder $l]
4586 $sha1entry delete 0 end
4587 $sha1entry insert 0 $id
4588 $sha1entry selection from 0
4589 $sha1entry selection to end
4592 $ctext conf -state normal
4595 set info $commitinfo($id)
4596 set date [formatdate [lindex $info 2]]
4597 $ctext insert end "Author: [lindex $info 1] $date\n"
4598 set date [formatdate [lindex $info 4]]
4599 $ctext insert end "Committer: [lindex $info 3] $date\n"
4600 if {[info exists idtags($id)]} {
4601 $ctext insert end "Tags:"
4602 foreach tag $idtags($id) {
4603 $ctext insert end " $tag"
4605 $ctext insert end "\n"
4609 set olds [lindex $parentlist $l]
4610 if {[llength $olds] > 1} {
4613 if {$np >= $mergemax} {
4618 $ctext insert end "Parent: " $tag
4619 appendwithlinks [commit_descriptor $p] {}
4624 append headers "Parent: [commit_descriptor $p]"
4628 foreach c $children($curview,$id) {
4629 append headers "Child: [commit_descriptor $c]"
4632 # make anything that looks like a SHA1 ID be a clickable link
4633 appendwithlinks $headers {}
4634 if {$showneartags} {
4635 if {![info exists allcommits]} {
4638 $ctext insert end "Branch: "
4639 $ctext mark set branch "end -1c"
4640 $ctext mark gravity branch left
4641 $ctext insert end "\nFollows: "
4642 $ctext mark set follows "end -1c"
4643 $ctext mark gravity follows left
4644 $ctext insert end "\nPrecedes: "
4645 $ctext mark set precedes "end -1c"
4646 $ctext mark gravity precedes left
4647 $ctext insert end "\n"
4650 $ctext insert end "\n"
4651 set comment [lindex $info 5]
4652 if {[string first "\r" $comment] >= 0} {
4653 set comment [string map {"\r" "\n "} $comment]
4655 appendwithlinks $comment {comment}
4657 $ctext tag remove found 1.0 end
4658 $ctext conf -state disabled
4659 set commentend [$ctext index "end - 1c"]
4661 init_flist "Comments"
4662 if {$cmitmode eq "tree"} {
4664 } elseif {[llength $olds] <= 1} {
4671 proc selfirstline {} {
4676 proc sellastline {} {
4679 set l [expr {$numcommits - 1}]
4683 proc selnextline {dir} {
4686 if {![info exists selectedline]} return
4687 set l [expr {$selectedline + $dir}]
4692 proc selnextpage {dir} {
4693 global canv linespc selectedline numcommits
4695 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4699 allcanvs yview scroll [expr {$dir * $lpp}] units
4701 if {![info exists selectedline]} return
4702 set l [expr {$selectedline + $dir * $lpp}]
4705 } elseif {$l >= $numcommits} {
4706 set l [expr $numcommits - 1]
4712 proc unselectline {} {
4713 global selectedline currentid
4715 catch {unset selectedline}
4716 catch {unset currentid}
4717 allcanvs delete secsel
4719 cancel_next_highlight
4722 proc reselectline {} {
4725 if {[info exists selectedline]} {
4726 selectline $selectedline 0
4730 proc addtohistory {cmd} {
4731 global history historyindex curview
4733 set elt [list $curview $cmd]
4734 if {$historyindex > 0
4735 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4739 if {$historyindex < [llength $history]} {
4740 set history [lreplace $history $historyindex end $elt]
4742 lappend history $elt
4745 if {$historyindex > 1} {
4746 .tf.bar.leftbut conf -state normal
4748 .tf.bar.leftbut conf -state disabled
4750 .tf.bar.rightbut conf -state disabled
4756 set view [lindex $elt 0]
4757 set cmd [lindex $elt 1]
4758 if {$curview != $view} {
4765 global history historyindex
4768 if {$historyindex > 1} {
4769 incr historyindex -1
4770 godo [lindex $history [expr {$historyindex - 1}]]
4771 .tf.bar.rightbut conf -state normal
4773 if {$historyindex <= 1} {
4774 .tf.bar.leftbut conf -state disabled
4779 global history historyindex
4782 if {$historyindex < [llength $history]} {
4783 set cmd [lindex $history $historyindex]
4786 .tf.bar.leftbut conf -state normal
4788 if {$historyindex >= [llength $history]} {
4789 .tf.bar.rightbut conf -state disabled
4794 global treefilelist treeidlist diffids diffmergeid treepending
4795 global nullid nullid2
4798 catch {unset diffmergeid}
4799 if {![info exists treefilelist($id)]} {
4800 if {![info exists treepending]} {
4801 if {$id eq $nullid} {
4802 set cmd [list | git ls-files]
4803 } elseif {$id eq $nullid2} {
4804 set cmd [list | git ls-files --stage -t]
4806 set cmd [list | git ls-tree -r $id]
4808 if {[catch {set gtf [open $cmd r]}]} {
4812 set treefilelist($id) {}
4813 set treeidlist($id) {}
4814 fconfigure $gtf -blocking 0
4815 filerun $gtf [list gettreeline $gtf $id]
4822 proc gettreeline {gtf id} {
4823 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4826 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4827 if {$diffids eq $nullid} {
4830 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4831 set i [string first "\t" $line]
4832 if {$i < 0} continue
4833 set sha1 [lindex $line 2]
4834 set fname [string range $line [expr {$i+1}] end]
4835 if {[string index $fname 0] eq "\""} {
4836 set fname [lindex $fname 0]
4838 lappend treeidlist($id) $sha1
4840 lappend treefilelist($id) $fname
4843 return [expr {$nl >= 1000? 2: 1}]
4847 if {$cmitmode ne "tree"} {
4848 if {![info exists diffmergeid]} {
4849 gettreediffs $diffids
4851 } elseif {$id ne $diffids} {
4860 global treefilelist treeidlist diffids nullid nullid2
4861 global ctext commentend
4863 set i [lsearch -exact $treefilelist($diffids) $f]
4865 puts "oops, $f not in list for id $diffids"
4868 if {$diffids eq $nullid} {
4869 if {[catch {set bf [open $f r]} err]} {
4870 puts "oops, can't read $f: $err"
4874 set blob [lindex $treeidlist($diffids) $i]
4875 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4876 puts "oops, error reading blob $blob: $err"
4880 fconfigure $bf -blocking 0
4881 filerun $bf [list getblobline $bf $diffids]
4882 $ctext config -state normal
4883 clear_ctext $commentend
4884 $ctext insert end "\n"
4885 $ctext insert end "$f\n" filesep
4886 $ctext config -state disabled
4887 $ctext yview $commentend
4890 proc getblobline {bf id} {
4891 global diffids cmitmode ctext
4893 if {$id ne $diffids || $cmitmode ne "tree"} {
4897 $ctext config -state normal
4899 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4900 $ctext insert end "$line\n"
4903 # delete last newline
4904 $ctext delete "end - 2c" "end - 1c"
4908 $ctext config -state disabled
4909 return [expr {$nl >= 1000? 2: 1}]
4912 proc mergediff {id l} {
4913 global diffmergeid diffopts mdifffd
4919 # this doesn't seem to actually affect anything...
4920 set env(GIT_DIFF_OPTS) $diffopts
4921 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4922 if {[catch {set mdf [open $cmd r]} err]} {
4923 error_popup "Error getting merge diffs: $err"
4926 fconfigure $mdf -blocking 0
4927 set mdifffd($id) $mdf
4928 set np [llength [lindex $parentlist $l]]
4929 filerun $mdf [list getmergediffline $mdf $id $np]
4932 proc getmergediffline {mdf id np} {
4933 global diffmergeid ctext cflist mergemax
4934 global difffilestart mdifffd
4936 $ctext conf -state normal
4938 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4939 if {![info exists diffmergeid] || $id != $diffmergeid
4940 || $mdf != $mdifffd($id)} {
4944 if {[regexp {^diff --cc (.*)} $line match fname]} {
4945 # start of a new file
4946 $ctext insert end "\n"
4947 set here [$ctext index "end - 1c"]
4948 lappend difffilestart $here
4949 add_flist [list $fname]
4950 set l [expr {(78 - [string length $fname]) / 2}]
4951 set pad [string range "----------------------------------------" 1 $l]
4952 $ctext insert end "$pad $fname $pad\n" filesep
4953 } elseif {[regexp {^@@} $line]} {
4954 $ctext insert end "$line\n" hunksep
4955 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4958 # parse the prefix - one ' ', '-' or '+' for each parent
4963 for {set j 0} {$j < $np} {incr j} {
4964 set c [string range $line $j $j]
4967 } elseif {$c == "-"} {
4969 } elseif {$c == "+"} {
4978 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4979 # line doesn't appear in result, parents in $minuses have the line
4980 set num [lindex $minuses 0]
4981 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4982 # line appears in result, parents in $pluses don't have the line
4983 lappend tags mresult
4984 set num [lindex $spaces 0]
4987 if {$num >= $mergemax} {
4992 $ctext insert end "$line\n" $tags
4995 $ctext conf -state disabled
5000 return [expr {$nr >= 1000? 2: 1}]
5003 proc startdiff {ids} {
5004 global treediffs diffids treepending diffmergeid nullid nullid2
5007 catch {unset diffmergeid}
5008 if {![info exists treediffs($ids)] ||
5009 [lsearch -exact $ids $nullid] >= 0 ||
5010 [lsearch -exact $ids $nullid2] >= 0} {
5011 if {![info exists treepending]} {
5019 proc path_filter {filter name} {
5021 set l [string length $p]
5022 if {[string compare -length $l $p $name] == 0 &&
5023 ([string length $name] == $l || [string index $name $l] eq "/")} {
5030 proc addtocflist {ids} {
5031 global treediffs cflist viewfiles curview limitdiffs
5033 if {$limitdiffs && $viewfiles($curview) ne {}} {
5035 foreach f $treediffs($ids) {
5036 if {[path_filter $viewfiles($curview) $f]} {
5041 set flist $treediffs($ids)
5047 proc diffcmd {ids flags} {
5048 global nullid nullid2
5050 set i [lsearch -exact $ids $nullid]
5051 set j [lsearch -exact $ids $nullid2]
5053 if {[llength $ids] > 1 && $j < 0} {
5054 # comparing working directory with some specific revision
5055 set cmd [concat | git diff-index $flags]
5057 lappend cmd -R [lindex $ids 1]
5059 lappend cmd [lindex $ids 0]
5062 # comparing working directory with index
5063 set cmd [concat | git diff-files $flags]
5068 } elseif {$j >= 0} {
5069 set cmd [concat | git diff-index --cached $flags]
5070 if {[llength $ids] > 1} {
5071 # comparing index with specific revision
5073 lappend cmd -R [lindex $ids 1]
5075 lappend cmd [lindex $ids 0]
5078 # comparing index with HEAD
5082 set cmd [concat | git diff-tree -r $flags $ids]
5087 proc gettreediffs {ids} {
5088 global treediff treepending
5090 set treepending $ids
5092 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5093 fconfigure $gdtf -blocking 0
5094 filerun $gdtf [list gettreediffline $gdtf $ids]
5097 proc gettreediffline {gdtf ids} {
5098 global treediff treediffs treepending diffids diffmergeid
5102 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5103 set i [string first "\t" $line]
5105 set file [string range $line [expr {$i+1}] end]
5106 if {[string index $file 0] eq "\""} {
5107 set file [lindex $file 0]
5109 lappend treediff $file
5113 return [expr {$nr >= 1000? 2: 1}]
5116 set treediffs($ids) $treediff
5118 if {$cmitmode eq "tree"} {
5120 } elseif {$ids != $diffids} {
5121 if {![info exists diffmergeid]} {
5122 gettreediffs $diffids
5130 # empty string or positive integer
5131 proc diffcontextvalidate {v} {
5132 return [regexp {^(|[1-9][0-9]*)$} $v]
5135 proc diffcontextchange {n1 n2 op} {
5136 global diffcontextstring diffcontext
5138 if {[string is integer -strict $diffcontextstring]} {
5139 if {$diffcontextstring > 0} {
5140 set diffcontext $diffcontextstring
5146 proc getblobdiffs {ids} {
5147 global diffopts blobdifffd diffids env
5148 global diffinhdr treediffs
5150 global limitdiffs viewfiles curview
5152 set env(GIT_DIFF_OPTS) $diffopts
5153 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5154 if {$limitdiffs && $viewfiles($curview) ne {}} {
5155 set cmd [concat $cmd $viewfiles($curview)]
5157 if {[catch {set bdf [open $cmd r]} err]} {
5158 puts "error getting diffs: $err"
5162 fconfigure $bdf -blocking 0
5163 set blobdifffd($ids) $bdf
5164 filerun $bdf [list getblobdiffline $bdf $diffids]
5167 proc setinlist {var i val} {
5170 while {[llength [set $var]] < $i} {
5173 if {[llength [set $var]] == $i} {
5180 proc makediffhdr {fname ids} {
5181 global ctext curdiffstart treediffs
5183 set i [lsearch -exact $treediffs($ids) $fname]
5185 setinlist difffilestart $i $curdiffstart
5187 set l [expr {(78 - [string length $fname]) / 2}]
5188 set pad [string range "----------------------------------------" 1 $l]
5189 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5192 proc getblobdiffline {bdf ids} {
5193 global diffids blobdifffd ctext curdiffstart
5194 global diffnexthead diffnextnote difffilestart
5195 global diffinhdr treediffs
5198 $ctext conf -state normal
5199 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5200 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5204 if {![string compare -length 11 "diff --git " $line]} {
5205 # trim off "diff --git "
5206 set line [string range $line 11 end]
5208 # start of a new file
5209 $ctext insert end "\n"
5210 set curdiffstart [$ctext index "end - 1c"]
5211 $ctext insert end "\n" filesep
5212 # If the name hasn't changed the length will be odd,
5213 # the middle char will be a space, and the two bits either
5214 # side will be a/name and b/name, or "a/name" and "b/name".
5215 # If the name has changed we'll get "rename from" and
5216 # "rename to" or "copy from" and "copy to" lines following this,
5217 # and we'll use them to get the filenames.
5218 # This complexity is necessary because spaces in the filename(s)
5219 # don't get escaped.
5220 set l [string length $line]
5221 set i [expr {$l / 2}]
5222 if {!(($l & 1) && [string index $line $i] eq " " &&
5223 [string range $line 2 [expr {$i - 1}]] eq \
5224 [string range $line [expr {$i + 3}] end])} {
5227 # unescape if quoted and chop off the a/ from the front
5228 if {[string index $line 0] eq "\""} {
5229 set fname [string range [lindex $line 0] 2 end]
5231 set fname [string range $line 2 [expr {$i - 1}]]
5233 makediffhdr $fname $ids
5235 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5236 $line match f1l f1c f2l f2c rest]} {
5237 $ctext insert end "$line\n" hunksep
5240 } elseif {$diffinhdr} {
5241 if {![string compare -length 12 "rename from " $line]} {
5242 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5243 if {[string index $fname 0] eq "\""} {
5244 set fname [lindex $fname 0]
5246 set i [lsearch -exact $treediffs($ids) $fname]
5248 setinlist difffilestart $i $curdiffstart
5250 } elseif {![string compare -length 10 $line "rename to "] ||
5251 ![string compare -length 8 $line "copy to "]} {
5252 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5253 if {[string index $fname 0] eq "\""} {
5254 set fname [lindex $fname 0]
5256 makediffhdr $fname $ids
5257 } elseif {[string compare -length 3 $line "---"] == 0} {
5260 } elseif {[string compare -length 3 $line "+++"] == 0} {
5264 $ctext insert end "$line\n" filesep
5267 set x [string range $line 0 0]
5268 if {$x == "-" || $x == "+"} {
5269 set tag [expr {$x == "+"}]
5270 $ctext insert end "$line\n" d$tag
5271 } elseif {$x == " "} {
5272 $ctext insert end "$line\n"
5274 # "\ No newline at end of file",
5275 # or something else we don't recognize
5276 $ctext insert end "$line\n" hunksep
5280 $ctext conf -state disabled
5285 return [expr {$nr >= 1000? 2: 1}]
5288 proc changediffdisp {} {
5289 global ctext diffelide
5291 $ctext tag conf d0 -elide [lindex $diffelide 0]
5292 $ctext tag conf d1 -elide [lindex $diffelide 1]
5296 global difffilestart ctext
5297 set prev [lindex $difffilestart 0]
5298 set here [$ctext index @0,0]
5299 foreach loc $difffilestart {
5300 if {[$ctext compare $loc >= $here]} {
5310 global difffilestart ctext
5311 set here [$ctext index @0,0]
5312 foreach loc $difffilestart {
5313 if {[$ctext compare $loc > $here]} {
5320 proc clear_ctext {{first 1.0}} {
5321 global ctext smarktop smarkbot
5323 set l [lindex [split $first .] 0]
5324 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5327 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5330 $ctext delete $first end
5333 proc incrsearch {name ix op} {
5334 global ctext searchstring searchdirn
5336 $ctext tag remove found 1.0 end
5337 if {[catch {$ctext index anchor}]} {
5338 # no anchor set, use start of selection, or of visible area
5339 set sel [$ctext tag ranges sel]
5341 $ctext mark set anchor [lindex $sel 0]
5342 } elseif {$searchdirn eq "-forwards"} {
5343 $ctext mark set anchor @0,0
5345 $ctext mark set anchor @0,[winfo height $ctext]
5348 if {$searchstring ne {}} {
5349 set here [$ctext search $searchdirn -- $searchstring anchor]
5358 global sstring ctext searchstring searchdirn
5361 $sstring icursor end
5362 set searchdirn -forwards
5363 if {$searchstring ne {}} {
5364 set sel [$ctext tag ranges sel]
5366 set start "[lindex $sel 0] + 1c"
5367 } elseif {[catch {set start [$ctext index anchor]}]} {
5370 set match [$ctext search -count mlen -- $searchstring $start]
5371 $ctext tag remove sel 1.0 end
5377 set mend "$match + $mlen c"
5378 $ctext tag add sel $match $mend
5379 $ctext mark unset anchor
5383 proc dosearchback {} {
5384 global sstring ctext searchstring searchdirn
5387 $sstring icursor end
5388 set searchdirn -backwards
5389 if {$searchstring ne {}} {
5390 set sel [$ctext tag ranges sel]
5392 set start [lindex $sel 0]
5393 } elseif {[catch {set start [$ctext index anchor]}]} {
5394 set start @0,[winfo height $ctext]
5396 set match [$ctext search -backwards -count ml -- $searchstring $start]
5397 $ctext tag remove sel 1.0 end
5403 set mend "$match + $ml c"
5404 $ctext tag add sel $match $mend
5405 $ctext mark unset anchor
5409 proc searchmark {first last} {
5410 global ctext searchstring
5414 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5415 if {$match eq {}} break
5416 set mend "$match + $mlen c"
5417 $ctext tag add found $match $mend
5421 proc searchmarkvisible {doall} {
5422 global ctext smarktop smarkbot
5424 set topline [lindex [split [$ctext index @0,0] .] 0]
5425 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5426 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5427 # no overlap with previous
5428 searchmark $topline $botline
5429 set smarktop $topline
5430 set smarkbot $botline
5432 if {$topline < $smarktop} {
5433 searchmark $topline [expr {$smarktop-1}]
5434 set smarktop $topline
5436 if {$botline > $smarkbot} {
5437 searchmark [expr {$smarkbot+1}] $botline
5438 set smarkbot $botline
5443 proc scrolltext {f0 f1} {
5446 .bleft.sb set $f0 $f1
5447 if {$searchstring ne {}} {
5453 global linespc charspc canvx0 canvy0 mainfont
5454 global xspc1 xspc2 lthickness
5456 set linespc [font metrics $mainfont -linespace]
5457 set charspc [font measure $mainfont "m"]
5458 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5459 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5460 set lthickness [expr {int($linespc / 9) + 1}]
5461 set xspc1(0) $linespc
5469 set ymax [lindex [$canv cget -scrollregion] 3]
5470 if {$ymax eq {} || $ymax == 0} return
5471 set span [$canv yview]
5474 allcanvs yview moveto [lindex $span 0]
5476 if {[info exists selectedline]} {
5477 selectline $selectedline 0
5478 allcanvs yview moveto [lindex $span 0]
5482 proc incrfont {inc} {
5483 global mainfont textfont ctext canv phase cflist showrefstop
5484 global charspc tabstop
5485 global stopped entries
5487 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5488 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5490 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5491 $cflist conf -font $textfont
5492 $ctext tag conf filesep -font [concat $textfont bold]
5493 foreach e $entries {
5494 $e conf -font $mainfont
5496 if {$phase eq "getcommits"} {
5497 $canv itemconf textitems -font $mainfont
5499 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5500 $showrefstop.list conf -font $mainfont
5506 global sha1entry sha1string
5507 if {[string length $sha1string] == 40} {
5508 $sha1entry delete 0 end
5512 proc sha1change {n1 n2 op} {
5513 global sha1string currentid sha1but
5514 if {$sha1string == {}
5515 || ([info exists currentid] && $sha1string == $currentid)} {
5520 if {[$sha1but cget -state] == $state} return
5521 if {$state == "normal"} {
5522 $sha1but conf -state normal -relief raised -text "Goto: "
5524 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5528 proc gotocommit {} {
5529 global sha1string currentid commitrow tagids headids
5530 global displayorder numcommits curview
5532 if {$sha1string == {}
5533 || ([info exists currentid] && $sha1string == $currentid)} return
5534 if {[info exists tagids($sha1string)]} {
5535 set id $tagids($sha1string)
5536 } elseif {[info exists headids($sha1string)]} {
5537 set id $headids($sha1string)
5539 set id [string tolower $sha1string]
5540 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5542 foreach i $displayorder {
5543 if {[string match $id* $i]} {
5547 if {$matches ne {}} {
5548 if {[llength $matches] > 1} {
5549 error_popup "Short SHA1 id $id is ambiguous"
5552 set id [lindex $matches 0]
5556 if {[info exists commitrow($curview,$id)]} {
5557 selectline $commitrow($curview,$id) 1
5560 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5565 error_popup "$type $sha1string is not known"
5568 proc lineenter {x y id} {
5569 global hoverx hovery hoverid hovertimer
5570 global commitinfo canv
5572 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5576 if {[info exists hovertimer]} {
5577 after cancel $hovertimer
5579 set hovertimer [after 500 linehover]
5583 proc linemotion {x y id} {
5584 global hoverx hovery hoverid hovertimer
5586 if {[info exists hoverid] && $id == $hoverid} {
5589 if {[info exists hovertimer]} {
5590 after cancel $hovertimer
5592 set hovertimer [after 500 linehover]
5596 proc lineleave {id} {
5597 global hoverid hovertimer canv
5599 if {[info exists hoverid] && $id == $hoverid} {
5601 if {[info exists hovertimer]} {
5602 after cancel $hovertimer
5610 global hoverx hovery hoverid hovertimer
5611 global canv linespc lthickness
5612 global commitinfo mainfont
5614 set text [lindex $commitinfo($hoverid) 0]
5615 set ymax [lindex [$canv cget -scrollregion] 3]
5616 if {$ymax == {}} return
5617 set yfrac [lindex [$canv yview] 0]
5618 set x [expr {$hoverx + 2 * $linespc}]
5619 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5620 set x0 [expr {$x - 2 * $lthickness}]
5621 set y0 [expr {$y - 2 * $lthickness}]
5622 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5623 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5624 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5625 -fill \#ffff80 -outline black -width 1 -tags hover]
5627 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5632 proc clickisonarrow {id y} {
5635 set ranges [rowranges $id]
5636 set thresh [expr {2 * $lthickness + 6}]
5637 set n [expr {[llength $ranges] - 1}]
5638 for {set i 1} {$i < $n} {incr i} {
5639 set row [lindex $ranges $i]
5640 if {abs([yc $row] - $y) < $thresh} {
5647 proc arrowjump {id n y} {
5650 # 1 <-> 2, 3 <-> 4, etc...
5651 set n [expr {(($n - 1) ^ 1) + 1}]
5652 set row [lindex [rowranges $id] $n]
5654 set ymax [lindex [$canv cget -scrollregion] 3]
5655 if {$ymax eq {} || $ymax <= 0} return
5656 set view [$canv yview]
5657 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5658 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5662 allcanvs yview moveto $yfrac
5665 proc lineclick {x y id isnew} {
5666 global ctext commitinfo children canv thickerline curview
5668 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5673 # draw this line thicker than normal
5677 set ymax [lindex [$canv cget -scrollregion] 3]
5678 if {$ymax eq {}} return
5679 set yfrac [lindex [$canv yview] 0]
5680 set y [expr {$y + $yfrac * $ymax}]
5682 set dirn [clickisonarrow $id $y]
5684 arrowjump $id $dirn $y
5689 addtohistory [list lineclick $x $y $id 0]
5691 # fill the details pane with info about this line
5692 $ctext conf -state normal
5694 $ctext tag conf link -foreground blue -underline 1
5695 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5696 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5697 $ctext insert end "Parent:\t"
5698 $ctext insert end $id [list link link0]
5699 $ctext tag bind link0 <1> [list selbyid $id]
5700 set info $commitinfo($id)
5701 $ctext insert end "\n\t[lindex $info 0]\n"
5702 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5703 set date [formatdate [lindex $info 2]]
5704 $ctext insert end "\tDate:\t$date\n"
5705 set kids $children($curview,$id)
5707 $ctext insert end "\nChildren:"
5709 foreach child $kids {
5711 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5712 set info $commitinfo($child)
5713 $ctext insert end "\n\t"
5714 $ctext insert end $child [list link link$i]
5715 $ctext tag bind link$i <1> [list selbyid $child]
5716 $ctext insert end "\n\t[lindex $info 0]"
5717 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5718 set date [formatdate [lindex $info 2]]
5719 $ctext insert end "\n\tDate:\t$date\n"
5722 $ctext conf -state disabled
5726 proc normalline {} {
5728 if {[info exists thickerline]} {
5736 global commitrow curview
5737 if {[info exists commitrow($curview,$id)]} {
5738 selectline $commitrow($curview,$id) 1
5744 if {![info exists startmstime]} {
5745 set startmstime [clock clicks -milliseconds]
5747 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5750 proc rowmenu {x y id} {
5751 global rowctxmenu commitrow selectedline rowmenuid curview
5752 global nullid nullid2 fakerowmenu mainhead
5755 if {![info exists selectedline]
5756 || $commitrow($curview,$id) eq $selectedline} {
5761 if {$id ne $nullid && $id ne $nullid2} {
5762 set menu $rowctxmenu
5763 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5765 set menu $fakerowmenu
5767 $menu entryconfigure "Diff this*" -state $state
5768 $menu entryconfigure "Diff selected*" -state $state
5769 $menu entryconfigure "Make patch" -state $state
5770 tk_popup $menu $x $y
5773 proc diffvssel {dirn} {
5774 global rowmenuid selectedline displayorder
5776 if {![info exists selectedline]} return
5778 set oldid [lindex $displayorder $selectedline]
5779 set newid $rowmenuid
5781 set oldid $rowmenuid
5782 set newid [lindex $displayorder $selectedline]
5784 addtohistory [list doseldiff $oldid $newid]
5785 doseldiff $oldid $newid
5788 proc doseldiff {oldid newid} {
5792 $ctext conf -state normal
5795 $ctext insert end "From "
5796 $ctext tag conf link -foreground blue -underline 1
5797 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5798 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5799 $ctext tag bind link0 <1> [list selbyid $oldid]
5800 $ctext insert end $oldid [list link link0]
5801 $ctext insert end "\n "
5802 $ctext insert end [lindex $commitinfo($oldid) 0]
5803 $ctext insert end "\n\nTo "
5804 $ctext tag bind link1 <1> [list selbyid $newid]
5805 $ctext insert end $newid [list link link1]
5806 $ctext insert end "\n "
5807 $ctext insert end [lindex $commitinfo($newid) 0]
5808 $ctext insert end "\n"
5809 $ctext conf -state disabled
5810 $ctext tag remove found 1.0 end
5811 startdiff [list $oldid $newid]
5815 global rowmenuid currentid commitinfo patchtop patchnum
5817 if {![info exists currentid]} return
5818 set oldid $currentid
5819 set oldhead [lindex $commitinfo($oldid) 0]
5820 set newid $rowmenuid
5821 set newhead [lindex $commitinfo($newid) 0]
5824 catch {destroy $top}
5826 label $top.title -text "Generate patch"
5827 grid $top.title - -pady 10
5828 label $top.from -text "From:"
5829 entry $top.fromsha1 -width 40 -relief flat
5830 $top.fromsha1 insert 0 $oldid
5831 $top.fromsha1 conf -state readonly
5832 grid $top.from $top.fromsha1 -sticky w
5833 entry $top.fromhead -width 60 -relief flat
5834 $top.fromhead insert 0 $oldhead
5835 $top.fromhead conf -state readonly
5836 grid x $top.fromhead -sticky w
5837 label $top.to -text "To:"
5838 entry $top.tosha1 -width 40 -relief flat
5839 $top.tosha1 insert 0 $newid
5840 $top.tosha1 conf -state readonly
5841 grid $top.to $top.tosha1 -sticky w
5842 entry $top.tohead -width 60 -relief flat
5843 $top.tohead insert 0 $newhead
5844 $top.tohead conf -state readonly
5845 grid x $top.tohead -sticky w
5846 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5847 grid $top.rev x -pady 10
5848 label $top.flab -text "Output file:"
5849 entry $top.fname -width 60
5850 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5852 grid $top.flab $top.fname -sticky w
5854 button $top.buts.gen -text "Generate" -command mkpatchgo
5855 button $top.buts.can -text "Cancel" -command mkpatchcan
5856 grid $top.buts.gen $top.buts.can
5857 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5858 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5859 grid $top.buts - -pady 10 -sticky ew
5863 proc mkpatchrev {} {
5866 set oldid [$patchtop.fromsha1 get]
5867 set oldhead [$patchtop.fromhead get]
5868 set newid [$patchtop.tosha1 get]
5869 set newhead [$patchtop.tohead get]
5870 foreach e [list fromsha1 fromhead tosha1 tohead] \
5871 v [list $newid $newhead $oldid $oldhead] {
5872 $patchtop.$e conf -state normal
5873 $patchtop.$e delete 0 end
5874 $patchtop.$e insert 0 $v
5875 $patchtop.$e conf -state readonly
5880 global patchtop nullid nullid2
5882 set oldid [$patchtop.fromsha1 get]
5883 set newid [$patchtop.tosha1 get]
5884 set fname [$patchtop.fname get]
5885 set cmd [diffcmd [list $oldid $newid] -p]
5886 lappend cmd >$fname &
5887 if {[catch {eval exec $cmd} err]} {
5888 error_popup "Error creating patch: $err"
5890 catch {destroy $patchtop}
5894 proc mkpatchcan {} {
5897 catch {destroy $patchtop}
5902 global rowmenuid mktagtop commitinfo
5906 catch {destroy $top}
5908 label $top.title -text "Create tag"
5909 grid $top.title - -pady 10
5910 label $top.id -text "ID:"
5911 entry $top.sha1 -width 40 -relief flat
5912 $top.sha1 insert 0 $rowmenuid
5913 $top.sha1 conf -state readonly
5914 grid $top.id $top.sha1 -sticky w
5915 entry $top.head -width 60 -relief flat
5916 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5917 $top.head conf -state readonly
5918 grid x $top.head -sticky w
5919 label $top.tlab -text "Tag name:"
5920 entry $top.tag -width 60
5921 grid $top.tlab $top.tag -sticky w
5923 button $top.buts.gen -text "Create" -command mktaggo
5924 button $top.buts.can -text "Cancel" -command mktagcan
5925 grid $top.buts.gen $top.buts.can
5926 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5927 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5928 grid $top.buts - -pady 10 -sticky ew
5933 global mktagtop env tagids idtags
5935 set id [$mktagtop.sha1 get]
5936 set tag [$mktagtop.tag get]
5938 error_popup "No tag name specified"
5941 if {[info exists tagids($tag)]} {
5942 error_popup "Tag \"$tag\" already exists"
5947 set fname [file join $dir "refs/tags" $tag]
5948 set f [open $fname w]
5952 error_popup "Error creating tag: $err"
5956 set tagids($tag) $id
5957 lappend idtags($id) $tag
5964 proc redrawtags {id} {
5965 global canv linehtag commitrow idpos selectedline curview
5966 global mainfont canvxmax iddrawn
5968 if {![info exists commitrow($curview,$id)]} return
5969 if {![info exists iddrawn($id)]} return
5970 drawcommits $commitrow($curview,$id)
5971 $canv delete tag.$id
5972 set xt [eval drawtags $id $idpos($id)]
5973 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5974 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5975 set xr [expr {$xt + [font measure $mainfont $text]}]
5976 if {$xr > $canvxmax} {
5980 if {[info exists selectedline]
5981 && $selectedline == $commitrow($curview,$id)} {
5982 selectline $selectedline 0
5989 catch {destroy $mktagtop}
5998 proc writecommit {} {
5999 global rowmenuid wrcomtop commitinfo wrcomcmd
6001 set top .writecommit
6003 catch {destroy $top}
6005 label $top.title -text "Write commit to file"
6006 grid $top.title - -pady 10
6007 label $top.id -text "ID:"
6008 entry $top.sha1 -width 40 -relief flat
6009 $top.sha1 insert 0 $rowmenuid
6010 $top.sha1 conf -state readonly
6011 grid $top.id $top.sha1 -sticky w
6012 entry $top.head -width 60 -relief flat
6013 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6014 $top.head conf -state readonly
6015 grid x $top.head -sticky w
6016 label $top.clab -text "Command:"
6017 entry $top.cmd -width 60 -textvariable wrcomcmd
6018 grid $top.clab $top.cmd -sticky w -pady 10
6019 label $top.flab -text "Output file:"
6020 entry $top.fname -width 60
6021 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6022 grid $top.flab $top.fname -sticky w
6024 button $top.buts.gen -text "Write" -command wrcomgo
6025 button $top.buts.can -text "Cancel" -command wrcomcan
6026 grid $top.buts.gen $top.buts.can
6027 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6028 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6029 grid $top.buts - -pady 10 -sticky ew
6036 set id [$wrcomtop.sha1 get]
6037 set cmd "echo $id | [$wrcomtop.cmd get]"
6038 set fname [$wrcomtop.fname get]
6039 if {[catch {exec sh -c $cmd >$fname &} err]} {
6040 error_popup "Error writing commit: $err"
6042 catch {destroy $wrcomtop}
6049 catch {destroy $wrcomtop}
6054 global rowmenuid mkbrtop
6057 catch {destroy $top}
6059 label $top.title -text "Create new branch"
6060 grid $top.title - -pady 10
6061 label $top.id -text "ID:"
6062 entry $top.sha1 -width 40 -relief flat
6063 $top.sha1 insert 0 $rowmenuid
6064 $top.sha1 conf -state readonly
6065 grid $top.id $top.sha1 -sticky w
6066 label $top.nlab -text "Name:"
6067 entry $top.name -width 40
6068 grid $top.nlab $top.name -sticky w
6070 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6071 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6072 grid $top.buts.go $top.buts.can
6073 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6074 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6075 grid $top.buts - -pady 10 -sticky ew
6080 global headids idheads
6082 set name [$top.name get]
6083 set id [$top.sha1 get]
6085 error_popup "Please specify a name for the new branch"
6088 catch {destroy $top}
6092 exec git branch $name $id
6097 set headids($name) $id
6098 lappend idheads($id) $name
6107 proc cherrypick {} {
6108 global rowmenuid curview commitrow
6111 set oldhead [exec git rev-parse HEAD]
6112 set dheads [descheads $rowmenuid]
6113 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6114 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6115 included in branch $mainhead -- really re-apply it?"]
6120 # Unfortunately git-cherry-pick writes stuff to stderr even when
6121 # no error occurs, and exec takes that as an indication of error...
6122 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6127 set newhead [exec git rev-parse HEAD]
6128 if {$newhead eq $oldhead} {
6130 error_popup "No changes committed"
6133 addnewchild $newhead $oldhead
6134 if {[info exists commitrow($curview,$oldhead)]} {
6135 insertrow $commitrow($curview,$oldhead) $newhead
6136 if {$mainhead ne {}} {
6137 movehead $newhead $mainhead
6138 movedhead $newhead $mainhead
6147 global mainheadid mainhead rowmenuid confirm_ok resettype
6148 global showlocalchanges
6151 set w ".confirmreset"
6154 wm title $w "Confirm reset"
6155 message $w.m -text \
6156 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6157 -justify center -aspect 1000
6158 pack $w.m -side top -fill x -padx 20 -pady 20
6159 frame $w.f -relief sunken -border 2
6160 message $w.f.rt -text "Reset type:" -aspect 1000
6161 grid $w.f.rt -sticky w
6163 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6164 -text "Soft: Leave working tree and index untouched"
6165 grid $w.f.soft -sticky w
6166 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6167 -text "Mixed: Leave working tree untouched, reset index"
6168 grid $w.f.mixed -sticky w
6169 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6170 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6171 grid $w.f.hard -sticky w
6172 pack $w.f -side top -fill x
6173 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6174 pack $w.ok -side left -fill x -padx 20 -pady 20
6175 button $w.cancel -text Cancel -command "destroy $w"
6176 pack $w.cancel -side right -fill x -padx 20 -pady 20
6177 bind $w <Visibility> "grab $w; focus $w"
6179 if {!$confirm_ok} return
6180 if {[catch {set fd [open \
6181 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6185 set w ".resetprogress"
6186 filerun $fd [list readresetstat $fd $w]
6189 wm title $w "Reset progress"
6190 message $w.m -text "Reset in progress, please wait..." \
6191 -justify center -aspect 1000
6192 pack $w.m -side top -fill x -padx 20 -pady 5
6193 canvas $w.c -width 150 -height 20 -bg white
6194 $w.c create rect 0 0 0 20 -fill green -tags rect
6195 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6200 proc readresetstat {fd w} {
6201 global mainhead mainheadid showlocalchanges
6203 if {[gets $fd line] >= 0} {
6204 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6205 set x [expr {($m * 150) / $n}]
6206 $w.c coords rect 0 0 $x 20
6212 if {[catch {close $fd} err]} {
6215 set oldhead $mainheadid
6216 set newhead [exec git rev-parse HEAD]
6217 if {$newhead ne $oldhead} {
6218 movehead $newhead $mainhead
6219 movedhead $newhead $mainhead
6220 set mainheadid $newhead
6224 if {$showlocalchanges} {
6230 # context menu for a head
6231 proc headmenu {x y id head} {
6232 global headmenuid headmenuhead headctxmenu mainhead
6235 set headmenuhead $head
6237 if {$head eq $mainhead} {
6240 $headctxmenu entryconfigure 0 -state $state
6241 $headctxmenu entryconfigure 1 -state $state
6242 tk_popup $headctxmenu $x $y
6246 global headmenuid headmenuhead mainhead headids
6247 global showlocalchanges mainheadid
6249 # check the tree is clean first??
6250 set oldmainhead $mainhead
6255 exec git checkout -q $headmenuhead
6261 set mainhead $headmenuhead
6262 set mainheadid $headmenuid
6263 if {[info exists headids($oldmainhead)]} {
6264 redrawtags $headids($oldmainhead)
6266 redrawtags $headmenuid
6268 if {$showlocalchanges} {
6274 global headmenuid headmenuhead mainhead
6277 set head $headmenuhead
6279 # this check shouldn't be needed any more...
6280 if {$head eq $mainhead} {
6281 error_popup "Cannot delete the currently checked-out branch"
6284 set dheads [descheads $id]
6285 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6286 # the stuff on this branch isn't on any other branch
6287 if {![confirm_popup "The commits on branch $head aren't on any other\
6288 branch.\nReally delete branch $head?"]} return
6292 if {[catch {exec git branch -D $head} err]} {
6297 removehead $id $head
6298 removedhead $id $head
6305 # Display a list of tags and heads
6307 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6308 global bglist fglist uifont reflistfilter reflist maincursor
6311 set showrefstop $top
6312 if {[winfo exists $top]} {
6318 wm title $top "Tags and heads: [file tail [pwd]]"
6319 text $top.list -background $bgcolor -foreground $fgcolor \
6320 -selectbackground $selectbgcolor -font $mainfont \
6321 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6322 -width 30 -height 20 -cursor $maincursor \
6323 -spacing1 1 -spacing3 1 -state disabled
6324 $top.list tag configure highlight -background $selectbgcolor
6325 lappend bglist $top.list
6326 lappend fglist $top.list
6327 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6328 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6329 grid $top.list $top.ysb -sticky nsew
6330 grid $top.xsb x -sticky ew
6332 label $top.f.l -text "Filter: " -font $uifont
6333 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6334 set reflistfilter "*"
6335 trace add variable reflistfilter write reflistfilter_change
6336 pack $top.f.e -side right -fill x -expand 1
6337 pack $top.f.l -side left
6338 grid $top.f - -sticky ew -pady 2
6339 button $top.close -command [list destroy $top] -text "Close" \
6342 grid columnconfigure $top 0 -weight 1
6343 grid rowconfigure $top 0 -weight 1
6344 bind $top.list <1> {break}
6345 bind $top.list <B1-Motion> {break}
6346 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6351 proc sel_reflist {w x y} {
6352 global showrefstop reflist headids tagids otherrefids
6354 if {![winfo exists $showrefstop]} return
6355 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6356 set ref [lindex $reflist [expr {$l-1}]]
6357 set n [lindex $ref 0]
6358 switch -- [lindex $ref 1] {
6359 "H" {selbyid $headids($n)}
6360 "T" {selbyid $tagids($n)}
6361 "o" {selbyid $otherrefids($n)}
6363 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6366 proc unsel_reflist {} {
6369 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6370 $showrefstop.list tag remove highlight 0.0 end
6373 proc reflistfilter_change {n1 n2 op} {
6374 global reflistfilter
6376 after cancel refill_reflist
6377 after 200 refill_reflist
6380 proc refill_reflist {} {
6381 global reflist reflistfilter showrefstop headids tagids otherrefids
6382 global commitrow curview commitinterest
6384 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6386 foreach n [array names headids] {
6387 if {[string match $reflistfilter $n]} {
6388 if {[info exists commitrow($curview,$headids($n))]} {
6389 lappend refs [list $n H]
6391 set commitinterest($headids($n)) {run refill_reflist}
6395 foreach n [array names tagids] {
6396 if {[string match $reflistfilter $n]} {
6397 if {[info exists commitrow($curview,$tagids($n))]} {
6398 lappend refs [list $n T]
6400 set commitinterest($tagids($n)) {run refill_reflist}
6404 foreach n [array names otherrefids] {
6405 if {[string match $reflistfilter $n]} {
6406 if {[info exists commitrow($curview,$otherrefids($n))]} {
6407 lappend refs [list $n o]
6409 set commitinterest($otherrefids($n)) {run refill_reflist}
6413 set refs [lsort -index 0 $refs]
6414 if {$refs eq $reflist} return
6416 # Update the contents of $showrefstop.list according to the
6417 # differences between $reflist (old) and $refs (new)
6418 $showrefstop.list conf -state normal
6419 $showrefstop.list insert end "\n"
6422 while {$i < [llength $reflist] || $j < [llength $refs]} {
6423 if {$i < [llength $reflist]} {
6424 if {$j < [llength $refs]} {
6425 set cmp [string compare [lindex $reflist $i 0] \
6426 [lindex $refs $j 0]]
6428 set cmp [string compare [lindex $reflist $i 1] \
6429 [lindex $refs $j 1]]
6439 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6447 set l [expr {$j + 1}]
6448 $showrefstop.list image create $l.0 -align baseline \
6449 -image reficon-[lindex $refs $j 1] -padx 2
6450 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6456 # delete last newline
6457 $showrefstop.list delete end-2c end-1c
6458 $showrefstop.list conf -state disabled
6461 # Stuff for finding nearby tags
6462 proc getallcommits {} {
6463 global allcommits allids nbmp nextarc seeds
6465 if {![info exists allcommits]} {
6473 set cmd [concat | git rev-list --all --parents]
6477 set fd [open $cmd r]
6478 fconfigure $fd -blocking 0
6481 filerun $fd [list getallclines $fd]
6484 # Since most commits have 1 parent and 1 child, we group strings of
6485 # such commits into "arcs" joining branch/merge points (BMPs), which
6486 # are commits that either don't have 1 parent or don't have 1 child.
6488 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6489 # arcout(id) - outgoing arcs for BMP
6490 # arcids(a) - list of IDs on arc including end but not start
6491 # arcstart(a) - BMP ID at start of arc
6492 # arcend(a) - BMP ID at end of arc
6493 # growing(a) - arc a is still growing
6494 # arctags(a) - IDs out of arcids (excluding end) that have tags
6495 # archeads(a) - IDs out of arcids (excluding end) that have heads
6496 # The start of an arc is at the descendent end, so "incoming" means
6497 # coming from descendents, and "outgoing" means going towards ancestors.
6499 proc getallclines {fd} {
6500 global allids allparents allchildren idtags idheads nextarc nbmp
6501 global arcnos arcids arctags arcout arcend arcstart archeads growing
6502 global seeds allcommits
6505 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6506 set id [lindex $line 0]
6507 if {[info exists allparents($id)]} {
6512 set olds [lrange $line 1 end]
6513 set allparents($id) $olds
6514 if {![info exists allchildren($id)]} {
6515 set allchildren($id) {}
6520 if {[llength $olds] == 1 && [llength $a] == 1} {
6521 lappend arcids($a) $id
6522 if {[info exists idtags($id)]} {
6523 lappend arctags($a) $id
6525 if {[info exists idheads($id)]} {
6526 lappend archeads($a) $id
6528 if {[info exists allparents($olds)]} {
6529 # seen parent already
6530 if {![info exists arcout($olds)]} {
6533 lappend arcids($a) $olds
6534 set arcend($a) $olds
6537 lappend allchildren($olds) $id
6538 lappend arcnos($olds) $a
6543 foreach a $arcnos($id) {
6544 lappend arcids($a) $id
6551 lappend allchildren($p) $id
6552 set a [incr nextarc]
6553 set arcstart($a) $id
6560 if {[info exists allparents($p)]} {
6561 # seen it already, may need to make a new branch
6562 if {![info exists arcout($p)]} {
6565 lappend arcids($a) $p
6569 lappend arcnos($p) $a
6574 global cached_dheads cached_dtags cached_atags
6575 catch {unset cached_dheads}
6576 catch {unset cached_dtags}
6577 catch {unset cached_atags}
6580 return [expr {$nid >= 1000? 2: 1}]
6583 if {[incr allcommits -1] == 0} {
6590 proc recalcarc {a} {
6591 global arctags archeads arcids idtags idheads
6595 foreach id [lrange $arcids($a) 0 end-1] {
6596 if {[info exists idtags($id)]} {
6599 if {[info exists idheads($id)]} {
6604 set archeads($a) $ah
6608 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6609 global arcstart arcend arcout allparents growing
6612 if {[llength $a] != 1} {
6613 puts "oops splitarc called but [llength $a] arcs already"
6617 set i [lsearch -exact $arcids($a) $p]
6619 puts "oops splitarc $p not in arc $a"
6622 set na [incr nextarc]
6623 if {[info exists arcend($a)]} {
6624 set arcend($na) $arcend($a)
6626 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6627 set j [lsearch -exact $arcnos($l) $a]
6628 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6630 set tail [lrange $arcids($a) [expr {$i+1}] end]
6631 set arcids($a) [lrange $arcids($a) 0 $i]
6633 set arcstart($na) $p
6635 set arcids($na) $tail
6636 if {[info exists growing($a)]} {
6643 if {[llength $arcnos($id)] == 1} {
6646 set j [lsearch -exact $arcnos($id) $a]
6647 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6651 # reconstruct tags and heads lists
6652 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6657 set archeads($na) {}
6661 # Update things for a new commit added that is a child of one
6662 # existing commit. Used when cherry-picking.
6663 proc addnewchild {id p} {
6664 global allids allparents allchildren idtags nextarc nbmp
6665 global arcnos arcids arctags arcout arcend arcstart archeads growing
6666 global seeds allcommits
6668 if {![info exists allcommits] || ![info exists arcnos($p)]} return
6670 set allparents($id) [list $p]
6671 set allchildren($id) {}
6675 lappend allchildren($p) $id
6676 set a [incr nextarc]
6677 set arcstart($a) $id
6680 set arcids($a) [list $p]
6682 if {![info exists arcout($p)]} {
6685 lappend arcnos($p) $a
6686 set arcout($id) [list $a]
6689 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6690 # or 0 if neither is true.
6691 proc anc_or_desc {a b} {
6692 global arcout arcstart arcend arcnos cached_isanc
6694 if {$arcnos($a) eq $arcnos($b)} {
6695 # Both are on the same arc(s); either both are the same BMP,
6696 # or if one is not a BMP, the other is also not a BMP or is
6697 # the BMP at end of the arc (and it only has 1 incoming arc).
6698 # Or both can be BMPs with no incoming arcs.
6699 if {$a eq $b || $arcnos($a) eq {}} {
6702 # assert {[llength $arcnos($a)] == 1}
6703 set arc [lindex $arcnos($a) 0]
6704 set i [lsearch -exact $arcids($arc) $a]
6705 set j [lsearch -exact $arcids($arc) $b]
6706 if {$i < 0 || $i > $j} {
6713 if {![info exists arcout($a)]} {
6714 set arc [lindex $arcnos($a) 0]
6715 if {[info exists arcend($arc)]} {
6716 set aend $arcend($arc)
6720 set a $arcstart($arc)
6724 if {![info exists arcout($b)]} {
6725 set arc [lindex $arcnos($b) 0]
6726 if {[info exists arcend($arc)]} {
6727 set bend $arcend($arc)
6731 set b $arcstart($arc)
6741 if {[info exists cached_isanc($a,$bend)]} {
6742 if {$cached_isanc($a,$bend)} {
6746 if {[info exists cached_isanc($b,$aend)]} {
6747 if {$cached_isanc($b,$aend)} {
6750 if {[info exists cached_isanc($a,$bend)]} {
6755 set todo [list $a $b]
6758 for {set i 0} {$i < [llength $todo]} {incr i} {
6759 set x [lindex $todo $i]
6760 if {$anc($x) eq {}} {
6763 foreach arc $arcnos($x) {
6764 set xd $arcstart($arc)
6766 set cached_isanc($a,$bend) 1
6767 set cached_isanc($b,$aend) 0
6769 } elseif {$xd eq $aend} {
6770 set cached_isanc($b,$aend) 1
6771 set cached_isanc($a,$bend) 0
6774 if {![info exists anc($xd)]} {
6775 set anc($xd) $anc($x)
6777 } elseif {$anc($xd) ne $anc($x)} {
6782 set cached_isanc($a,$bend) 0
6783 set cached_isanc($b,$aend) 0
6787 # This identifies whether $desc has an ancestor that is
6788 # a growing tip of the graph and which is not an ancestor of $anc
6789 # and returns 0 if so and 1 if not.
6790 # If we subsequently discover a tag on such a growing tip, and that
6791 # turns out to be a descendent of $anc (which it could, since we
6792 # don't necessarily see children before parents), then $desc
6793 # isn't a good choice to display as a descendent tag of
6794 # $anc (since it is the descendent of another tag which is
6795 # a descendent of $anc). Similarly, $anc isn't a good choice to
6796 # display as a ancestor tag of $desc.
6798 proc is_certain {desc anc} {
6799 global arcnos arcout arcstart arcend growing problems
6802 if {[llength $arcnos($anc)] == 1} {
6803 # tags on the same arc are certain
6804 if {$arcnos($desc) eq $arcnos($anc)} {
6807 if {![info exists arcout($anc)]} {
6808 # if $anc is partway along an arc, use the start of the arc instead
6809 set a [lindex $arcnos($anc) 0]
6810 set anc $arcstart($a)
6813 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6816 set a [lindex $arcnos($desc) 0]
6822 set anclist [list $x]
6826 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6827 set x [lindex $anclist $i]
6832 foreach a $arcout($x) {
6833 if {[info exists growing($a)]} {
6834 if {![info exists growanc($x)] && $dl($x)} {
6840 if {[info exists dl($y)]} {
6844 if {![info exists done($y)]} {
6847 if {[info exists growanc($x)]} {
6851 for {set k 0} {$k < [llength $xl]} {incr k} {
6852 set z [lindex $xl $k]
6853 foreach c $arcout($z) {
6854 if {[info exists arcend($c)]} {
6856 if {[info exists dl($v)] && $dl($v)} {
6858 if {![info exists done($v)]} {
6861 if {[info exists growanc($v)]} {
6871 } elseif {$y eq $anc || !$dl($x)} {
6882 foreach x [array names growanc] {
6891 proc validate_arctags {a} {
6892 global arctags idtags
6896 foreach id $arctags($a) {
6898 if {![info exists idtags($id)]} {
6899 set na [lreplace $na $i $i]
6906 proc validate_archeads {a} {
6907 global archeads idheads
6910 set na $archeads($a)
6911 foreach id $archeads($a) {
6913 if {![info exists idheads($id)]} {
6914 set na [lreplace $na $i $i]
6918 set archeads($a) $na
6921 # Return the list of IDs that have tags that are descendents of id,
6922 # ignoring IDs that are descendents of IDs already reported.
6923 proc desctags {id} {
6924 global arcnos arcstart arcids arctags idtags allparents
6925 global growing cached_dtags
6927 if {![info exists allparents($id)]} {
6930 set t1 [clock clicks -milliseconds]
6932 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6933 # part-way along an arc; check that arc first
6934 set a [lindex $arcnos($id) 0]
6935 if {$arctags($a) ne {}} {
6937 set i [lsearch -exact $arcids($a) $id]
6939 foreach t $arctags($a) {
6940 set j [lsearch -exact $arcids($a) $t]
6948 set id $arcstart($a)
6949 if {[info exists idtags($id)]} {
6953 if {[info exists cached_dtags($id)]} {
6954 return $cached_dtags($id)
6961 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6962 set id [lindex $todo $i]
6964 set ta [info exists hastaggedancestor($id)]
6968 # ignore tags on starting node
6969 if {!$ta && $i > 0} {
6970 if {[info exists idtags($id)]} {
6973 } elseif {[info exists cached_dtags($id)]} {
6974 set tagloc($id) $cached_dtags($id)
6978 foreach a $arcnos($id) {
6980 if {!$ta && $arctags($a) ne {}} {
6982 if {$arctags($a) ne {}} {
6983 lappend tagloc($id) [lindex $arctags($a) end]
6986 if {$ta || $arctags($a) ne {}} {
6987 set tomark [list $d]
6988 for {set j 0} {$j < [llength $tomark]} {incr j} {
6989 set dd [lindex $tomark $j]
6990 if {![info exists hastaggedancestor($dd)]} {
6991 if {[info exists done($dd)]} {
6992 foreach b $arcnos($dd) {
6993 lappend tomark $arcstart($b)
6995 if {[info exists tagloc($dd)]} {
6998 } elseif {[info exists queued($dd)]} {
7001 set hastaggedancestor($dd) 1
7005 if {![info exists queued($d)]} {
7008 if {![info exists hastaggedancestor($d)]} {
7015 foreach id [array names tagloc] {
7016 if {![info exists hastaggedancestor($id)]} {
7017 foreach t $tagloc($id) {
7018 if {[lsearch -exact $tags $t] < 0} {
7024 set t2 [clock clicks -milliseconds]
7027 # remove tags that are descendents of other tags
7028 for {set i 0} {$i < [llength $tags]} {incr i} {
7029 set a [lindex $tags $i]
7030 for {set j 0} {$j < $i} {incr j} {
7031 set b [lindex $tags $j]
7032 set r [anc_or_desc $a $b]
7034 set tags [lreplace $tags $j $j]
7037 } elseif {$r == -1} {
7038 set tags [lreplace $tags $i $i]
7045 if {[array names growing] ne {}} {
7046 # graph isn't finished, need to check if any tag could get
7047 # eclipsed by another tag coming later. Simply ignore any
7048 # tags that could later get eclipsed.
7051 if {[is_certain $t $origid]} {
7055 if {$tags eq $ctags} {
7056 set cached_dtags($origid) $tags
7061 set cached_dtags($origid) $tags
7063 set t3 [clock clicks -milliseconds]
7064 if {0 && $t3 - $t1 >= 100} {
7065 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7066 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7072 global arcnos arcids arcout arcend arctags idtags allparents
7073 global growing cached_atags
7075 if {![info exists allparents($id)]} {
7078 set t1 [clock clicks -milliseconds]
7080 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7081 # part-way along an arc; check that arc first
7082 set a [lindex $arcnos($id) 0]
7083 if {$arctags($a) ne {}} {
7085 set i [lsearch -exact $arcids($a) $id]
7086 foreach t $arctags($a) {
7087 set j [lsearch -exact $arcids($a) $t]
7093 if {![info exists arcend($a)]} {
7097 if {[info exists idtags($id)]} {
7101 if {[info exists cached_atags($id)]} {
7102 return $cached_atags($id)
7110 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7111 set id [lindex $todo $i]
7113 set td [info exists hastaggeddescendent($id)]
7117 # ignore tags on starting node
7118 if {!$td && $i > 0} {
7119 if {[info exists idtags($id)]} {
7122 } elseif {[info exists cached_atags($id)]} {
7123 set tagloc($id) $cached_atags($id)
7127 foreach a $arcout($id) {
7128 if {!$td && $arctags($a) ne {}} {
7130 if {$arctags($a) ne {}} {
7131 lappend tagloc($id) [lindex $arctags($a) 0]
7134 if {![info exists arcend($a)]} continue
7136 if {$td || $arctags($a) ne {}} {
7137 set tomark [list $d]
7138 for {set j 0} {$j < [llength $tomark]} {incr j} {
7139 set dd [lindex $tomark $j]
7140 if {![info exists hastaggeddescendent($dd)]} {
7141 if {[info exists done($dd)]} {
7142 foreach b $arcout($dd) {
7143 if {[info exists arcend($b)]} {
7144 lappend tomark $arcend($b)
7147 if {[info exists tagloc($dd)]} {
7150 } elseif {[info exists queued($dd)]} {
7153 set hastaggeddescendent($dd) 1
7157 if {![info exists queued($d)]} {
7160 if {![info exists hastaggeddescendent($d)]} {
7166 set t2 [clock clicks -milliseconds]
7169 foreach id [array names tagloc] {
7170 if {![info exists hastaggeddescendent($id)]} {
7171 foreach t $tagloc($id) {
7172 if {[lsearch -exact $tags $t] < 0} {
7179 # remove tags that are ancestors of other tags
7180 for {set i 0} {$i < [llength $tags]} {incr i} {
7181 set a [lindex $tags $i]
7182 for {set j 0} {$j < $i} {incr j} {
7183 set b [lindex $tags $j]
7184 set r [anc_or_desc $a $b]
7186 set tags [lreplace $tags $j $j]
7189 } elseif {$r == 1} {
7190 set tags [lreplace $tags $i $i]
7197 if {[array names growing] ne {}} {
7198 # graph isn't finished, need to check if any tag could get
7199 # eclipsed by another tag coming later. Simply ignore any
7200 # tags that could later get eclipsed.
7203 if {[is_certain $origid $t]} {
7207 if {$tags eq $ctags} {
7208 set cached_atags($origid) $tags
7213 set cached_atags($origid) $tags
7215 set t3 [clock clicks -milliseconds]
7216 if {0 && $t3 - $t1 >= 100} {
7217 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7218 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7223 # Return the list of IDs that have heads that are descendents of id,
7224 # including id itself if it has a head.
7225 proc descheads {id} {
7226 global arcnos arcstart arcids archeads idheads cached_dheads
7229 if {![info exists allparents($id)]} {
7233 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7234 # part-way along an arc; check it first
7235 set a [lindex $arcnos($id) 0]
7236 if {$archeads($a) ne {}} {
7237 validate_archeads $a
7238 set i [lsearch -exact $arcids($a) $id]
7239 foreach t $archeads($a) {
7240 set j [lsearch -exact $arcids($a) $t]
7245 set id $arcstart($a)
7251 for {set i 0} {$i < [llength $todo]} {incr i} {
7252 set id [lindex $todo $i]
7253 if {[info exists cached_dheads($id)]} {
7254 set ret [concat $ret $cached_dheads($id)]
7256 if {[info exists idheads($id)]} {
7259 foreach a $arcnos($id) {
7260 if {$archeads($a) ne {}} {
7261 validate_archeads $a
7262 if {$archeads($a) ne {}} {
7263 set ret [concat $ret $archeads($a)]
7267 if {![info exists seen($d)]} {
7274 set ret [lsort -unique $ret]
7275 set cached_dheads($origid) $ret
7276 return [concat $ret $aret]
7279 proc addedtag {id} {
7280 global arcnos arcout cached_dtags cached_atags
7282 if {![info exists arcnos($id)]} return
7283 if {![info exists arcout($id)]} {
7284 recalcarc [lindex $arcnos($id) 0]
7286 catch {unset cached_dtags}
7287 catch {unset cached_atags}
7290 proc addedhead {hid head} {
7291 global arcnos arcout cached_dheads
7293 if {![info exists arcnos($hid)]} return
7294 if {![info exists arcout($hid)]} {
7295 recalcarc [lindex $arcnos($hid) 0]
7297 catch {unset cached_dheads}
7300 proc removedhead {hid head} {
7301 global cached_dheads
7303 catch {unset cached_dheads}
7306 proc movedhead {hid head} {
7307 global arcnos arcout cached_dheads
7309 if {![info exists arcnos($hid)]} return
7310 if {![info exists arcout($hid)]} {
7311 recalcarc [lindex $arcnos($hid) 0]
7313 catch {unset cached_dheads}
7316 proc changedrefs {} {
7317 global cached_dheads cached_dtags cached_atags
7318 global arctags archeads arcnos arcout idheads idtags
7320 foreach id [concat [array names idheads] [array names idtags]] {
7321 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7322 set a [lindex $arcnos($id) 0]
7323 if {![info exists donearc($a)]} {
7329 catch {unset cached_dtags}
7330 catch {unset cached_atags}
7331 catch {unset cached_dheads}
7334 proc rereadrefs {} {
7335 global idtags idheads idotherrefs mainhead
7337 set refids [concat [array names idtags] \
7338 [array names idheads] [array names idotherrefs]]
7339 foreach id $refids {
7340 if {![info exists ref($id)]} {
7341 set ref($id) [listrefs $id]
7344 set oldmainhead $mainhead
7347 set refids [lsort -unique [concat $refids [array names idtags] \
7348 [array names idheads] [array names idotherrefs]]]
7349 foreach id $refids {
7350 set v [listrefs $id]
7351 if {![info exists ref($id)] || $ref($id) != $v ||
7352 ($id eq $oldmainhead && $id ne $mainhead) ||
7353 ($id eq $mainhead && $id ne $oldmainhead)} {
7360 proc listrefs {id} {
7361 global idtags idheads idotherrefs
7364 if {[info exists idtags($id)]} {
7368 if {[info exists idheads($id)]} {
7372 if {[info exists idotherrefs($id)]} {
7373 set z $idotherrefs($id)
7375 return [list $x $y $z]
7378 proc showtag {tag isnew} {
7379 global ctext tagcontents tagids linknum tagobjid
7382 addtohistory [list showtag $tag 0]
7384 $ctext conf -state normal
7387 if {![info exists tagcontents($tag)]} {
7389 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7392 if {[info exists tagcontents($tag)]} {
7393 set text $tagcontents($tag)
7395 set text "Tag: $tag\nId: $tagids($tag)"
7397 appendwithlinks $text {}
7398 $ctext conf -state disabled
7410 global maxwidth maxgraphpct diffopts
7411 global oldprefs prefstop showneartags showlocalchanges
7412 global bgcolor fgcolor ctext diffcolors selectbgcolor
7413 global uifont tabstop limitdiffs
7417 if {[winfo exists $top]} {
7421 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges \
7423 set oldprefs($v) [set $v]
7426 wm title $top "Gitk preferences"
7427 label $top.ldisp -text "Commit list display options"
7428 $top.ldisp configure -font $uifont
7429 grid $top.ldisp - -sticky w -pady 10
7430 label $top.spacer -text " "
7431 label $top.maxwidthl -text "Maximum graph width (lines)" \
7433 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7434 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7435 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7437 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7438 grid x $top.maxpctl $top.maxpct -sticky w
7439 frame $top.showlocal
7440 label $top.showlocal.l -text "Show local changes" -font optionfont
7441 checkbutton $top.showlocal.b -variable showlocalchanges
7442 pack $top.showlocal.b $top.showlocal.l -side left
7443 grid x $top.showlocal -sticky w
7445 label $top.ddisp -text "Diff display options"
7446 $top.ddisp configure -font $uifont
7447 grid $top.ddisp - -sticky w -pady 10
7448 label $top.diffoptl -text "Options for diff program" \
7450 entry $top.diffopt -width 20 -textvariable diffopts
7451 grid x $top.diffoptl $top.diffopt -sticky w
7453 label $top.ntag.l -text "Display nearby tags" -font optionfont
7454 checkbutton $top.ntag.b -variable showneartags
7455 pack $top.ntag.b $top.ntag.l -side left
7456 grid x $top.ntag -sticky w
7457 label $top.tabstopl -text "tabstop" -font optionfont
7458 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7459 grid x $top.tabstopl $top.tabstop -sticky w
7461 label $top.ldiff.l -text "Limit diffs to listed paths" -font optionfont
7462 checkbutton $top.ldiff.b -variable limitdiffs
7463 pack $top.ldiff.b $top.ldiff.l -side left
7464 grid x $top.ldiff -sticky w
7466 label $top.cdisp -text "Colors: press to choose"
7467 $top.cdisp configure -font $uifont
7468 grid $top.cdisp - -sticky w -pady 10
7469 label $top.bg -padx 40 -relief sunk -background $bgcolor
7470 button $top.bgbut -text "Background" -font optionfont \
7471 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7472 grid x $top.bgbut $top.bg -sticky w
7473 label $top.fg -padx 40 -relief sunk -background $fgcolor
7474 button $top.fgbut -text "Foreground" -font optionfont \
7475 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7476 grid x $top.fgbut $top.fg -sticky w
7477 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7478 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7479 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7480 [list $ctext tag conf d0 -foreground]]
7481 grid x $top.diffoldbut $top.diffold -sticky w
7482 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7483 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7484 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7485 [list $ctext tag conf d1 -foreground]]
7486 grid x $top.diffnewbut $top.diffnew -sticky w
7487 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7488 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7489 -command [list choosecolor diffcolors 2 $top.hunksep \
7490 "diff hunk header" \
7491 [list $ctext tag conf hunksep -foreground]]
7492 grid x $top.hunksepbut $top.hunksep -sticky w
7493 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7494 button $top.selbgbut -text "Select bg" -font optionfont \
7495 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7496 grid x $top.selbgbut $top.selbgsep -sticky w
7499 button $top.buts.ok -text "OK" -command prefsok -default active
7500 $top.buts.ok configure -font $uifont
7501 button $top.buts.can -text "Cancel" -command prefscan -default normal
7502 $top.buts.can configure -font $uifont
7503 grid $top.buts.ok $top.buts.can
7504 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7505 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7506 grid $top.buts - - -pady 10 -sticky ew
7507 bind $top <Visibility> "focus $top.buts.ok"
7510 proc choosecolor {v vi w x cmd} {
7513 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7514 -title "Gitk: choose color for $x"]
7515 if {$c eq {}} return
7516 $w conf -background $c
7522 global bglist cflist
7524 $w configure -selectbackground $c
7526 $cflist tag configure highlight \
7527 -background [$cflist cget -selectbackground]
7528 allcanvs itemconf secsel -fill $c
7535 $w conf -background $c
7543 $w conf -foreground $c
7545 allcanvs itemconf text -fill $c
7546 $canv itemconf circle -outline $c
7550 global maxwidth maxgraphpct diffopts
7551 global oldprefs prefstop showneartags showlocalchanges limitdiffs
7553 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges \
7555 set $v $oldprefs($v)
7557 catch {destroy $prefstop}
7562 global maxwidth maxgraphpct
7563 global oldprefs prefstop showneartags showlocalchanges
7564 global charspc ctext tabstop limitdiffs
7566 catch {destroy $prefstop}
7568 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7569 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7570 if {$showlocalchanges} {
7576 if {$maxwidth != $oldprefs(maxwidth)
7577 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7579 } elseif {$showneartags != $oldprefs(showneartags) ||
7580 $limitdiffs != $oldprefs(limitdiffs)} {
7585 proc formatdate {d} {
7586 global datetimeformat
7588 set d [clock format $d -format $datetimeformat]
7593 # This list of encoding names and aliases is distilled from
7594 # http://www.iana.org/assignments/character-sets.
7595 # Not all of them are supported by Tcl.
7596 set encoding_aliases {
7597 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7598 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7599 { ISO-10646-UTF-1 csISO10646UTF1 }
7600 { ISO_646.basic:1983 ref csISO646basic1983 }
7601 { INVARIANT csINVARIANT }
7602 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7603 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7604 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7605 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7606 { NATS-DANO iso-ir-9-1 csNATSDANO }
7607 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7608 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7609 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7610 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7611 { ISO-2022-KR csISO2022KR }
7613 { ISO-2022-JP csISO2022JP }
7614 { ISO-2022-JP-2 csISO2022JP2 }
7615 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7617 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7618 { IT iso-ir-15 ISO646-IT csISO15Italian }
7619 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7620 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7621 { greek7-old iso-ir-18 csISO18Greek7Old }
7622 { latin-greek iso-ir-19 csISO19LatinGreek }
7623 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7624 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7625 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7626 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7627 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7628 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7629 { INIS iso-ir-49 csISO49INIS }
7630 { INIS-8 iso-ir-50 csISO50INIS8 }
7631 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7632 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7633 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7634 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7635 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7636 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7638 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7639 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7640 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7641 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7642 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7643 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7644 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7645 { greek7 iso-ir-88 csISO88Greek7 }
7646 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7647 { iso-ir-90 csISO90 }
7648 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7649 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7650 csISO92JISC62991984b }
7651 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7652 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7653 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7654 csISO95JIS62291984handadd }
7655 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7656 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7657 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7658 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7660 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7661 { T.61-7bit iso-ir-102 csISO102T617bit }
7662 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7663 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7664 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7665 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7666 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7667 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7668 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7669 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7670 arabic csISOLatinArabic }
7671 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7672 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7673 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7674 greek greek8 csISOLatinGreek }
7675 { T.101-G2 iso-ir-128 csISO128T101G2 }
7676 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7678 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7679 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7680 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7681 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7682 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7683 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7684 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7685 csISOLatinCyrillic }
7686 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7687 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7688 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7689 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7690 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7691 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7692 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7693 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7694 { ISO_10367-box iso-ir-155 csISO10367Box }
7695 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7696 { latin-lap lap iso-ir-158 csISO158Lap }
7697 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7698 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7701 { JIS_X0201 X0201 csHalfWidthKatakana }
7702 { KSC5636 ISO646-KR csKSC5636 }
7703 { ISO-10646-UCS-2 csUnicode }
7704 { ISO-10646-UCS-4 csUCS4 }
7705 { DEC-MCS dec csDECMCS }
7706 { hp-roman8 roman8 r8 csHPRoman8 }
7707 { macintosh mac csMacintosh }
7708 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7710 { IBM038 EBCDIC-INT cp038 csIBM038 }
7711 { IBM273 CP273 csIBM273 }
7712 { IBM274 EBCDIC-BE CP274 csIBM274 }
7713 { IBM275 EBCDIC-BR cp275 csIBM275 }
7714 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7715 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7716 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7717 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7718 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7719 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7720 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7721 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7722 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7723 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7724 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7725 { IBM437 cp437 437 csPC8CodePage437 }
7726 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7727 { IBM775 cp775 csPC775Baltic }
7728 { IBM850 cp850 850 csPC850Multilingual }
7729 { IBM851 cp851 851 csIBM851 }
7730 { IBM852 cp852 852 csPCp852 }
7731 { IBM855 cp855 855 csIBM855 }
7732 { IBM857 cp857 857 csIBM857 }
7733 { IBM860 cp860 860 csIBM860 }
7734 { IBM861 cp861 861 cp-is csIBM861 }
7735 { IBM862 cp862 862 csPC862LatinHebrew }
7736 { IBM863 cp863 863 csIBM863 }
7737 { IBM864 cp864 csIBM864 }
7738 { IBM865 cp865 865 csIBM865 }
7739 { IBM866 cp866 866 csIBM866 }
7740 { IBM868 CP868 cp-ar csIBM868 }
7741 { IBM869 cp869 869 cp-gr csIBM869 }
7742 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7743 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7744 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7745 { IBM891 cp891 csIBM891 }
7746 { IBM903 cp903 csIBM903 }
7747 { IBM904 cp904 904 csIBBM904 }
7748 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7749 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7750 { IBM1026 CP1026 csIBM1026 }
7751 { EBCDIC-AT-DE csIBMEBCDICATDE }
7752 { EBCDIC-AT-DE-A csEBCDICATDEA }
7753 { EBCDIC-CA-FR csEBCDICCAFR }
7754 { EBCDIC-DK-NO csEBCDICDKNO }
7755 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7756 { EBCDIC-FI-SE csEBCDICFISE }
7757 { EBCDIC-FI-SE-A csEBCDICFISEA }
7758 { EBCDIC-FR csEBCDICFR }
7759 { EBCDIC-IT csEBCDICIT }
7760 { EBCDIC-PT csEBCDICPT }
7761 { EBCDIC-ES csEBCDICES }
7762 { EBCDIC-ES-A csEBCDICESA }
7763 { EBCDIC-ES-S csEBCDICESS }
7764 { EBCDIC-UK csEBCDICUK }
7765 { EBCDIC-US csEBCDICUS }
7766 { UNKNOWN-8BIT csUnknown8BiT }
7767 { MNEMONIC csMnemonic }
7772 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7773 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7774 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7775 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7776 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7777 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7778 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7779 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7780 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7781 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7782 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7783 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7784 { IBM1047 IBM-1047 }
7785 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7786 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7787 { UNICODE-1-1 csUnicode11 }
7790 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7791 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7793 { ISO-8859-15 ISO_8859-15 Latin-9 }
7794 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7795 { GBK CP936 MS936 windows-936 }
7796 { JIS_Encoding csJISEncoding }
7797 { Shift_JIS MS_Kanji csShiftJIS }
7798 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7800 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7801 { ISO-10646-UCS-Basic csUnicodeASCII }
7802 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7803 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7804 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7805 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7806 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7807 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7808 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7809 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7810 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7811 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7812 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7813 { Ventura-US csVenturaUS }
7814 { Ventura-International csVenturaInternational }
7815 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7816 { PC8-Turkish csPC8Turkish }
7817 { IBM-Symbols csIBMSymbols }
7818 { IBM-Thai csIBMThai }
7819 { HP-Legal csHPLegal }
7820 { HP-Pi-font csHPPiFont }
7821 { HP-Math8 csHPMath8 }
7822 { Adobe-Symbol-Encoding csHPPSMath }
7823 { HP-DeskTop csHPDesktop }
7824 { Ventura-Math csVenturaMath }
7825 { Microsoft-Publishing csMicrosoftPublishing }
7826 { Windows-31J csWindows31J }
7831 proc tcl_encoding {enc} {
7832 global encoding_aliases
7833 set names [encoding names]
7834 set lcnames [string tolower $names]
7835 set enc [string tolower $enc]
7836 set i [lsearch -exact $lcnames $enc]
7838 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7839 if {[regsub {^iso[-_]} $enc iso encx]} {
7840 set i [lsearch -exact $lcnames $encx]
7844 foreach l $encoding_aliases {
7845 set ll [string tolower $l]
7846 if {[lsearch -exact $ll $enc] < 0} continue
7847 # look through the aliases for one that tcl knows about
7849 set i [lsearch -exact $lcnames $e]
7851 if {[regsub {^iso[-_]} $e iso ex]} {
7852 set i [lsearch -exact $lcnames $ex]
7861 return [lindex $names $i]
7866 # First check that Tcl/Tk is recent enough
7867 if {[catch {package require Tk 8.4} err]} {
7868 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
7869 Gitk requires at least Tcl/Tk 8.4."
7875 set diffopts "-U 5 -p"
7876 set wrcomcmd "git diff-tree --stdin -p --pretty"
7880 set gitencoding [exec git config --get i18n.commitencoding]
7882 if {$gitencoding == ""} {
7883 set gitencoding "utf-8"
7885 set tclencoding [tcl_encoding $gitencoding]
7886 if {$tclencoding == {}} {
7887 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7890 set mainfont {Helvetica 9}
7891 set textfont {Courier 9}
7892 set uifont {Helvetica 9 bold}
7894 set findmergefiles 0
7902 set cmitmode "patch"
7903 set wrapcomment "none"
7907 set showlocalchanges 1
7909 set datetimeformat "%Y-%m-%d %H:%M:%S"
7911 set colors {green red blue magenta darkgrey brown orange}
7914 set diffcolors {red "#00a000" blue}
7916 set selectbgcolor gray85
7918 catch {source ~/.gitk}
7920 font create optionfont -family sans-serif -size -12
7922 # check that we can find a .git directory somewhere...
7923 if {[catch {set gitdir [gitdir]}]} {
7924 show_error {} . "Cannot find a git repository here."
7927 if {![file isdirectory $gitdir]} {
7928 show_error {} . "Cannot find the git directory \"$gitdir\"."
7934 set cmdline_files {}
7939 "-d" { set datemode 1 }
7942 lappend revtreeargs $arg
7945 set cmdline_files [lrange $argv [expr {$i + 1}] end]
7949 lappend revtreeargs $arg
7955 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7956 # no -- on command line, but some arguments (other than -d)
7958 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7959 set cmdline_files [split $f "\n"]
7960 set n [llength $cmdline_files]
7961 set revtreeargs [lrange $revtreeargs 0 end-$n]
7962 # Unfortunately git rev-parse doesn't produce an error when
7963 # something is both a revision and a filename. To be consistent
7964 # with git log and git rev-list, check revtreeargs for filenames.
7965 foreach arg $revtreeargs {
7966 if {[file exists $arg]} {
7967 show_error {} . "Ambiguous argument '$arg': both revision\
7973 # unfortunately we get both stdout and stderr in $err,
7974 # so look for "fatal:".
7975 set i [string first "fatal:" $err]
7977 set err [string range $err [expr {$i + 6}] end]
7979 show_error {} . "Bad arguments to gitk:\n$err"
7985 # find the list of unmerged files
7989 set fd [open "| git ls-files -u" r]
7991 show_error {} . "Couldn't get list of unmerged files: $err"
7994 while {[gets $fd line] >= 0} {
7995 set i [string first "\t" $line]
7996 if {$i < 0} continue
7997 set fname [string range $line [expr {$i+1}] end]
7998 if {[lsearch -exact $mlist $fname] >= 0} continue
8000 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8001 lappend mlist $fname
8006 if {$nr_unmerged == 0} {
8007 show_error {} . "No files selected: --merge specified but\
8008 no files are unmerged."
8010 show_error {} . "No files selected: --merge specified but\
8011 no unmerged files are within file limit."
8015 set cmdline_files $mlist
8018 set nullid "0000000000000000000000000000000000000000"
8019 set nullid2 "0000000000000000000000000000000000000001"
8027 set highlight_paths {}
8028 set searchdirn -forwards
8032 set markingmatches 0
8039 set selectedhlview None
8048 set lookingforhead 0
8054 # wait for the window to become visible
8056 wm title . "[file tail $argv0]: [file tail [pwd]]"
8059 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8060 # create a view for the files/dirs specified on the command line
8064 set viewname(1) "Command line"
8065 set viewfiles(1) $cmdline_files
8066 set viewargs(1) $revtreeargs
8069 .bar.view entryconf Edit* -state normal
8070 .bar.view entryconf Delete* -state normal
8073 if {[info exists permviews]} {
8074 foreach v $permviews {
8077 set viewname($n) [lindex $v 0]
8078 set viewfiles($n) [lindex $v 1]
8079 set viewargs($n) [lindex $v 2]