2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env(GIT_DIR)]} {
15 return [exec git rev-parse --git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
28 if {[info exists isonrunq($script)]} return
32 lappend runq [list {} $script]
33 set isonrunq($script) 1
36 proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
40 proc filereadable {fd script} {
43 fileevent $fd readable {}
47 lappend runq [list $fd $script]
53 set tstart [clock clicks -milliseconds]
56 set fd [lindex $runq 0 0]
57 set script [lindex $runq 0 1]
58 set repeat [eval $script]
59 set t1 [clock clicks -milliseconds]
60 set t [expr {$t1 - $t0}]
61 set runq [lrange $runq 1 end]
62 if {$repeat ne {} && $repeat} {
63 if {$fd eq {} || $repeat == 2} {
64 # script returns 1 if it wants to be readded
65 # file readers return 2 if they could do more straight away
66 lappend runq [list $fd $script]
68 fileevent $fd readable [list filereadable $fd $script]
70 } elseif {$fd eq {}} {
71 unset isonrunq($script)
74 if {$t1 - $tstart >= 80} break
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list {view} {
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx
86 global lookingforhead showlocalchanges
88 set startmsecs [clock clicks -milliseconds]
89 set commitidx($view) 0
90 set order "--topo-order"
92 set order "--date-order"
95 set fd [open [concat | git log -z --pretty=raw $order --parents \
96 --boundary $viewargs($view) "--" $viewfiles($view)] r]
98 error_popup "Error executing git rev-list: $err"
101 set commfd($view) $fd
102 set leftover($view) {}
103 set lookingforhead $showlocalchanges
104 fconfigure $fd -blocking 0 -translation lf -eofchar {}
105 if {$tclencoding != {}} {
106 fconfigure $fd -encoding $tclencoding
108 filerun $fd [list getcommitlines $fd $view]
112 proc stop_rev_list {} {
113 global commfd curview
115 if {![info exists commfd($curview)]} return
116 set fd $commfd($curview)
122 unset commfd($curview)
126 global phase canv mainfont curview
130 start_rev_list $curview
131 show_status "Reading commits..."
134 proc getcommitlines {fd view} {
136 global leftover commfd
137 global displayorder commitidx commitrow commitdata
138 global parentlist children curview hlview
139 global vparentlist vdisporder vcmitlisted
141 set stuff [read $fd 500000]
142 # git log doesn't terminate the last commit with a null...
143 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
153 # set it blocking so we wait for the process to terminate
154 fconfigure $fd -blocking 1
155 if {[catch {close $fd} err]} {
157 if {$view != $curview} {
158 set fv " for the \"$viewname($view)\" view"
160 if {[string range $err 0 4] == "usage"} {
161 set err "Gitk: error reading commits$fv:\
162 bad arguments to git rev-list."
163 if {$viewname($view) eq "Command line"} {
165 " (Note: arguments to gitk are passed to git rev-list\
166 to allow selection of commits to be displayed.)"
169 set err "Error reading commits$fv: $err"
173 if {$view == $curview} {
174 run chewcommits $view
181 set i [string first "\0" $stuff $start]
183 append leftover($view) [string range $stuff $start end]
187 set cmit $leftover($view)
188 append cmit [string range $stuff 0 [expr {$i - 1}]]
189 set leftover($view) {}
191 set cmit [string range $stuff $start [expr {$i - 1}]]
193 set start [expr {$i + 1}]
194 set j [string first "\n" $cmit]
197 if {$j >= 0 && [string match "commit *" $cmit]} {
198 set ids [string range $cmit 7 [expr {$j - 1}]]
199 if {[string match {[-<>]*} $ids]} {
200 switch -- [string index $ids 0] {
205 set ids [string range $ids 1 end]
209 if {[string length $id] != 40} {
217 if {[string length $shortcmit] > 80} {
218 set shortcmit "[string range $shortcmit 0 80]..."
220 error_popup "Can't parse git log output: {$shortcmit}"
223 set id [lindex $ids 0]
225 set olds [lrange $ids 1 end]
228 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
229 lappend children($view,$p) $id
236 if {![info exists children($view,$id)]} {
237 set children($view,$id) {}
239 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
240 set commitrow($view,$id) $commitidx($view)
241 incr commitidx($view)
242 if {$view == $curview} {
243 lappend parentlist $olds
244 lappend displayorder $id
245 lappend commitlisted $listed
247 lappend vparentlist($view) $olds
248 lappend vdisporder($view) $id
249 lappend vcmitlisted($view) $listed
254 run chewcommits $view
259 proc chewcommits {view} {
260 global curview hlview commfd
261 global selectedline pending_select
264 if {$view == $curview} {
265 set allread [expr {![info exists commfd($view)]}]
266 set tlimit [expr {[clock clicks -milliseconds] + 50}]
267 set more [layoutmore $tlimit $allread]
268 if {$allread && !$more} {
269 global displayorder commitidx phase
270 global numcommits startmsecs
272 if {[info exists pending_select]} {
273 set row [first_real_row]
276 if {$commitidx($curview) > 0} {
277 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
278 #puts "overall $ms ms for $numcommits commits"
280 show_status "No commits selected"
286 if {[info exists hlview] && $view == $hlview} {
292 proc readcommit {id} {
293 if {[catch {set contents [exec git cat-file commit $id]}]} return
294 parsecommit $id $contents 0
297 proc updatecommits {} {
298 global viewdata curview phase displayorder
299 global children commitrow selectedline thickerline showneartags
306 foreach id $displayorder {
307 catch {unset children($n,$id)}
308 catch {unset commitrow($n,$id)}
311 catch {unset selectedline}
312 catch {unset thickerline}
313 catch {unset viewdata($n)}
322 proc parsecommit {id contents listed} {
323 global commitinfo cdate
332 set hdrend [string first "\n\n" $contents]
334 # should never happen...
335 set hdrend [string length $contents]
337 set header [string range $contents 0 [expr {$hdrend - 1}]]
338 set comment [string range $contents [expr {$hdrend + 2}] end]
339 foreach line [split $header "\n"] {
340 set tag [lindex $line 0]
341 if {$tag == "author"} {
342 set audate [lindex $line end-1]
343 set auname [lrange $line 1 end-2]
344 } elseif {$tag == "committer"} {
345 set comdate [lindex $line end-1]
346 set comname [lrange $line 1 end-2]
350 # take the first non-blank line of the comment as the headline
351 set headline [string trimleft $comment]
352 set i [string first "\n" $headline]
354 set headline [string range $headline 0 $i]
356 set headline [string trimright $headline]
357 set i [string first "\r" $headline]
359 set headline [string trimright [string range $headline 0 $i]]
362 # git rev-list indents the comment by 4 spaces;
363 # if we got this via git cat-file, add the indentation
365 foreach line [split $comment "\n"] {
366 append newcomment " "
367 append newcomment $line
368 append newcomment "\n"
370 set comment $newcomment
372 if {$comdate != {}} {
373 set cdate($id) $comdate
375 set commitinfo($id) [list $headline $auname $audate \
376 $comname $comdate $comment]
379 proc getcommit {id} {
380 global commitdata commitinfo
382 if {[info exists commitdata($id)]} {
383 parsecommit $id $commitdata($id) 1
386 if {![info exists commitinfo($id)]} {
387 set commitinfo($id) {"No commit information available"}
394 global tagids idtags headids idheads tagobjid
395 global otherrefids idotherrefs mainhead mainheadid
397 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
400 set refd [open [list | git show-ref -d] r]
401 while {[gets $refd line] >= 0} {
402 if {[string index $line 40] ne " "} continue
403 set id [string range $line 0 39]
404 set ref [string range $line 41 end]
405 if {![string match "refs/*" $ref]} continue
406 set name [string range $ref 5 end]
407 if {[string match "remotes/*" $name]} {
408 if {![string match "*/HEAD" $name]} {
409 set headids($name) $id
410 lappend idheads($id) $name
412 } elseif {[string match "heads/*" $name]} {
413 set name [string range $name 6 end]
414 set headids($name) $id
415 lappend idheads($id) $name
416 } elseif {[string match "tags/*" $name]} {
417 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
418 # which is what we want since the former is the commit ID
419 set name [string range $name 5 end]
420 if {[string match "*^{}" $name]} {
421 set name [string range $name 0 end-3]
423 set tagobjid($name) $id
425 set tagids($name) $id
426 lappend idtags($id) $name
428 set otherrefids($name) $id
429 lappend idotherrefs($id) $name
436 set thehead [exec git symbolic-ref HEAD]
437 if {[string match "refs/heads/*" $thehead]} {
438 set mainhead [string range $thehead 11 end]
439 if {[info exists headids($mainhead)]} {
440 set mainheadid $headids($mainhead)
446 # skip over fake commits
447 proc first_real_row {} {
448 global nullid nullid2 displayorder numcommits
450 for {set row 0} {$row < $numcommits} {incr row} {
451 set id [lindex $displayorder $row]
452 if {$id ne $nullid && $id ne $nullid2} {
459 # update things for a head moved to a child of its previous location
460 proc movehead {id name} {
461 global headids idheads
463 removehead $headids($name) $name
464 set headids($name) $id
465 lappend idheads($id) $name
468 # update things when a head has been removed
469 proc removehead {id name} {
470 global headids idheads
472 if {$idheads($id) eq $name} {
475 set i [lsearch -exact $idheads($id) $name]
477 set idheads($id) [lreplace $idheads($id) $i $i]
483 proc show_error {w top msg} {
484 message $w.m -text $msg -justify center -aspect 400
485 pack $w.m -side top -fill x -padx 20 -pady 20
486 button $w.ok -text OK -command "destroy $top"
487 pack $w.ok -side bottom -fill x
488 bind $top <Visibility> "grab $top; focus $top"
489 bind $top <Key-Return> "destroy $top"
493 proc error_popup msg {
497 show_error $w $w $msg
500 proc confirm_popup msg {
506 message $w.m -text $msg -justify center -aspect 400
507 pack $w.m -side top -fill x -padx 20 -pady 20
508 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
509 pack $w.ok -side left -fill x
510 button $w.cancel -text Cancel -command "destroy $w"
511 pack $w.cancel -side right -fill x
512 bind $w <Visibility> "grab $w; focus $w"
518 global canv canv2 canv3 linespc charspc ctext cflist
519 global textfont mainfont uifont tabstop
520 global findtype findtypemenu findloc findstring fstring geometry
521 global entries sha1entry sha1string sha1but
522 global diffcontextstring diffcontext
523 global maincursor textcursor curtextcursor
524 global rowctxmenu fakerowmenu mergemax wrapcomment
525 global highlight_files gdttype
526 global searchstring sstring
527 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
531 .bar add cascade -label "File" -menu .bar.file
532 .bar configure -font $uifont
534 .bar.file add command -label "Update" -command updatecommits
535 .bar.file add command -label "Reread references" -command rereadrefs
536 .bar.file add command -label "Quit" -command doquit
537 .bar.file configure -font $uifont
539 .bar add cascade -label "Edit" -menu .bar.edit
540 .bar.edit add command -label "Preferences" -command doprefs
541 .bar.edit configure -font $uifont
543 menu .bar.view -font $uifont
544 .bar add cascade -label "View" -menu .bar.view
545 .bar.view add command -label "New view..." -command {newview 0}
546 .bar.view add command -label "Edit view..." -command editview \
548 .bar.view add command -label "Delete view" -command delview -state disabled
549 .bar.view add separator
550 .bar.view add radiobutton -label "All files" -command {showview 0} \
551 -variable selectedview -value 0
554 .bar add cascade -label "Help" -menu .bar.help
555 .bar.help add command -label "About gitk" -command about
556 .bar.help add command -label "Key bindings" -command keys
557 .bar.help configure -font $uifont
558 . configure -menu .bar
560 # the gui has upper and lower half, parts of a paned window.
561 panedwindow .ctop -orient vertical
563 # possibly use assumed geometry
564 if {![info exists geometry(pwsash0)]} {
565 set geometry(topheight) [expr {15 * $linespc}]
566 set geometry(topwidth) [expr {80 * $charspc}]
567 set geometry(botheight) [expr {15 * $linespc}]
568 set geometry(botwidth) [expr {50 * $charspc}]
569 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
570 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
573 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
574 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
576 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
578 # create three canvases
579 set cscroll .tf.histframe.csb
580 set canv .tf.histframe.pwclist.canv
582 -selectbackground $selectbgcolor \
583 -background $bgcolor -bd 0 \
584 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
585 .tf.histframe.pwclist add $canv
586 set canv2 .tf.histframe.pwclist.canv2
588 -selectbackground $selectbgcolor \
589 -background $bgcolor -bd 0 -yscrollincr $linespc
590 .tf.histframe.pwclist add $canv2
591 set canv3 .tf.histframe.pwclist.canv3
593 -selectbackground $selectbgcolor \
594 -background $bgcolor -bd 0 -yscrollincr $linespc
595 .tf.histframe.pwclist add $canv3
596 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
597 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
599 # a scroll bar to rule them
600 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
601 pack $cscroll -side right -fill y
602 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
603 lappend bglist $canv $canv2 $canv3
604 pack .tf.histframe.pwclist -fill both -expand 1 -side left
606 # we have two button bars at bottom of top frame. Bar 1
608 frame .tf.lbar -height 15
610 set sha1entry .tf.bar.sha1
611 set entries $sha1entry
612 set sha1but .tf.bar.sha1label
613 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
614 -command gotocommit -width 8 -font $uifont
615 $sha1but conf -disabledforeground [$sha1but cget -foreground]
616 pack .tf.bar.sha1label -side left
617 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
618 trace add variable sha1string write sha1change
619 pack $sha1entry -side left -pady 2
621 image create bitmap bm-left -data {
622 #define left_width 16
623 #define left_height 16
624 static unsigned char left_bits[] = {
625 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
626 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
627 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
629 image create bitmap bm-right -data {
630 #define right_width 16
631 #define right_height 16
632 static unsigned char right_bits[] = {
633 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
634 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
635 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
637 button .tf.bar.leftbut -image bm-left -command goback \
638 -state disabled -width 26
639 pack .tf.bar.leftbut -side left -fill y
640 button .tf.bar.rightbut -image bm-right -command goforw \
641 -state disabled -width 26
642 pack .tf.bar.rightbut -side left -fill y
644 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
645 pack .tf.bar.findbut -side left
647 set fstring .tf.bar.findstring
648 lappend entries $fstring
649 entry $fstring -width 30 -font $textfont -textvariable findstring
650 trace add variable findstring write find_change
651 pack $fstring -side left -expand 1 -fill x -in .tf.bar
653 set findtypemenu [tk_optionMenu .tf.bar.findtype \
654 findtype Exact IgnCase Regexp]
655 trace add variable findtype write find_change
656 .tf.bar.findtype configure -font $uifont
657 .tf.bar.findtype.menu configure -font $uifont
658 set findloc "All fields"
659 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
660 Comments Author Committer
661 trace add variable findloc write find_change
662 .tf.bar.findloc configure -font $uifont
663 .tf.bar.findloc.menu configure -font $uifont
664 pack .tf.bar.findloc -side right
665 pack .tf.bar.findtype -side right
667 # build up the bottom bar of upper window
668 label .tf.lbar.flabel -text "Highlight: Commits " \
670 pack .tf.lbar.flabel -side left -fill y
671 set gdttype "touching paths:"
672 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
673 "adding/removing string:"]
674 trace add variable gdttype write hfiles_change
675 $gm conf -font $uifont
676 .tf.lbar.gdttype conf -font $uifont
677 pack .tf.lbar.gdttype -side left -fill y
678 entry .tf.lbar.fent -width 25 -font $textfont \
679 -textvariable highlight_files
680 trace add variable highlight_files write hfiles_change
681 lappend entries .tf.lbar.fent
682 pack .tf.lbar.fent -side left -fill x -expand 1
683 label .tf.lbar.vlabel -text " OR in view" -font $uifont
684 pack .tf.lbar.vlabel -side left -fill y
685 global viewhlmenu selectedhlview
686 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
687 $viewhlmenu entryconf None -command delvhighlight
688 $viewhlmenu conf -font $uifont
689 .tf.lbar.vhl conf -font $uifont
690 pack .tf.lbar.vhl -side left -fill y
691 label .tf.lbar.rlabel -text " OR " -font $uifont
692 pack .tf.lbar.rlabel -side left -fill y
693 global highlight_related
694 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
695 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
696 $m conf -font $uifont
697 .tf.lbar.relm conf -font $uifont
698 trace add variable highlight_related write vrel_change
699 pack .tf.lbar.relm -side left -fill y
701 # Finish putting the upper half of the viewer together
702 pack .tf.lbar -in .tf -side bottom -fill x
703 pack .tf.bar -in .tf -side bottom -fill x
704 pack .tf.histframe -fill both -side top -expand 1
706 .ctop paneconfigure .tf -height $geometry(topheight)
707 .ctop paneconfigure .tf -width $geometry(topwidth)
709 # now build up the bottom
710 panedwindow .pwbottom -orient horizontal
712 # lower left, a text box over search bar, scroll bar to the right
713 # if we know window height, then that will set the lower text height, otherwise
714 # we set lower text height which will drive window height
715 if {[info exists geometry(main)]} {
716 frame .bleft -width $geometry(botwidth)
718 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
723 button .bleft.top.search -text "Search" -command dosearch \
725 pack .bleft.top.search -side left -padx 5
726 set sstring .bleft.top.sstring
727 entry $sstring -width 20 -font $textfont -textvariable searchstring
728 lappend entries $sstring
729 trace add variable searchstring write incrsearch
730 pack $sstring -side left -expand 1 -fill x
731 radiobutton .bleft.mid.diff -text "Diff" \
732 -command changediffdisp -variable diffelide -value {0 0}
733 radiobutton .bleft.mid.old -text "Old version" \
734 -command changediffdisp -variable diffelide -value {0 1}
735 radiobutton .bleft.mid.new -text "New version" \
736 -command changediffdisp -variable diffelide -value {1 0}
737 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
739 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
740 spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
741 -from 1 -increment 1 -to 10000000 \
742 -validate all -validatecommand "diffcontextvalidate %P" \
743 -textvariable diffcontextstring
744 .bleft.mid.diffcontext set $diffcontext
745 trace add variable diffcontextstring write diffcontextchange
746 lappend entries .bleft.mid.diffcontext
747 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
748 set ctext .bleft.ctext
749 text $ctext -background $bgcolor -foreground $fgcolor \
750 -tabs "[expr {$tabstop * $charspc}]" \
751 -state disabled -font $textfont \
752 -yscrollcommand scrolltext -wrap none
753 scrollbar .bleft.sb -command "$ctext yview"
754 pack .bleft.top -side top -fill x
755 pack .bleft.mid -side top -fill x
756 pack .bleft.sb -side right -fill y
757 pack $ctext -side left -fill both -expand 1
758 lappend bglist $ctext
759 lappend fglist $ctext
761 $ctext tag conf comment -wrap $wrapcomment
762 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
763 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
764 $ctext tag conf d0 -fore [lindex $diffcolors 0]
765 $ctext tag conf d1 -fore [lindex $diffcolors 1]
766 $ctext tag conf m0 -fore red
767 $ctext tag conf m1 -fore blue
768 $ctext tag conf m2 -fore green
769 $ctext tag conf m3 -fore purple
770 $ctext tag conf m4 -fore brown
771 $ctext tag conf m5 -fore "#009090"
772 $ctext tag conf m6 -fore magenta
773 $ctext tag conf m7 -fore "#808000"
774 $ctext tag conf m8 -fore "#009000"
775 $ctext tag conf m9 -fore "#ff0080"
776 $ctext tag conf m10 -fore cyan
777 $ctext tag conf m11 -fore "#b07070"
778 $ctext tag conf m12 -fore "#70b0f0"
779 $ctext tag conf m13 -fore "#70f0b0"
780 $ctext tag conf m14 -fore "#f0b070"
781 $ctext tag conf m15 -fore "#ff70b0"
782 $ctext tag conf mmax -fore darkgrey
784 $ctext tag conf mresult -font [concat $textfont bold]
785 $ctext tag conf msep -font [concat $textfont bold]
786 $ctext tag conf found -back yellow
789 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
794 radiobutton .bright.mode.patch -text "Patch" \
795 -command reselectline -variable cmitmode -value "patch"
796 .bright.mode.patch configure -font $uifont
797 radiobutton .bright.mode.tree -text "Tree" \
798 -command reselectline -variable cmitmode -value "tree"
799 .bright.mode.tree configure -font $uifont
800 grid .bright.mode.patch .bright.mode.tree -sticky ew
801 pack .bright.mode -side top -fill x
802 set cflist .bright.cfiles
803 set indent [font measure $mainfont "nn"]
805 -selectbackground $selectbgcolor \
806 -background $bgcolor -foreground $fgcolor \
808 -tabs [list $indent [expr {2 * $indent}]] \
809 -yscrollcommand ".bright.sb set" \
810 -cursor [. cget -cursor] \
811 -spacing1 1 -spacing3 1
812 lappend bglist $cflist
813 lappend fglist $cflist
814 scrollbar .bright.sb -command "$cflist yview"
815 pack .bright.sb -side right -fill y
816 pack $cflist -side left -fill both -expand 1
817 $cflist tag configure highlight \
818 -background [$cflist cget -selectbackground]
819 $cflist tag configure bold -font [concat $mainfont bold]
821 .pwbottom add .bright
824 # restore window position if known
825 if {[info exists geometry(main)]} {
826 wm geometry . "$geometry(main)"
829 if {[tk windowingsystem] eq {aqua}} {
835 bind .pwbottom <Configure> {resizecdetpanes %W %w}
836 pack .ctop -fill both -expand 1
837 bindall <1> {selcanvline %W %x %y}
838 #bindall <B1-Motion> {selcanvline %W %x %y}
839 if {[tk windowingsystem] == "win32"} {
840 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
841 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
843 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
844 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
846 bindall <2> "canvscan mark %W %x %y"
847 bindall <B2-Motion> "canvscan dragto %W %x %y"
848 bindkey <Home> selfirstline
849 bindkey <End> sellastline
850 bind . <Key-Up> "selnextline -1"
851 bind . <Key-Down> "selnextline 1"
852 bind . <Shift-Key-Up> "next_highlight -1"
853 bind . <Shift-Key-Down> "next_highlight 1"
854 bindkey <Key-Right> "goforw"
855 bindkey <Key-Left> "goback"
856 bind . <Key-Prior> "selnextpage -1"
857 bind . <Key-Next> "selnextpage 1"
858 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
859 bind . <$M1B-End> "allcanvs yview moveto 1.0"
860 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
861 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
862 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
863 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
864 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
865 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
866 bindkey <Key-space> "$ctext yview scroll 1 pages"
867 bindkey p "selnextline -1"
868 bindkey n "selnextline 1"
871 bindkey i "selnextline -1"
872 bindkey k "selnextline 1"
875 bindkey b "$ctext yview scroll -1 pages"
876 bindkey d "$ctext yview scroll 18 units"
877 bindkey u "$ctext yview scroll -18 units"
878 bindkey / {findnext 1}
879 bindkey <Key-Return> {findnext 0}
882 bindkey <F5> updatecommits
883 bind . <$M1B-q> doquit
884 bind . <$M1B-f> dofind
885 bind . <$M1B-g> {findnext 0}
886 bind . <$M1B-r> dosearchback
887 bind . <$M1B-s> dosearch
888 bind . <$M1B-equal> {incrfont 1}
889 bind . <$M1B-KP_Add> {incrfont 1}
890 bind . <$M1B-minus> {incrfont -1}
891 bind . <$M1B-KP_Subtract> {incrfont -1}
892 wm protocol . WM_DELETE_WINDOW doquit
893 bind . <Button-1> "click %W"
894 bind $fstring <Key-Return> dofind
895 bind $sha1entry <Key-Return> gotocommit
896 bind $sha1entry <<PasteSelection>> clearsha1
897 bind $cflist <1> {sel_flist %W %x %y; break}
898 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
899 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
900 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
902 set maincursor [. cget -cursor]
903 set textcursor [$ctext cget -cursor]
904 set curtextcursor $textcursor
906 set rowctxmenu .rowctxmenu
907 menu $rowctxmenu -tearoff 0
908 $rowctxmenu add command -label "Diff this -> selected" \
909 -command {diffvssel 0}
910 $rowctxmenu add command -label "Diff selected -> this" \
911 -command {diffvssel 1}
912 $rowctxmenu add command -label "Make patch" -command mkpatch
913 $rowctxmenu add command -label "Create tag" -command mktag
914 $rowctxmenu add command -label "Write commit to file" -command writecommit
915 $rowctxmenu add command -label "Create new branch" -command mkbranch
916 $rowctxmenu add command -label "Cherry-pick this commit" \
918 $rowctxmenu add command -label "Reset HEAD branch to here" \
921 set fakerowmenu .fakerowmenu
922 menu $fakerowmenu -tearoff 0
923 $fakerowmenu add command -label "Diff this -> selected" \
924 -command {diffvssel 0}
925 $fakerowmenu add command -label "Diff selected -> this" \
926 -command {diffvssel 1}
927 $fakerowmenu add command -label "Make patch" -command mkpatch
928 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
929 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
930 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
932 set headctxmenu .headctxmenu
933 menu $headctxmenu -tearoff 0
934 $headctxmenu add command -label "Check out this branch" \
936 $headctxmenu add command -label "Remove this branch" \
940 set flist_menu .flistctxmenu
941 menu $flist_menu -tearoff 0
942 $flist_menu add command -label "Highlight this too" \
943 -command {flist_hl 0}
944 $flist_menu add command -label "Highlight this only" \
945 -command {flist_hl 1}
948 # Windows sends all mouse wheel events to the current focused window, not
949 # the one where the mouse hovers, so bind those events here and redirect
950 # to the correct window
951 proc windows_mousewheel_redirector {W X Y D} {
952 global canv canv2 canv3
953 set w [winfo containing -displayof $W $X $Y]
955 set u [expr {$D < 0 ? 5 : -5}]
956 if {$w == $canv || $w == $canv2 || $w == $canv3} {
957 allcanvs yview scroll $u units
960 $w yview scroll $u units
966 # mouse-2 makes all windows scan vertically, but only the one
967 # the cursor is in scans horizontally
968 proc canvscan {op w x y} {
969 global canv canv2 canv3
970 foreach c [list $canv $canv2 $canv3] {
979 proc scrollcanv {cscroll f0 f1} {
985 # when we make a key binding for the toplevel, make sure
986 # it doesn't get triggered when that key is pressed in the
987 # find string entry widget.
988 proc bindkey {ev script} {
991 set escript [bind Entry $ev]
992 if {$escript == {}} {
993 set escript [bind Entry <Key>]
996 bind $e $ev "$escript; break"
1000 # set the focus back to the toplevel for any click outside
1003 global ctext entries
1004 foreach e [concat $entries $ctext] {
1005 if {$w == $e} return
1010 proc savestuff {w} {
1011 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1012 global stuffsaved findmergefiles maxgraphpct
1013 global maxwidth showneartags showlocalchanges
1014 global viewname viewfiles viewargs viewperm nextviewnum
1015 global cmitmode wrapcomment datetimeformat
1016 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1018 if {$stuffsaved} return
1019 if {![winfo viewable .]} return
1021 set f [open "~/.gitk-new" w]
1022 puts $f [list set mainfont $mainfont]
1023 puts $f [list set textfont $textfont]
1024 puts $f [list set uifont $uifont]
1025 puts $f [list set tabstop $tabstop]
1026 puts $f [list set findmergefiles $findmergefiles]
1027 puts $f [list set maxgraphpct $maxgraphpct]
1028 puts $f [list set maxwidth $maxwidth]
1029 puts $f [list set cmitmode $cmitmode]
1030 puts $f [list set wrapcomment $wrapcomment]
1031 puts $f [list set showneartags $showneartags]
1032 puts $f [list set showlocalchanges $showlocalchanges]
1033 puts $f [list set datetimeformat $datetimeformat]
1034 puts $f [list set bgcolor $bgcolor]
1035 puts $f [list set fgcolor $fgcolor]
1036 puts $f [list set colors $colors]
1037 puts $f [list set diffcolors $diffcolors]
1038 puts $f [list set diffcontext $diffcontext]
1039 puts $f [list set selectbgcolor $selectbgcolor]
1041 puts $f "set geometry(main) [wm geometry .]"
1042 puts $f "set geometry(topwidth) [winfo width .tf]"
1043 puts $f "set geometry(topheight) [winfo height .tf]"
1044 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1045 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1046 puts $f "set geometry(botwidth) [winfo width .bleft]"
1047 puts $f "set geometry(botheight) [winfo height .bleft]"
1049 puts -nonewline $f "set permviews {"
1050 for {set v 0} {$v < $nextviewnum} {incr v} {
1051 if {$viewperm($v)} {
1052 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1057 file rename -force "~/.gitk-new" "~/.gitk"
1062 proc resizeclistpanes {win w} {
1064 if {[info exists oldwidth($win)]} {
1065 set s0 [$win sash coord 0]
1066 set s1 [$win sash coord 1]
1068 set sash0 [expr {int($w/2 - 2)}]
1069 set sash1 [expr {int($w*5/6 - 2)}]
1071 set factor [expr {1.0 * $w / $oldwidth($win)}]
1072 set sash0 [expr {int($factor * [lindex $s0 0])}]
1073 set sash1 [expr {int($factor * [lindex $s1 0])}]
1077 if {$sash1 < $sash0 + 20} {
1078 set sash1 [expr {$sash0 + 20}]
1080 if {$sash1 > $w - 10} {
1081 set sash1 [expr {$w - 10}]
1082 if {$sash0 > $sash1 - 20} {
1083 set sash0 [expr {$sash1 - 20}]
1087 $win sash place 0 $sash0 [lindex $s0 1]
1088 $win sash place 1 $sash1 [lindex $s1 1]
1090 set oldwidth($win) $w
1093 proc resizecdetpanes {win w} {
1095 if {[info exists oldwidth($win)]} {
1096 set s0 [$win sash coord 0]
1098 set sash0 [expr {int($w*3/4 - 2)}]
1100 set factor [expr {1.0 * $w / $oldwidth($win)}]
1101 set sash0 [expr {int($factor * [lindex $s0 0])}]
1105 if {$sash0 > $w - 15} {
1106 set sash0 [expr {$w - 15}]
1109 $win sash place 0 $sash0 [lindex $s0 1]
1111 set oldwidth($win) $w
1114 proc allcanvs args {
1115 global canv canv2 canv3
1121 proc bindall {event action} {
1122 global canv canv2 canv3
1123 bind $canv $event $action
1124 bind $canv2 $event $action
1125 bind $canv3 $event $action
1131 if {[winfo exists $w]} {
1136 wm title $w "About gitk"
1137 message $w.m -text {
1138 Gitk - a commit viewer for git
1140 Copyright © 2005-2006 Paul Mackerras
1142 Use and redistribute under the terms of the GNU General Public License} \
1143 -justify center -aspect 400 -border 2 -bg white -relief groove
1144 pack $w.m -side top -fill x -padx 2 -pady 2
1145 $w.m configure -font $uifont
1146 button $w.ok -text Close -command "destroy $w" -default active
1147 pack $w.ok -side bottom
1148 $w.ok configure -font $uifont
1149 bind $w <Visibility> "focus $w.ok"
1150 bind $w <Key-Escape> "destroy $w"
1151 bind $w <Key-Return> "destroy $w"
1157 if {[winfo exists $w]} {
1161 if {[tk windowingsystem] eq {aqua}} {
1167 wm title $w "Gitk key bindings"
1168 message $w.m -text "
1172 <Home> Move to first commit
1173 <End> Move to last commit
1174 <Up>, p, i Move up one commit
1175 <Down>, n, k Move down one commit
1176 <Left>, z, j Go back in history list
1177 <Right>, x, l Go forward in history list
1178 <PageUp> Move up one page in commit list
1179 <PageDown> Move down one page in commit list
1180 <$M1T-Home> Scroll to top of commit list
1181 <$M1T-End> Scroll to bottom of commit list
1182 <$M1T-Up> Scroll commit list up one line
1183 <$M1T-Down> Scroll commit list down one line
1184 <$M1T-PageUp> Scroll commit list up one page
1185 <$M1T-PageDown> Scroll commit list down one page
1186 <Shift-Up> Move to previous highlighted line
1187 <Shift-Down> Move to next highlighted line
1188 <Delete>, b Scroll diff view up one page
1189 <Backspace> Scroll diff view up one page
1190 <Space> Scroll diff view down one page
1191 u Scroll diff view up 18 lines
1192 d Scroll diff view down 18 lines
1194 <$M1T-G> Move to next find hit
1195 <Return> Move to next find hit
1196 / Move to next find hit, or redo find
1197 ? Move to previous find hit
1198 f Scroll diff view to next file
1199 <$M1T-S> Search for next hit in diff view
1200 <$M1T-R> Search for previous hit in diff view
1201 <$M1T-KP+> Increase font size
1202 <$M1T-plus> Increase font size
1203 <$M1T-KP-> Decrease font size
1204 <$M1T-minus> Decrease font size
1207 -justify left -bg white -border 2 -relief groove
1208 pack $w.m -side top -fill both -padx 2 -pady 2
1209 $w.m configure -font $uifont
1210 button $w.ok -text Close -command "destroy $w" -default active
1211 pack $w.ok -side bottom
1212 $w.ok configure -font $uifont
1213 bind $w <Visibility> "focus $w.ok"
1214 bind $w <Key-Escape> "destroy $w"
1215 bind $w <Key-Return> "destroy $w"
1218 # Procedures for manipulating the file list window at the
1219 # bottom right of the overall window.
1221 proc treeview {w l openlevs} {
1222 global treecontents treediropen treeheight treeparent treeindex
1232 set treecontents() {}
1233 $w conf -state normal
1235 while {[string range $f 0 $prefixend] ne $prefix} {
1236 if {$lev <= $openlevs} {
1237 $w mark set e:$treeindex($prefix) "end -1c"
1238 $w mark gravity e:$treeindex($prefix) left
1240 set treeheight($prefix) $ht
1241 incr ht [lindex $htstack end]
1242 set htstack [lreplace $htstack end end]
1243 set prefixend [lindex $prefendstack end]
1244 set prefendstack [lreplace $prefendstack end end]
1245 set prefix [string range $prefix 0 $prefixend]
1248 set tail [string range $f [expr {$prefixend+1}] end]
1249 while {[set slash [string first "/" $tail]] >= 0} {
1252 lappend prefendstack $prefixend
1253 incr prefixend [expr {$slash + 1}]
1254 set d [string range $tail 0 $slash]
1255 lappend treecontents($prefix) $d
1256 set oldprefix $prefix
1258 set treecontents($prefix) {}
1259 set treeindex($prefix) [incr ix]
1260 set treeparent($prefix) $oldprefix
1261 set tail [string range $tail [expr {$slash+1}] end]
1262 if {$lev <= $openlevs} {
1264 set treediropen($prefix) [expr {$lev < $openlevs}]
1265 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1266 $w mark set d:$ix "end -1c"
1267 $w mark gravity d:$ix left
1269 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1271 $w image create end -align center -image $bm -padx 1 \
1273 $w insert end $d [highlight_tag $prefix]
1274 $w mark set s:$ix "end -1c"
1275 $w mark gravity s:$ix left
1280 if {$lev <= $openlevs} {
1283 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1285 $w insert end $tail [highlight_tag $f]
1287 lappend treecontents($prefix) $tail
1290 while {$htstack ne {}} {
1291 set treeheight($prefix) $ht
1292 incr ht [lindex $htstack end]
1293 set htstack [lreplace $htstack end end]
1294 set prefixend [lindex $prefendstack end]
1295 set prefendstack [lreplace $prefendstack end end]
1296 set prefix [string range $prefix 0 $prefixend]
1298 $w conf -state disabled
1301 proc linetoelt {l} {
1302 global treeheight treecontents
1307 foreach e $treecontents($prefix) {
1312 if {[string index $e end] eq "/"} {
1313 set n $treeheight($prefix$e)
1325 proc highlight_tree {y prefix} {
1326 global treeheight treecontents cflist
1328 foreach e $treecontents($prefix) {
1330 if {[highlight_tag $path] ne {}} {
1331 $cflist tag add bold $y.0 "$y.0 lineend"
1334 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1335 set y [highlight_tree $y $path]
1341 proc treeclosedir {w dir} {
1342 global treediropen treeheight treeparent treeindex
1344 set ix $treeindex($dir)
1345 $w conf -state normal
1346 $w delete s:$ix e:$ix
1347 set treediropen($dir) 0
1348 $w image configure a:$ix -image tri-rt
1349 $w conf -state disabled
1350 set n [expr {1 - $treeheight($dir)}]
1351 while {$dir ne {}} {
1352 incr treeheight($dir) $n
1353 set dir $treeparent($dir)
1357 proc treeopendir {w dir} {
1358 global treediropen treeheight treeparent treecontents treeindex
1360 set ix $treeindex($dir)
1361 $w conf -state normal
1362 $w image configure a:$ix -image tri-dn
1363 $w mark set e:$ix s:$ix
1364 $w mark gravity e:$ix right
1367 set n [llength $treecontents($dir)]
1368 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1371 incr treeheight($x) $n
1373 foreach e $treecontents($dir) {
1375 if {[string index $e end] eq "/"} {
1376 set iy $treeindex($de)
1377 $w mark set d:$iy e:$ix
1378 $w mark gravity d:$iy left
1379 $w insert e:$ix $str
1380 set treediropen($de) 0
1381 $w image create e:$ix -align center -image tri-rt -padx 1 \
1383 $w insert e:$ix $e [highlight_tag $de]
1384 $w mark set s:$iy e:$ix
1385 $w mark gravity s:$iy left
1386 set treeheight($de) 1
1388 $w insert e:$ix $str
1389 $w insert e:$ix $e [highlight_tag $de]
1392 $w mark gravity e:$ix left
1393 $w conf -state disabled
1394 set treediropen($dir) 1
1395 set top [lindex [split [$w index @0,0] .] 0]
1396 set ht [$w cget -height]
1397 set l [lindex [split [$w index s:$ix] .] 0]
1400 } elseif {$l + $n + 1 > $top + $ht} {
1401 set top [expr {$l + $n + 2 - $ht}]
1409 proc treeclick {w x y} {
1410 global treediropen cmitmode ctext cflist cflist_top
1412 if {$cmitmode ne "tree"} return
1413 if {![info exists cflist_top]} return
1414 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1415 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1416 $cflist tag add highlight $l.0 "$l.0 lineend"
1422 set e [linetoelt $l]
1423 if {[string index $e end] ne "/"} {
1425 } elseif {$treediropen($e)} {
1432 proc setfilelist {id} {
1433 global treefilelist cflist
1435 treeview $cflist $treefilelist($id) 0
1438 image create bitmap tri-rt -background black -foreground blue -data {
1439 #define tri-rt_width 13
1440 #define tri-rt_height 13
1441 static unsigned char tri-rt_bits[] = {
1442 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1443 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1446 #define tri-rt-mask_width 13
1447 #define tri-rt-mask_height 13
1448 static unsigned char tri-rt-mask_bits[] = {
1449 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1450 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1453 image create bitmap tri-dn -background black -foreground blue -data {
1454 #define tri-dn_width 13
1455 #define tri-dn_height 13
1456 static unsigned char tri-dn_bits[] = {
1457 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1458 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1461 #define tri-dn-mask_width 13
1462 #define tri-dn-mask_height 13
1463 static unsigned char tri-dn-mask_bits[] = {
1464 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1465 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1469 proc init_flist {first} {
1470 global cflist cflist_top selectedline difffilestart
1472 $cflist conf -state normal
1473 $cflist delete 0.0 end
1475 $cflist insert end $first
1477 $cflist tag add highlight 1.0 "1.0 lineend"
1479 catch {unset cflist_top}
1481 $cflist conf -state disabled
1482 set difffilestart {}
1485 proc highlight_tag {f} {
1486 global highlight_paths
1488 foreach p $highlight_paths {
1489 if {[string match $p $f]} {
1496 proc highlight_filelist {} {
1497 global cmitmode cflist
1499 $cflist conf -state normal
1500 if {$cmitmode ne "tree"} {
1501 set end [lindex [split [$cflist index end] .] 0]
1502 for {set l 2} {$l < $end} {incr l} {
1503 set line [$cflist get $l.0 "$l.0 lineend"]
1504 if {[highlight_tag $line] ne {}} {
1505 $cflist tag add bold $l.0 "$l.0 lineend"
1511 $cflist conf -state disabled
1514 proc unhighlight_filelist {} {
1517 $cflist conf -state normal
1518 $cflist tag remove bold 1.0 end
1519 $cflist conf -state disabled
1522 proc add_flist {fl} {
1525 $cflist conf -state normal
1527 $cflist insert end "\n"
1528 $cflist insert end $f [highlight_tag $f]
1530 $cflist conf -state disabled
1533 proc sel_flist {w x y} {
1534 global ctext difffilestart cflist cflist_top cmitmode
1536 if {$cmitmode eq "tree"} return
1537 if {![info exists cflist_top]} return
1538 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1539 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1540 $cflist tag add highlight $l.0 "$l.0 lineend"
1545 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1549 proc pop_flist_menu {w X Y x y} {
1550 global ctext cflist cmitmode flist_menu flist_menu_file
1551 global treediffs diffids
1553 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1555 if {$cmitmode eq "tree"} {
1556 set e [linetoelt $l]
1557 if {[string index $e end] eq "/"} return
1559 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1561 set flist_menu_file $e
1562 tk_popup $flist_menu $X $Y
1565 proc flist_hl {only} {
1566 global flist_menu_file highlight_files
1568 set x [shellquote $flist_menu_file]
1569 if {$only || $highlight_files eq {}} {
1570 set highlight_files $x
1572 append highlight_files " " $x
1576 # Functions for adding and removing shell-type quoting
1578 proc shellquote {str} {
1579 if {![string match "*\['\"\\ \t]*" $str]} {
1582 if {![string match "*\['\"\\]*" $str]} {
1585 if {![string match "*'*" $str]} {
1588 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1591 proc shellarglist {l} {
1597 append str [shellquote $a]
1602 proc shelldequote {str} {
1607 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1608 append ret [string range $str $used end]
1609 set used [string length $str]
1612 set first [lindex $first 0]
1613 set ch [string index $str $first]
1614 if {$first > $used} {
1615 append ret [string range $str $used [expr {$first - 1}]]
1618 if {$ch eq " " || $ch eq "\t"} break
1621 set first [string first "'" $str $used]
1623 error "unmatched single-quote"
1625 append ret [string range $str $used [expr {$first - 1}]]
1630 if {$used >= [string length $str]} {
1631 error "trailing backslash"
1633 append ret [string index $str $used]
1638 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1639 error "unmatched double-quote"
1641 set first [lindex $first 0]
1642 set ch [string index $str $first]
1643 if {$first > $used} {
1644 append ret [string range $str $used [expr {$first - 1}]]
1647 if {$ch eq "\""} break
1649 append ret [string index $str $used]
1653 return [list $used $ret]
1656 proc shellsplit {str} {
1659 set str [string trimleft $str]
1660 if {$str eq {}} break
1661 set dq [shelldequote $str]
1662 set n [lindex $dq 0]
1663 set word [lindex $dq 1]
1664 set str [string range $str $n end]
1670 # Code to implement multiple views
1672 proc newview {ishighlight} {
1673 global nextviewnum newviewname newviewperm uifont newishighlight
1674 global newviewargs revtreeargs
1676 set newishighlight $ishighlight
1678 if {[winfo exists $top]} {
1682 set newviewname($nextviewnum) "View $nextviewnum"
1683 set newviewperm($nextviewnum) 0
1684 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1685 vieweditor $top $nextviewnum "Gitk view definition"
1690 global viewname viewperm newviewname newviewperm
1691 global viewargs newviewargs
1693 set top .gitkvedit-$curview
1694 if {[winfo exists $top]} {
1698 set newviewname($curview) $viewname($curview)
1699 set newviewperm($curview) $viewperm($curview)
1700 set newviewargs($curview) [shellarglist $viewargs($curview)]
1701 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1704 proc vieweditor {top n title} {
1705 global newviewname newviewperm viewfiles
1709 wm title $top $title
1710 label $top.nl -text "Name" -font $uifont
1711 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1712 grid $top.nl $top.name -sticky w -pady 5
1713 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1715 grid $top.perm - -pady 5 -sticky w
1716 message $top.al -aspect 1000 -font $uifont \
1717 -text "Commits to include (arguments to git rev-list):"
1718 grid $top.al - -sticky w -pady 5
1719 entry $top.args -width 50 -textvariable newviewargs($n) \
1720 -background white -font $uifont
1721 grid $top.args - -sticky ew -padx 5
1722 message $top.l -aspect 1000 -font $uifont \
1723 -text "Enter files and directories to include, one per line:"
1724 grid $top.l - -sticky w
1725 text $top.t -width 40 -height 10 -background white -font $uifont
1726 if {[info exists viewfiles($n)]} {
1727 foreach f $viewfiles($n) {
1728 $top.t insert end $f
1729 $top.t insert end "\n"
1731 $top.t delete {end - 1c} end
1732 $top.t mark set insert 0.0
1734 grid $top.t - -sticky ew -padx 5
1736 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1738 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1740 grid $top.buts.ok $top.buts.can
1741 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1742 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1743 grid $top.buts - -pady 10 -sticky ew
1747 proc doviewmenu {m first cmd op argv} {
1748 set nmenu [$m index end]
1749 for {set i $first} {$i <= $nmenu} {incr i} {
1750 if {[$m entrycget $i -command] eq $cmd} {
1751 eval $m $op $i $argv
1757 proc allviewmenus {n op args} {
1760 doviewmenu .bar.view 5 [list showview $n] $op $args
1761 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1764 proc newviewok {top n} {
1765 global nextviewnum newviewperm newviewname newishighlight
1766 global viewname viewfiles viewperm selectedview curview
1767 global viewargs newviewargs viewhlmenu
1770 set newargs [shellsplit $newviewargs($n)]
1772 error_popup "Error in commit selection arguments: $err"
1778 foreach f [split [$top.t get 0.0 end] "\n"] {
1779 set ft [string trim $f]
1784 if {![info exists viewfiles($n)]} {
1785 # creating a new view
1787 set viewname($n) $newviewname($n)
1788 set viewperm($n) $newviewperm($n)
1789 set viewfiles($n) $files
1790 set viewargs($n) $newargs
1792 if {!$newishighlight} {
1795 run addvhighlight $n
1798 # editing an existing view
1799 set viewperm($n) $newviewperm($n)
1800 if {$newviewname($n) ne $viewname($n)} {
1801 set viewname($n) $newviewname($n)
1802 doviewmenu .bar.view 5 [list showview $n] \
1803 entryconf [list -label $viewname($n)]
1804 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1805 entryconf [list -label $viewname($n) -value $viewname($n)]
1807 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1808 set viewfiles($n) $files
1809 set viewargs($n) $newargs
1810 if {$curview == $n} {
1815 catch {destroy $top}
1819 global curview viewdata viewperm hlview selectedhlview
1821 if {$curview == 0} return
1822 if {[info exists hlview] && $hlview == $curview} {
1823 set selectedhlview None
1826 allviewmenus $curview delete
1827 set viewdata($curview) {}
1828 set viewperm($curview) 0
1832 proc addviewmenu {n} {
1833 global viewname viewhlmenu
1835 .bar.view add radiobutton -label $viewname($n) \
1836 -command [list showview $n] -variable selectedview -value $n
1837 $viewhlmenu add radiobutton -label $viewname($n) \
1838 -command [list addvhighlight $n] -variable selectedhlview
1841 proc flatten {var} {
1845 foreach i [array names $var] {
1846 lappend ret $i [set $var\($i\)]
1851 proc unflatten {var l} {
1861 global curview viewdata viewfiles
1862 global displayorder parentlist rowidlist rowoffsets
1863 global colormap rowtextx commitrow nextcolor canvxmax
1864 global numcommits rowrangelist commitlisted idrowranges rowchk
1865 global selectedline currentid canv canvy0
1867 global pending_select phase
1868 global commitidx rowlaidout rowoptim
1870 global selectedview selectfirst
1871 global vparentlist vdisporder vcmitlisted
1872 global hlview selectedhlview
1874 if {$n == $curview} return
1876 if {[info exists selectedline]} {
1877 set selid $currentid
1878 set y [yc $selectedline]
1879 set ymax [lindex [$canv cget -scrollregion] 3]
1880 set span [$canv yview]
1881 set ytop [expr {[lindex $span 0] * $ymax}]
1882 set ybot [expr {[lindex $span 1] * $ymax}]
1883 if {$ytop < $y && $y < $ybot} {
1884 set yscreen [expr {$y - $ytop}]
1886 set yscreen [expr {($ybot - $ytop) / 2}]
1888 } elseif {[info exists pending_select]} {
1889 set selid $pending_select
1890 unset pending_select
1894 if {$curview >= 0} {
1895 set vparentlist($curview) $parentlist
1896 set vdisporder($curview) $displayorder
1897 set vcmitlisted($curview) $commitlisted
1899 set viewdata($curview) \
1900 [list $phase $rowidlist $rowoffsets $rowrangelist \
1901 [flatten idrowranges] [flatten idinlist] \
1902 $rowlaidout $rowoptim $numcommits]
1903 } elseif {![info exists viewdata($curview)]
1904 || [lindex $viewdata($curview) 0] ne {}} {
1905 set viewdata($curview) \
1906 [list {} $rowidlist $rowoffsets $rowrangelist]
1909 catch {unset treediffs}
1911 if {[info exists hlview] && $hlview == $n} {
1913 set selectedhlview None
1918 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1919 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1921 if {![info exists viewdata($n)]} {
1923 set pending_select $selid
1930 set phase [lindex $v 0]
1931 set displayorder $vdisporder($n)
1932 set parentlist $vparentlist($n)
1933 set commitlisted $vcmitlisted($n)
1934 set rowidlist [lindex $v 1]
1935 set rowoffsets [lindex $v 2]
1936 set rowrangelist [lindex $v 3]
1938 set numcommits [llength $displayorder]
1939 catch {unset idrowranges}
1941 unflatten idrowranges [lindex $v 4]
1942 unflatten idinlist [lindex $v 5]
1943 set rowlaidout [lindex $v 6]
1944 set rowoptim [lindex $v 7]
1945 set numcommits [lindex $v 8]
1946 catch {unset rowchk}
1949 catch {unset colormap}
1950 catch {unset rowtextx}
1952 set canvxmax [$canv cget -width]
1959 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1960 set row $commitrow($n,$selid)
1961 # try to get the selected row in the same position on the screen
1962 set ymax [lindex [$canv cget -scrollregion] 3]
1963 set ytop [expr {[yc $row] - $yscreen}]
1967 set yf [expr {$ytop * 1.0 / $ymax}]
1969 allcanvs yview moveto $yf
1973 } elseif {$selid ne {}} {
1974 set pending_select $selid
1976 set row [first_real_row]
1977 if {$row < $numcommits} {
1984 if {$phase eq "getcommits"} {
1985 show_status "Reading commits..."
1988 } elseif {$numcommits == 0} {
1989 show_status "No commits selected"
1993 # Stuff relating to the highlighting facility
1995 proc ishighlighted {row} {
1996 global vhighlights fhighlights nhighlights rhighlights
1998 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1999 return $nhighlights($row)
2001 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2002 return $vhighlights($row)
2004 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2005 return $fhighlights($row)
2007 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2008 return $rhighlights($row)
2013 proc bolden {row font} {
2014 global canv linehtag selectedline boldrows
2016 lappend boldrows $row
2017 $canv itemconf $linehtag($row) -font $font
2018 if {[info exists selectedline] && $row == $selectedline} {
2020 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2021 -outline {{}} -tags secsel \
2022 -fill [$canv cget -selectbackground]]
2027 proc bolden_name {row font} {
2028 global canv2 linentag selectedline boldnamerows
2030 lappend boldnamerows $row
2031 $canv2 itemconf $linentag($row) -font $font
2032 if {[info exists selectedline] && $row == $selectedline} {
2033 $canv2 delete secsel
2034 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2035 -outline {{}} -tags secsel \
2036 -fill [$canv2 cget -selectbackground]]
2042 global mainfont boldrows
2045 foreach row $boldrows {
2046 if {![ishighlighted $row]} {
2047 bolden $row $mainfont
2049 lappend stillbold $row
2052 set boldrows $stillbold
2055 proc addvhighlight {n} {
2056 global hlview curview viewdata vhl_done vhighlights commitidx
2058 if {[info exists hlview]} {
2062 if {$n != $curview && ![info exists viewdata($n)]} {
2063 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
2064 set vparentlist($n) {}
2065 set vdisporder($n) {}
2066 set vcmitlisted($n) {}
2069 set vhl_done $commitidx($hlview)
2070 if {$vhl_done > 0} {
2075 proc delvhighlight {} {
2076 global hlview vhighlights
2078 if {![info exists hlview]} return
2080 catch {unset vhighlights}
2084 proc vhighlightmore {} {
2085 global hlview vhl_done commitidx vhighlights
2086 global displayorder vdisporder curview mainfont
2088 set font [concat $mainfont bold]
2089 set max $commitidx($hlview)
2090 if {$hlview == $curview} {
2091 set disp $displayorder
2093 set disp $vdisporder($hlview)
2095 set vr [visiblerows]
2096 set r0 [lindex $vr 0]
2097 set r1 [lindex $vr 1]
2098 for {set i $vhl_done} {$i < $max} {incr i} {
2099 set id [lindex $disp $i]
2100 if {[info exists commitrow($curview,$id)]} {
2101 set row $commitrow($curview,$id)
2102 if {$r0 <= $row && $row <= $r1} {
2103 if {![highlighted $row]} {
2106 set vhighlights($row) 1
2113 proc askvhighlight {row id} {
2114 global hlview vhighlights commitrow iddrawn mainfont
2116 if {[info exists commitrow($hlview,$id)]} {
2117 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2118 bolden $row [concat $mainfont bold]
2120 set vhighlights($row) 1
2122 set vhighlights($row) 0
2126 proc hfiles_change {name ix op} {
2127 global highlight_files filehighlight fhighlights fh_serial
2128 global mainfont highlight_paths
2130 if {[info exists filehighlight]} {
2131 # delete previous highlights
2132 catch {close $filehighlight}
2134 catch {unset fhighlights}
2136 unhighlight_filelist
2138 set highlight_paths {}
2139 after cancel do_file_hl $fh_serial
2141 if {$highlight_files ne {}} {
2142 after 300 do_file_hl $fh_serial
2146 proc makepatterns {l} {
2149 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2150 if {[string index $ee end] eq "/"} {
2160 proc do_file_hl {serial} {
2161 global highlight_files filehighlight highlight_paths gdttype fhl_list
2163 if {$gdttype eq "touching paths:"} {
2164 if {[catch {set paths [shellsplit $highlight_files]}]} return
2165 set highlight_paths [makepatterns $paths]
2167 set gdtargs [concat -- $paths]
2169 set gdtargs [list "-S$highlight_files"]
2171 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2172 set filehighlight [open $cmd r+]
2173 fconfigure $filehighlight -blocking 0
2174 filerun $filehighlight readfhighlight
2180 proc flushhighlights {} {
2181 global filehighlight fhl_list
2183 if {[info exists filehighlight]} {
2185 puts $filehighlight ""
2186 flush $filehighlight
2190 proc askfilehighlight {row id} {
2191 global filehighlight fhighlights fhl_list
2193 lappend fhl_list $id
2194 set fhighlights($row) -1
2195 puts $filehighlight $id
2198 proc readfhighlight {} {
2199 global filehighlight fhighlights commitrow curview mainfont iddrawn
2202 if {![info exists filehighlight]} {
2206 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2207 set line [string trim $line]
2208 set i [lsearch -exact $fhl_list $line]
2209 if {$i < 0} continue
2210 for {set j 0} {$j < $i} {incr j} {
2211 set id [lindex $fhl_list $j]
2212 if {[info exists commitrow($curview,$id)]} {
2213 set fhighlights($commitrow($curview,$id)) 0
2216 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2217 if {$line eq {}} continue
2218 if {![info exists commitrow($curview,$line)]} continue
2219 set row $commitrow($curview,$line)
2220 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2221 bolden $row [concat $mainfont bold]
2223 set fhighlights($row) 1
2225 if {[eof $filehighlight]} {
2227 puts "oops, git diff-tree died"
2228 catch {close $filehighlight}
2236 proc find_change {name ix op} {
2237 global nhighlights mainfont boldnamerows
2238 global findstring findpattern findtype
2240 # delete previous highlights, if any
2241 foreach row $boldnamerows {
2242 bolden_name $row $mainfont
2245 catch {unset nhighlights}
2248 if {$findtype ne "Regexp"} {
2249 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2251 set findpattern "*$e*"
2256 proc doesmatch {f} {
2257 global findtype findstring findpattern
2259 if {$findtype eq "Regexp"} {
2260 return [regexp $findstring $f]
2261 } elseif {$findtype eq "IgnCase"} {
2262 return [string match -nocase $findpattern $f]
2264 return [string match $findpattern $f]
2268 proc askfindhighlight {row id} {
2269 global nhighlights commitinfo iddrawn mainfont
2271 global markingmatches
2273 if {![info exists commitinfo($id)]} {
2276 set info $commitinfo($id)
2278 set fldtypes {Headline Author Date Committer CDate Comments}
2279 foreach f $info ty $fldtypes {
2280 if {($findloc eq "All fields" || $findloc eq $ty) &&
2282 if {$ty eq "Author"} {
2289 if {$isbold && [info exists iddrawn($id)]} {
2290 set f [concat $mainfont bold]
2291 if {![ishighlighted $row]} {
2297 if {$markingmatches} {
2298 markrowmatches $row $id
2301 set nhighlights($row) $isbold
2304 proc markrowmatches {row id} {
2305 global canv canv2 linehtag linentag commitinfo findloc
2307 set headline [lindex $commitinfo($id) 0]
2308 set author [lindex $commitinfo($id) 1]
2309 $canv delete match$row
2310 $canv2 delete match$row
2311 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2312 set m [findmatches $headline]
2314 markmatches $canv $row $headline $linehtag($row) $m \
2315 [$canv itemcget $linehtag($row) -font] $row
2318 if {$findloc eq "All fields" || $findloc eq "Author"} {
2319 set m [findmatches $author]
2321 markmatches $canv2 $row $author $linentag($row) $m \
2322 [$canv2 itemcget $linentag($row) -font] $row
2327 proc vrel_change {name ix op} {
2328 global highlight_related
2331 if {$highlight_related ne "None"} {
2336 # prepare for testing whether commits are descendents or ancestors of a
2337 proc rhighlight_sel {a} {
2338 global descendent desc_todo ancestor anc_todo
2339 global highlight_related rhighlights
2341 catch {unset descendent}
2342 set desc_todo [list $a]
2343 catch {unset ancestor}
2344 set anc_todo [list $a]
2345 if {$highlight_related ne "None"} {
2351 proc rhighlight_none {} {
2354 catch {unset rhighlights}
2358 proc is_descendent {a} {
2359 global curview children commitrow descendent desc_todo
2362 set la $commitrow($v,$a)
2366 for {set i 0} {$i < [llength $todo]} {incr i} {
2367 set do [lindex $todo $i]
2368 if {$commitrow($v,$do) < $la} {
2369 lappend leftover $do
2372 foreach nk $children($v,$do) {
2373 if {![info exists descendent($nk)]} {
2374 set descendent($nk) 1
2382 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2386 set descendent($a) 0
2387 set desc_todo $leftover
2390 proc is_ancestor {a} {
2391 global curview parentlist commitrow ancestor anc_todo
2394 set la $commitrow($v,$a)
2398 for {set i 0} {$i < [llength $todo]} {incr i} {
2399 set do [lindex $todo $i]
2400 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2401 lappend leftover $do
2404 foreach np [lindex $parentlist $commitrow($v,$do)] {
2405 if {![info exists ancestor($np)]} {
2414 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2419 set anc_todo $leftover
2422 proc askrelhighlight {row id} {
2423 global descendent highlight_related iddrawn mainfont rhighlights
2424 global selectedline ancestor
2426 if {![info exists selectedline]} return
2428 if {$highlight_related eq "Descendent" ||
2429 $highlight_related eq "Not descendent"} {
2430 if {![info exists descendent($id)]} {
2433 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2436 } elseif {$highlight_related eq "Ancestor" ||
2437 $highlight_related eq "Not ancestor"} {
2438 if {![info exists ancestor($id)]} {
2441 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2445 if {[info exists iddrawn($id)]} {
2446 if {$isbold && ![ishighlighted $row]} {
2447 bolden $row [concat $mainfont bold]
2450 set rhighlights($row) $isbold
2453 proc next_hlcont {} {
2454 global fhl_row fhl_dirn displayorder numcommits
2455 global vhighlights fhighlights nhighlights rhighlights
2456 global hlview filehighlight findstring highlight_related
2458 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2461 if {$row < 0 || $row >= $numcommits} {
2466 set id [lindex $displayorder $row]
2467 if {[info exists hlview]} {
2468 if {![info exists vhighlights($row)]} {
2469 askvhighlight $row $id
2471 if {$vhighlights($row) > 0} break
2473 if {$findstring ne {}} {
2474 if {![info exists nhighlights($row)]} {
2475 askfindhighlight $row $id
2477 if {$nhighlights($row) > 0} break
2479 if {$highlight_related ne "None"} {
2480 if {![info exists rhighlights($row)]} {
2481 askrelhighlight $row $id
2483 if {$rhighlights($row) > 0} break
2485 if {[info exists filehighlight]} {
2486 if {![info exists fhighlights($row)]} {
2487 # ask for a few more while we're at it...
2489 for {set n 0} {$n < 100} {incr n} {
2490 if {![info exists fhighlights($r)]} {
2491 askfilehighlight $r [lindex $displayorder $r]
2494 if {$r < 0 || $r >= $numcommits} break
2498 if {$fhighlights($row) < 0} {
2502 if {$fhighlights($row) > 0} break
2510 proc next_highlight {dirn} {
2511 global selectedline fhl_row fhl_dirn
2512 global hlview filehighlight findstring highlight_related
2514 if {![info exists selectedline]} return
2515 if {!([info exists hlview] || $findstring ne {} ||
2516 $highlight_related ne "None" || [info exists filehighlight])} return
2517 set fhl_row [expr {$selectedline + $dirn}]
2522 proc cancel_next_highlight {} {
2528 # Graph layout functions
2530 proc shortids {ids} {
2533 if {[llength $id] > 1} {
2534 lappend res [shortids $id]
2535 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2536 lappend res [string range $id 0 7]
2544 proc incrange {l x o} {
2547 set e [lindex $l $x]
2549 lset l $x [expr {$e + $o}]
2558 for {} {$n > 0} {incr n -1} {
2564 proc usedinrange {id l1 l2} {
2565 global children commitrow curview
2567 if {[info exists commitrow($curview,$id)]} {
2568 set r $commitrow($curview,$id)
2569 if {$l1 <= $r && $r <= $l2} {
2570 return [expr {$r - $l1 + 1}]
2573 set kids $children($curview,$id)
2575 set r $commitrow($curview,$c)
2576 if {$l1 <= $r && $r <= $l2} {
2577 return [expr {$r - $l1 + 1}]
2583 proc sanity {row {full 0}} {
2584 global rowidlist rowoffsets
2587 set ids [lindex $rowidlist $row]
2590 if {$id eq {}} continue
2591 if {$col < [llength $ids] - 1 &&
2592 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2593 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2595 set o [lindex $rowoffsets $row $col]
2601 if {[lindex $rowidlist $y $x] != $id} {
2602 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2603 puts " id=[shortids $id] check started at row $row"
2604 for {set i $row} {$i >= $y} {incr i -1} {
2605 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2610 set o [lindex $rowoffsets $y $x]
2615 proc makeuparrow {oid x y z} {
2616 global rowidlist rowoffsets uparrowlen idrowranges displayorder
2618 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2621 set off0 [lindex $rowoffsets $y]
2622 for {set x0 $x} {1} {incr x0} {
2623 if {$x0 >= [llength $off0]} {
2624 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2627 set z [lindex $off0 $x0]
2633 set z [expr {$x0 - $x}]
2634 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2635 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2637 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2638 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2639 lappend idrowranges($oid) [lindex $displayorder $y]
2642 proc initlayout {} {
2643 global rowidlist rowoffsets displayorder commitlisted
2644 global rowlaidout rowoptim
2645 global idinlist rowchk rowrangelist idrowranges
2646 global numcommits canvxmax canv
2649 global colormap rowtextx
2660 catch {unset idinlist}
2661 catch {unset rowchk}
2664 set canvxmax [$canv cget -width]
2665 catch {unset colormap}
2666 catch {unset rowtextx}
2667 catch {unset idrowranges}
2671 proc setcanvscroll {} {
2672 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2674 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2675 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2676 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2677 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2680 proc visiblerows {} {
2681 global canv numcommits linespc
2683 set ymax [lindex [$canv cget -scrollregion] 3]
2684 if {$ymax eq {} || $ymax == 0} return
2686 set y0 [expr {int([lindex $f 0] * $ymax)}]
2687 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2691 set y1 [expr {int([lindex $f 1] * $ymax)}]
2692 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2693 if {$r1 >= $numcommits} {
2694 set r1 [expr {$numcommits - 1}]
2696 return [list $r0 $r1]
2699 proc layoutmore {tmax allread} {
2700 global rowlaidout rowoptim commitidx numcommits optim_delay
2701 global uparrowlen curview rowidlist idinlist
2704 set showdelay $optim_delay
2705 set optdelay [expr {$uparrowlen + 1}]
2707 if {$rowoptim - $showdelay > $numcommits} {
2708 showstuff [expr {$rowoptim - $showdelay}] $showlast
2709 } elseif {$rowlaidout - $optdelay > $rowoptim} {
2710 set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2714 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2716 } elseif {$commitidx($curview) > $rowlaidout} {
2717 set nr [expr {$commitidx($curview) - $rowlaidout}]
2718 # may need to increase this threshold if uparrowlen or
2719 # mingaplen are increased...
2724 set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2725 if {$rowlaidout == $row} {
2728 } elseif {$allread} {
2730 set nrows $commitidx($curview)
2731 if {[lindex $rowidlist $nrows] ne {} ||
2732 [array names idinlist] ne {}} {
2734 set rowlaidout $commitidx($curview)
2735 } elseif {$rowoptim == $nrows} {
2738 if {$numcommits == $nrows} {
2745 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2751 proc showstuff {canshow last} {
2752 global numcommits commitrow pending_select selectedline curview
2753 global lookingforhead mainheadid displayorder selectfirst
2754 global lastscrollset
2756 if {$numcommits == 0} {
2758 set phase "incrdraw"
2762 set prev $numcommits
2763 set numcommits $canshow
2764 set t [clock clicks -milliseconds]
2765 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2766 set lastscrollset $t
2769 set rows [visiblerows]
2770 set r1 [lindex $rows 1]
2771 if {$r1 >= $canshow} {
2772 set r1 [expr {$canshow - 1}]
2777 if {[info exists pending_select] &&
2778 [info exists commitrow($curview,$pending_select)] &&
2779 $commitrow($curview,$pending_select) < $numcommits} {
2780 selectline $commitrow($curview,$pending_select) 1
2783 if {[info exists selectedline] || [info exists pending_select]} {
2786 set l [first_real_row]
2791 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2792 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2793 set lookingforhead 0
2798 proc doshowlocalchanges {} {
2799 global lookingforhead curview mainheadid phase commitrow
2801 if {[info exists commitrow($curview,$mainheadid)] &&
2802 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2804 } elseif {$phase ne {}} {
2805 set lookingforhead 1
2809 proc dohidelocalchanges {} {
2810 global lookingforhead localfrow localirow lserial
2812 set lookingforhead 0
2813 if {$localfrow >= 0} {
2814 removerow $localfrow
2816 if {$localirow > 0} {
2820 if {$localirow >= 0} {
2821 removerow $localirow
2827 # spawn off a process to do git diff-index --cached HEAD
2828 proc dodiffindex {} {
2829 global localirow localfrow lserial
2834 set fd [open "|git diff-index --cached HEAD" r]
2835 fconfigure $fd -blocking 0
2836 filerun $fd [list readdiffindex $fd $lserial]
2839 proc readdiffindex {fd serial} {
2840 global localirow commitrow mainheadid nullid2 curview
2841 global commitinfo commitdata lserial
2844 if {[gets $fd line] < 0} {
2850 # we only need to see one line and we don't really care what it says...
2853 # now see if there are any local changes not checked in to the index
2854 if {$serial == $lserial} {
2855 set fd [open "|git diff-files" r]
2856 fconfigure $fd -blocking 0
2857 filerun $fd [list readdifffiles $fd $serial]
2860 if {$isdiff && $serial == $lserial && $localirow == -1} {
2861 # add the line for the changes in the index to the graph
2862 set localirow $commitrow($curview,$mainheadid)
2863 set hl "Local changes checked in to index but not committed"
2864 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2865 set commitdata($nullid2) "\n $hl\n"
2866 insertrow $localirow $nullid2
2871 proc readdifffiles {fd serial} {
2872 global localirow localfrow commitrow mainheadid nullid curview
2873 global commitinfo commitdata lserial
2876 if {[gets $fd line] < 0} {
2882 # we only need to see one line and we don't really care what it says...
2885 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2886 # add the line for the local diff to the graph
2887 if {$localirow >= 0} {
2888 set localfrow $localirow
2891 set localfrow $commitrow($curview,$mainheadid)
2893 set hl "Local uncommitted changes, not checked in to index"
2894 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2895 set commitdata($nullid) "\n $hl\n"
2896 insertrow $localfrow $nullid
2901 proc layoutrows {row endrow last} {
2902 global rowidlist rowoffsets displayorder
2903 global uparrowlen downarrowlen maxwidth mingaplen
2904 global children parentlist
2906 global commitidx curview
2907 global idinlist rowchk rowrangelist
2909 set idlist [lindex $rowidlist $row]
2910 set offs [lindex $rowoffsets $row]
2911 while {$row < $endrow} {
2912 set id [lindex $displayorder $row]
2913 set nev [expr {[llength $idlist] - $maxwidth + 1}]
2914 foreach p [lindex $parentlist $row] {
2915 if {![info exists idinlist($p)] || !$idinlist($p)} {
2921 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2922 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2923 set i [lindex $idlist $x]
2924 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2925 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2926 [expr {$row + $uparrowlen + $mingaplen}]]
2928 set idlist [lreplace $idlist $x $x]
2929 set offs [lreplace $offs $x $x]
2930 set offs [incrange $offs $x 1]
2932 set rm1 [expr {$row - 1}]
2933 lappend idrowranges($i) [lindex $displayorder $rm1]
2934 if {[incr nev -1] <= 0} break
2937 set rowchk($i) [expr {$row + $r}]
2940 lset rowidlist $row $idlist
2941 lset rowoffsets $row $offs
2945 foreach p [lindex $parentlist $row] {
2946 if {![info exists idinlist($p)]} {
2948 } elseif {!$idinlist($p)} {
2953 set col [lsearch -exact $idlist $id]
2955 set col [llength $idlist]
2957 lset rowidlist $row $idlist
2959 if {$children($curview,$id) ne {}} {
2960 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2964 lset rowoffsets $row $offs
2966 makeuparrow $id $col $row $z
2972 if {[info exists idrowranges($id)]} {
2973 set ranges $idrowranges($id)
2975 unset idrowranges($id)
2977 lappend rowrangelist $ranges
2979 set offs [ntimes [llength $idlist] 0]
2980 set l [llength $newolds]
2981 set idlist [eval lreplace \$idlist $col $col $newolds]
2984 set offs [lrange $offs 0 [expr {$col - 1}]]
2985 foreach x $newolds {
2990 set tmp [expr {[llength $idlist] - [llength $offs]}]
2992 set offs [concat $offs [ntimes $tmp $o]]
2997 foreach i $newolds {
2998 set idrowranges($i) $id
3001 foreach oid $oldolds {
3002 set idlist [linsert $idlist $col $oid]
3003 set offs [linsert $offs $col $o]
3004 makeuparrow $oid $col $row $o
3007 lappend rowidlist $idlist
3008 lappend rowoffsets $offs
3013 proc addextraid {id row} {
3014 global displayorder commitrow commitinfo
3015 global commitidx commitlisted
3016 global parentlist children curview
3018 incr commitidx($curview)
3019 lappend displayorder $id
3020 lappend commitlisted 0
3021 lappend parentlist {}
3022 set commitrow($curview,$id) $row
3024 if {![info exists commitinfo($id)]} {
3025 set commitinfo($id) {"No commit information available"}
3027 if {![info exists children($curview,$id)]} {
3028 set children($curview,$id) {}
3032 proc layouttail {} {
3033 global rowidlist rowoffsets idinlist commitidx curview
3034 global idrowranges rowrangelist
3036 set row $commitidx($curview)
3037 set idlist [lindex $rowidlist $row]
3038 while {$idlist ne {}} {
3039 set col [expr {[llength $idlist] - 1}]
3040 set id [lindex $idlist $col]
3042 catch {unset idinlist($id)}
3043 lappend idrowranges($id) $id
3044 lappend rowrangelist $idrowranges($id)
3045 unset idrowranges($id)
3047 set offs [ntimes $col 0]
3048 set idlist [lreplace $idlist $col $col]
3049 lappend rowidlist $idlist
3050 lappend rowoffsets $offs
3053 foreach id [array names idinlist] {
3056 lset rowidlist $row [list $id]
3057 lset rowoffsets $row 0
3058 makeuparrow $id 0 $row 0
3059 lappend idrowranges($id) $id
3060 lappend rowrangelist $idrowranges($id)
3061 unset idrowranges($id)
3063 lappend rowidlist {}
3064 lappend rowoffsets {}
3068 proc insert_pad {row col npad} {
3069 global rowidlist rowoffsets
3071 set pad [ntimes $npad {}]
3072 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
3073 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
3074 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
3077 proc optimize_rows {row col endrow} {
3078 global rowidlist rowoffsets displayorder
3080 for {} {$row < $endrow} {incr row} {
3081 set idlist [lindex $rowidlist $row]
3082 set offs [lindex $rowoffsets $row]
3084 for {} {$col < [llength $offs]} {incr col} {
3085 if {[lindex $idlist $col] eq {}} {
3089 set z [lindex $offs $col]
3090 if {$z eq {}} continue
3092 set x0 [expr {$col + $z}]
3093 set y0 [expr {$row - 1}]
3094 set z0 [lindex $rowoffsets $y0 $x0]
3096 set id [lindex $idlist $col]
3097 set ranges [rowranges $id]
3098 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
3102 # Looking at lines from this row to the previous row,
3103 # make them go straight up if they end in an arrow on
3104 # the previous row; otherwise make them go straight up
3106 if {$z < -1 || ($z < 0 && $isarrow)} {
3107 # Line currently goes left too much;
3108 # insert pads in the previous row, then optimize it
3109 set npad [expr {-1 - $z + $isarrow}]
3110 set offs [incrange $offs $col $npad]
3111 insert_pad $y0 $x0 $npad
3113 optimize_rows $y0 $x0 $row
3115 set z [lindex $offs $col]
3116 set x0 [expr {$col + $z}]
3117 set z0 [lindex $rowoffsets $y0 $x0]
3118 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3119 # Line currently goes right too much;
3120 # insert pads in this line and adjust the next's rowoffsets
3121 set npad [expr {$z - 1 + $isarrow}]
3122 set y1 [expr {$row + 1}]
3123 set offs2 [lindex $rowoffsets $y1]
3127 if {$z eq {} || $x1 + $z < $col} continue
3128 if {$x1 + $z > $col} {
3131 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
3134 set pad [ntimes $npad {}]
3135 set idlist [eval linsert \$idlist $col $pad]
3136 set tmp [eval linsert \$offs $col $pad]
3138 set offs [incrange $tmp $col [expr {-$npad}]]
3139 set z [lindex $offs $col]
3142 if {$z0 eq {} && !$isarrow} {
3143 # this line links to its first child on row $row-2
3144 set rm2 [expr {$row - 2}]
3145 set id [lindex $displayorder $rm2]
3146 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
3148 set z0 [expr {$xc - $x0}]
3151 # avoid lines jigging left then immediately right
3152 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3153 insert_pad $y0 $x0 1
3154 set offs [incrange $offs $col 1]
3155 optimize_rows $y0 [expr {$x0 + 1}] $row
3160 # Find the first column that doesn't have a line going right
3161 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3162 set o [lindex $offs $col]
3164 # check if this is the link to the first child
3165 set id [lindex $idlist $col]
3166 set ranges [rowranges $id]
3167 if {$ranges ne {} && $row == [lindex $ranges 0]} {
3168 # it is, work out offset to child
3169 set y0 [expr {$row - 1}]
3170 set id [lindex $displayorder $y0]
3171 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3173 set o [expr {$x0 - $col}]
3177 if {$o eq {} || $o <= 0} break
3179 # Insert a pad at that column as long as it has a line and
3180 # isn't the last column, and adjust the next row' offsets
3181 if {$o ne {} && [incr col] < [llength $idlist]} {
3182 set y1 [expr {$row + 1}]
3183 set offs2 [lindex $rowoffsets $y1]
3187 if {$z eq {} || $x1 + $z < $col} continue
3188 lset rowoffsets $y1 [incrange $offs2 $x1 1]
3191 set idlist [linsert $idlist $col {}]
3192 set tmp [linsert $offs $col {}]
3194 set offs [incrange $tmp $col -1]
3197 lset rowidlist $row $idlist
3198 lset rowoffsets $row $offs
3204 global canvx0 linespc
3205 return [expr {$canvx0 + $col * $linespc}]
3209 global canvy0 linespc
3210 return [expr {$canvy0 + $row * $linespc}]
3213 proc linewidth {id} {
3214 global thickerline lthickness
3217 if {[info exists thickerline] && $id eq $thickerline} {
3218 set wid [expr {2 * $lthickness}]
3223 proc rowranges {id} {
3224 global phase idrowranges commitrow rowlaidout rowrangelist curview
3228 ([info exists commitrow($curview,$id)]
3229 && $commitrow($curview,$id) < $rowlaidout)} {
3230 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3231 } elseif {[info exists idrowranges($id)]} {
3232 set ranges $idrowranges($id)
3235 foreach rid $ranges {
3236 lappend linenos $commitrow($curview,$rid)
3238 if {$linenos ne {}} {
3239 lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3244 # work around tk8.4 refusal to draw arrows on diagonal segments
3245 proc adjarrowhigh {coords} {
3248 set x0 [lindex $coords 0]
3249 set x1 [lindex $coords 2]
3251 set y0 [lindex $coords 1]
3252 set y1 [lindex $coords 3]
3253 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3254 # we have a nearby vertical segment, just trim off the diag bit
3255 set coords [lrange $coords 2 end]
3257 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3258 set xi [expr {$x0 - $slope * $linespc / 2}]
3259 set yi [expr {$y0 - $linespc / 2}]
3260 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3266 proc drawlineseg {id row endrow arrowlow} {
3267 global rowidlist displayorder iddrawn linesegs
3268 global canv colormap linespc curview maxlinelen
3270 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3271 set le [expr {$row + 1}]
3274 set c [lsearch -exact [lindex $rowidlist $le] $id]
3280 set x [lindex $displayorder $le]
3285 if {[info exists iddrawn($x)] || $le == $endrow} {
3286 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3302 if {[info exists linesegs($id)]} {
3303 set lines $linesegs($id)
3305 set r0 [lindex $li 0]
3307 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3317 set li [lindex $lines [expr {$i-1}]]
3318 set r1 [lindex $li 1]
3319 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3324 set x [lindex $cols [expr {$le - $row}]]
3325 set xp [lindex $cols [expr {$le - 1 - $row}]]
3326 set dir [expr {$xp - $x}]
3328 set ith [lindex $lines $i 2]
3329 set coords [$canv coords $ith]
3330 set ah [$canv itemcget $ith -arrow]
3331 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3332 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3333 if {$x2 ne {} && $x - $x2 == $dir} {
3334 set coords [lrange $coords 0 end-2]
3337 set coords [list [xc $le $x] [yc $le]]
3340 set itl [lindex $lines [expr {$i-1}] 2]
3341 set al [$canv itemcget $itl -arrow]
3342 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3343 } elseif {$arrowlow &&
3344 [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3347 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3348 for {set y $le} {[incr y -1] > $row} {} {
3350 set xp [lindex $cols [expr {$y - 1 - $row}]]
3351 set ndir [expr {$xp - $x}]
3352 if {$dir != $ndir || $xp < 0} {
3353 lappend coords [xc $y $x] [yc $y]
3359 # join parent line to first child
3360 set ch [lindex $displayorder $row]
3361 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3363 puts "oops: drawlineseg: child $ch not on row $row"
3366 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3367 } elseif {$xc > $x + 1} {
3368 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3372 lappend coords [xc $row $x] [yc $row]
3374 set xn [xc $row $xp]
3376 # work around tk8.4 refusal to draw arrows on diagonal segments
3377 if {$arrowlow && $xn != [lindex $coords end-1]} {
3378 if {[llength $coords] < 4 ||
3379 [lindex $coords end-3] != [lindex $coords end-1] ||
3380 [lindex $coords end] - $yn > 2 * $linespc} {
3381 set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3382 set yo [yc [expr {$row + 0.5}]]
3383 lappend coords $xn $yo $xn $yn
3386 lappend coords $xn $yn
3391 set coords [adjarrowhigh $coords]
3394 set t [$canv create line $coords -width [linewidth $id] \
3395 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3398 set lines [linsert $lines $i [list $row $le $t]]
3400 $canv coords $ith $coords
3401 if {$arrow ne $ah} {
3402 $canv itemconf $ith -arrow $arrow
3404 lset lines $i 0 $row
3407 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3408 set ndir [expr {$xo - $xp}]
3409 set clow [$canv coords $itl]
3410 if {$dir == $ndir} {
3411 set clow [lrange $clow 2 end]
3413 set coords [concat $coords $clow]
3415 lset lines [expr {$i-1}] 1 $le
3417 set coords [adjarrowhigh $coords]
3420 # coalesce two pieces
3422 set b [lindex $lines [expr {$i-1}] 0]
3423 set e [lindex $lines $i 1]
3424 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3426 $canv coords $itl $coords
3427 if {$arrow ne $al} {
3428 $canv itemconf $itl -arrow $arrow
3432 set linesegs($id) $lines
3436 proc drawparentlinks {id row} {
3437 global rowidlist canv colormap curview parentlist
3440 set rowids [lindex $rowidlist $row]
3441 set col [lsearch -exact $rowids $id]
3442 if {$col < 0} return
3443 set olds [lindex $parentlist $row]
3444 set row2 [expr {$row + 1}]
3445 set x [xc $row $col]
3448 set ids [lindex $rowidlist $row2]
3449 # rmx = right-most X coord used
3452 set i [lsearch -exact $ids $p]
3454 puts "oops, parent $p of $id not in list"
3457 set x2 [xc $row2 $i]
3461 if {[lsearch -exact $rowids $p] < 0} {
3462 # drawlineseg will do this one for us
3466 # should handle duplicated parents here...
3467 set coords [list $x $y]
3468 if {$i < $col - 1} {
3469 lappend coords [xc $row [expr {$i + 1}]] $y
3470 } elseif {$i > $col + 1} {
3471 lappend coords [xc $row [expr {$i - 1}]] $y
3473 lappend coords $x2 $y2
3474 set t [$canv create line $coords -width [linewidth $p] \
3475 -fill $colormap($p) -tags lines.$p]
3479 if {$rmx > [lindex $idpos($id) 1]} {
3480 lset idpos($id) 1 $rmx
3485 proc drawlines {id} {
3488 $canv itemconf lines.$id -width [linewidth $id]
3491 proc drawcmittext {id row col} {
3492 global linespc canv canv2 canv3 canvy0 fgcolor curview
3493 global commitlisted commitinfo rowidlist parentlist
3494 global rowtextx idpos idtags idheads idotherrefs
3495 global linehtag linentag linedtag
3496 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3498 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3499 set listed [lindex $commitlisted $row]
3500 if {$id eq $nullid} {
3502 } elseif {$id eq $nullid2} {
3505 set ofill [expr {$listed != 0? "blue": "white"}]
3507 set x [xc $row $col]
3509 set orad [expr {$linespc / 3}]
3511 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3512 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3513 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3514 } elseif {$listed == 2} {
3515 # triangle pointing left for left-side commits
3516 set t [$canv create polygon \
3517 [expr {$x - $orad}] $y \
3518 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3519 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3520 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3522 # triangle pointing right for right-side commits
3523 set t [$canv create polygon \
3524 [expr {$x + $orad - 1}] $y \
3525 [expr {$x - $orad}] [expr {$y - $orad}] \
3526 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3527 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3530 $canv bind $t <1> {selcanvline {} %x %y}
3531 set rmx [llength [lindex $rowidlist $row]]
3532 set olds [lindex $parentlist $row]
3534 set nextids [lindex $rowidlist [expr {$row + 1}]]
3536 set i [lsearch -exact $nextids $p]
3542 set xt [xc $row $rmx]
3543 set rowtextx($row) $xt
3544 set idpos($id) [list $x $xt $y]
3545 if {[info exists idtags($id)] || [info exists idheads($id)]
3546 || [info exists idotherrefs($id)]} {
3547 set xt [drawtags $id $x $xt $y]
3549 set headline [lindex $commitinfo($id) 0]
3550 set name [lindex $commitinfo($id) 1]
3551 set date [lindex $commitinfo($id) 2]
3552 set date [formatdate $date]
3555 set isbold [ishighlighted $row]
3557 lappend boldrows $row
3560 lappend boldnamerows $row
3564 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3565 -text $headline -font $font -tags text]
3566 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3567 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3568 -text $name -font $nfont -tags text]
3569 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3570 -text $date -font $mainfont -tags text]
3571 set xr [expr {$xt + [font measure $mainfont $headline]}]
3572 if {$xr > $canvxmax} {
3578 proc drawcmitrow {row} {
3579 global displayorder rowidlist
3580 global iddrawn markingmatches
3581 global commitinfo parentlist numcommits
3582 global filehighlight fhighlights findstring nhighlights
3583 global hlview vhighlights
3584 global highlight_related rhighlights
3586 if {$row >= $numcommits} return
3588 set id [lindex $displayorder $row]
3589 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3590 askvhighlight $row $id
3592 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3593 askfilehighlight $row $id
3595 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3596 askfindhighlight $row $id
3598 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3599 askrelhighlight $row $id
3601 if {![info exists iddrawn($id)]} {
3602 set col [lsearch -exact [lindex $rowidlist $row] $id]
3604 puts "oops, row $row id $id not in list"
3607 if {![info exists commitinfo($id)]} {
3611 drawcmittext $id $row $col
3614 if {$markingmatches} {
3615 markrowmatches $row $id
3619 proc drawcommits {row {endrow {}}} {
3620 global numcommits iddrawn displayorder curview
3621 global parentlist rowidlist
3626 if {$endrow eq {}} {
3629 if {$endrow >= $numcommits} {
3630 set endrow [expr {$numcommits - 1}]
3633 # make the lines join to already-drawn rows either side
3634 set r [expr {$row - 1}]
3635 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3638 set er [expr {$endrow + 1}]
3639 if {$er >= $numcommits ||
3640 ![info exists iddrawn([lindex $displayorder $er])]} {
3643 for {} {$r <= $er} {incr r} {
3644 set id [lindex $displayorder $r]
3645 set wasdrawn [info exists iddrawn($id)]
3647 if {$r == $er} break
3648 set nextid [lindex $displayorder [expr {$r + 1}]]
3649 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3650 catch {unset prevlines}
3653 drawparentlinks $id $r
3655 if {[info exists lineends($r)]} {
3656 foreach lid $lineends($r) {
3657 unset prevlines($lid)
3660 set rowids [lindex $rowidlist $r]
3661 foreach lid $rowids {
3662 if {$lid eq {}} continue
3664 # see if this is the first child of any of its parents
3665 foreach p [lindex $parentlist $r] {
3666 if {[lsearch -exact $rowids $p] < 0} {
3667 # make this line extend up to the child
3668 set le [drawlineseg $p $r $er 0]
3669 lappend lineends($le) $p
3673 } elseif {![info exists prevlines($lid)]} {
3674 set le [drawlineseg $lid $r $er 1]
3675 lappend lineends($le) $lid
3676 set prevlines($lid) 1
3682 proc drawfrac {f0 f1} {
3685 set ymax [lindex [$canv cget -scrollregion] 3]
3686 if {$ymax eq {} || $ymax == 0} return
3687 set y0 [expr {int($f0 * $ymax)}]
3688 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3689 set y1 [expr {int($f1 * $ymax)}]
3690 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3691 drawcommits $row $endrow
3694 proc drawvisible {} {
3696 eval drawfrac [$canv yview]
3699 proc clear_display {} {
3700 global iddrawn linesegs
3701 global vhighlights fhighlights nhighlights rhighlights
3704 catch {unset iddrawn}
3705 catch {unset linesegs}
3706 catch {unset vhighlights}
3707 catch {unset fhighlights}
3708 catch {unset nhighlights}
3709 catch {unset rhighlights}
3712 proc findcrossings {id} {
3713 global rowidlist parentlist numcommits rowoffsets displayorder
3717 foreach {s e} [rowranges $id] {
3718 if {$e >= $numcommits} {
3719 set e [expr {$numcommits - 1}]
3721 if {$e <= $s} continue
3722 set x [lsearch -exact [lindex $rowidlist $e] $id]
3724 puts "findcrossings: oops, no [shortids $id] in row $e"
3727 for {set row $e} {[incr row -1] >= $s} {} {
3728 set olds [lindex $parentlist $row]
3729 set kid [lindex $displayorder $row]
3730 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3731 if {$kidx < 0} continue
3732 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3734 set px [lsearch -exact $nextrow $p]
3735 if {$px < 0} continue
3736 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3737 if {[lsearch -exact $ccross $p] >= 0} continue
3738 if {$x == $px + ($kidx < $px? -1: 1)} {
3740 } elseif {[lsearch -exact $cross $p] < 0} {
3745 set inc [lindex $rowoffsets $row $x]
3746 if {$inc eq {}} break
3750 return [concat $ccross {{}} $cross]
3753 proc assigncolor {id} {
3754 global colormap colors nextcolor
3755 global commitrow parentlist children children curview
3757 if {[info exists colormap($id)]} return
3758 set ncolors [llength $colors]
3759 if {[info exists children($curview,$id)]} {
3760 set kids $children($curview,$id)
3764 if {[llength $kids] == 1} {
3765 set child [lindex $kids 0]
3766 if {[info exists colormap($child)]
3767 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3768 set colormap($id) $colormap($child)
3774 foreach x [findcrossings $id] {
3776 # delimiter between corner crossings and other crossings
3777 if {[llength $badcolors] >= $ncolors - 1} break
3778 set origbad $badcolors
3780 if {[info exists colormap($x)]
3781 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3782 lappend badcolors $colormap($x)
3785 if {[llength $badcolors] >= $ncolors} {
3786 set badcolors $origbad
3788 set origbad $badcolors
3789 if {[llength $badcolors] < $ncolors - 1} {
3790 foreach child $kids {
3791 if {[info exists colormap($child)]
3792 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3793 lappend badcolors $colormap($child)
3795 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3796 if {[info exists colormap($p)]
3797 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3798 lappend badcolors $colormap($p)
3802 if {[llength $badcolors] >= $ncolors} {
3803 set badcolors $origbad
3806 for {set i 0} {$i <= $ncolors} {incr i} {
3807 set c [lindex $colors $nextcolor]
3808 if {[incr nextcolor] >= $ncolors} {
3811 if {[lsearch -exact $badcolors $c]} break
3813 set colormap($id) $c
3816 proc bindline {t id} {
3819 $canv bind $t <Enter> "lineenter %x %y $id"
3820 $canv bind $t <Motion> "linemotion %x %y $id"
3821 $canv bind $t <Leave> "lineleave $id"
3822 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3825 proc drawtags {id x xt y1} {
3826 global idtags idheads idotherrefs mainhead
3827 global linespc lthickness
3828 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3833 if {[info exists idtags($id)]} {
3834 set marks $idtags($id)
3835 set ntags [llength $marks]
3837 if {[info exists idheads($id)]} {
3838 set marks [concat $marks $idheads($id)]
3839 set nheads [llength $idheads($id)]
3841 if {[info exists idotherrefs($id)]} {
3842 set marks [concat $marks $idotherrefs($id)]
3848 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3849 set yt [expr {$y1 - 0.5 * $linespc}]
3850 set yb [expr {$yt + $linespc - 1}]
3854 foreach tag $marks {
3856 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3857 set wid [font measure [concat $mainfont bold] $tag]
3859 set wid [font measure $mainfont $tag]
3863 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3865 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3866 -width $lthickness -fill black -tags tag.$id]
3868 foreach tag $marks x $xvals wid $wvals {
3869 set xl [expr {$x + $delta}]
3870 set xr [expr {$x + $delta + $wid + $lthickness}]
3872 if {[incr ntags -1] >= 0} {
3874 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3875 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3876 -width 1 -outline black -fill yellow -tags tag.$id]
3877 $canv bind $t <1> [list showtag $tag 1]
3878 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3880 # draw a head or other ref
3881 if {[incr nheads -1] >= 0} {
3883 if {$tag eq $mainhead} {
3889 set xl [expr {$xl - $delta/2}]
3890 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3891 -width 1 -outline black -fill $col -tags tag.$id
3892 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3893 set rwid [font measure $mainfont $remoteprefix]
3894 set xi [expr {$x + 1}]
3895 set yti [expr {$yt + 1}]
3896 set xri [expr {$x + $rwid}]
3897 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3898 -width 0 -fill "#ffddaa" -tags tag.$id
3901 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3902 -font $font -tags [list tag.$id text]]
3904 $canv bind $t <1> [list showtag $tag 1]
3905 } elseif {$nheads >= 0} {
3906 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3912 proc xcoord {i level ln} {
3913 global canvx0 xspc1 xspc2
3915 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3916 if {$i > 0 && $i == $level} {
3917 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3918 } elseif {$i > $level} {
3919 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3924 proc show_status {msg} {
3925 global canv mainfont fgcolor
3928 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3929 -tags text -fill $fgcolor
3932 # Insert a new commit as the child of the commit on row $row.
3933 # The new commit will be displayed on row $row and the commits
3934 # on that row and below will move down one row.
3935 proc insertrow {row newcmit} {
3936 global displayorder parentlist commitlisted children
3937 global commitrow curview rowidlist rowoffsets numcommits
3938 global rowrangelist rowlaidout rowoptim numcommits
3939 global selectedline rowchk commitidx
3941 if {$row >= $numcommits} {
3942 puts "oops, inserting new row $row but only have $numcommits rows"
3945 set p [lindex $displayorder $row]
3946 set displayorder [linsert $displayorder $row $newcmit]
3947 set parentlist [linsert $parentlist $row $p]
3948 set kids $children($curview,$p)
3949 lappend kids $newcmit
3950 set children($curview,$p) $kids
3951 set children($curview,$newcmit) {}
3952 set commitlisted [linsert $commitlisted $row 1]
3953 set l [llength $displayorder]
3954 for {set r $row} {$r < $l} {incr r} {
3955 set id [lindex $displayorder $r]
3956 set commitrow($curview,$id) $r
3958 incr commitidx($curview)
3960 set idlist [lindex $rowidlist $row]
3961 set offs [lindex $rowoffsets $row]
3964 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3970 if {[llength $kids] == 1} {
3971 set col [lsearch -exact $idlist $p]
3972 lset idlist $col $newcmit
3974 set col [llength $idlist]
3975 lappend idlist $newcmit
3977 lset rowoffsets $row $offs
3979 set rowidlist [linsert $rowidlist $row $idlist]
3980 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3982 set rowrangelist [linsert $rowrangelist $row {}]
3983 if {[llength $kids] > 1} {
3984 set rp1 [expr {$row + 1}]
3985 set ranges [lindex $rowrangelist $rp1]
3986 if {$ranges eq {}} {
3987 set ranges [list $newcmit $p]
3988 } elseif {[lindex $ranges end-1] eq $p} {
3989 lset ranges end-1 $newcmit
3991 lset rowrangelist $rp1 $ranges
3994 catch {unset rowchk}
4000 if {[info exists selectedline] && $selectedline >= $row} {
4006 # Remove a commit that was inserted with insertrow on row $row.
4007 proc removerow {row} {
4008 global displayorder parentlist commitlisted children
4009 global commitrow curview rowidlist rowoffsets numcommits
4010 global rowrangelist idrowranges rowlaidout rowoptim numcommits
4011 global linesegends selectedline rowchk commitidx
4013 if {$row >= $numcommits} {
4014 puts "oops, removing row $row but only have $numcommits rows"
4017 set rp1 [expr {$row + 1}]
4018 set id [lindex $displayorder $row]
4019 set p [lindex $parentlist $row]
4020 set displayorder [lreplace $displayorder $row $row]
4021 set parentlist [lreplace $parentlist $row $row]
4022 set commitlisted [lreplace $commitlisted $row $row]
4023 set kids $children($curview,$p)
4024 set i [lsearch -exact $kids $id]
4026 set kids [lreplace $kids $i $i]
4027 set children($curview,$p) $kids
4029 set l [llength $displayorder]
4030 for {set r $row} {$r < $l} {incr r} {
4031 set id [lindex $displayorder $r]
4032 set commitrow($curview,$id) $r
4034 incr commitidx($curview) -1
4036 set rowidlist [lreplace $rowidlist $row $row]
4037 set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
4039 set offs [lindex $rowoffsets $row]
4040 set offs [lreplace $offs end end]
4041 lset rowoffsets $row $offs
4044 set rowrangelist [lreplace $rowrangelist $row $row]
4045 if {[llength $kids] > 0} {
4046 set ranges [lindex $rowrangelist $row]
4047 if {[lindex $ranges end-1] eq $id} {
4048 set ranges [lreplace $ranges end-1 end]
4049 lset rowrangelist $row $ranges
4053 catch {unset rowchk}
4059 if {[info exists selectedline] && $selectedline > $row} {
4060 incr selectedline -1
4065 # Don't change the text pane cursor if it is currently the hand cursor,
4066 # showing that we are over a sha1 ID link.
4067 proc settextcursor {c} {
4068 global ctext curtextcursor
4070 if {[$ctext cget -cursor] == $curtextcursor} {
4071 $ctext config -cursor $c
4073 set curtextcursor $c
4076 proc nowbusy {what} {
4079 if {[array names isbusy] eq {}} {
4080 . config -cursor watch
4086 proc notbusy {what} {
4087 global isbusy maincursor textcursor
4089 catch {unset isbusy($what)}
4090 if {[array names isbusy] eq {}} {
4091 . config -cursor $maincursor
4092 settextcursor $textcursor
4096 proc findmatches {f} {
4097 global findtype findstring
4098 if {$findtype == "Regexp"} {
4099 set matches [regexp -indices -all -inline $findstring $f]
4102 if {$findtype == "IgnCase"} {
4103 set f [string tolower $f]
4104 set fs [string tolower $fs]
4108 set l [string length $fs]
4109 while {[set j [string first $fs $f $i]] >= 0} {
4110 lappend matches [list $j [expr {$j+$l-1}]]
4111 set i [expr {$j + $l}]
4117 proc dofind {{rev 0}} {
4118 global findstring findstartline findcurline selectedline numcommits
4121 cancel_next_highlight
4123 if {$findstring eq {} || $numcommits == 0} return
4124 if {![info exists selectedline]} {
4125 set findstartline [lindex [visiblerows] $rev]
4127 set findstartline $selectedline
4129 set findcurline $findstartline
4134 if {$findcurline == 0} {
4135 set findcurline $numcommits
4142 proc findnext {restart} {
4144 if {![info exists findcurline]} {
4158 if {![info exists findcurline]} {
4167 global commitdata commitinfo numcommits findstring findpattern findloc
4168 global findstartline findcurline displayorder
4170 set fldtypes {Headline Author Date Committer CDate Comments}
4171 set l [expr {$findcurline + 1}]
4172 if {$l >= $numcommits} {
4175 if {$l <= $findstartline} {
4176 set lim [expr {$findstartline + 1}]
4180 if {$lim - $l > 500} {
4181 set lim [expr {$l + 500}]
4184 for {} {$l < $lim} {incr l} {
4185 set id [lindex $displayorder $l]
4186 # shouldn't happen unless git log doesn't give all the commits...
4187 if {![info exists commitdata($id)]} continue
4188 if {![doesmatch $commitdata($id)]} continue
4189 if {![info exists commitinfo($id)]} {
4192 set info $commitinfo($id)
4193 foreach f $info ty $fldtypes {
4194 if {($findloc eq "All fields" || $findloc eq $ty) &&
4202 if {$l == $findstartline + 1} {
4208 set findcurline [expr {$l - 1}]
4212 proc findmorerev {} {
4213 global commitdata commitinfo numcommits findstring findpattern findloc
4214 global findstartline findcurline displayorder
4216 set fldtypes {Headline Author Date Committer CDate Comments}
4222 if {$l >= $findstartline} {
4223 set lim [expr {$findstartline - 1}]
4227 if {$l - $lim > 500} {
4228 set lim [expr {$l - 500}]
4231 for {} {$l > $lim} {incr l -1} {
4232 set id [lindex $displayorder $l]
4233 if {![doesmatch $commitdata($id)]} continue
4234 if {![info exists commitinfo($id)]} {
4237 set info $commitinfo($id)
4238 foreach f $info ty $fldtypes {
4239 if {($findloc eq "All fields" || $findloc eq $ty) &&
4253 set findcurline [expr {$l + 1}]
4257 proc findselectline {l} {
4258 global findloc commentend ctext findcurline markingmatches
4260 set markingmatches 1
4263 if {$findloc == "All fields" || $findloc == "Comments"} {
4264 # highlight the matches in the comments
4265 set f [$ctext get 1.0 $commentend]
4266 set matches [findmatches $f]
4267 foreach match $matches {
4268 set start [lindex $match 0]
4269 set end [expr {[lindex $match 1] + 1}]
4270 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4276 # mark the bits of a headline or author that match a find string
4277 proc markmatches {canv l str tag matches font row} {
4280 set bbox [$canv bbox $tag]
4281 set x0 [lindex $bbox 0]
4282 set y0 [lindex $bbox 1]
4283 set y1 [lindex $bbox 3]
4284 foreach match $matches {
4285 set start [lindex $match 0]
4286 set end [lindex $match 1]
4287 if {$start > $end} continue
4288 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4289 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4290 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4291 [expr {$x0+$xlen+2}] $y1 \
4292 -outline {} -tags [list match$l matches] -fill yellow]
4294 if {[info exists selectedline] && $row == $selectedline} {
4295 $canv raise $t secsel
4300 proc unmarkmatches {} {
4301 global findids markingmatches findcurline
4303 allcanvs delete matches
4304 catch {unset findids}
4305 set markingmatches 0
4306 catch {unset findcurline}
4309 proc selcanvline {w x y} {
4310 global canv canvy0 ctext linespc
4312 set ymax [lindex [$canv cget -scrollregion] 3]
4313 if {$ymax == {}} return
4314 set yfrac [lindex [$canv yview] 0]
4315 set y [expr {$y + $yfrac * $ymax}]
4316 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4321 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4327 proc commit_descriptor {p} {
4329 if {![info exists commitinfo($p)]} {
4333 if {[llength $commitinfo($p)] > 1} {
4334 set l [lindex $commitinfo($p) 0]
4339 # append some text to the ctext widget, and make any SHA1 ID
4340 # that we know about be a clickable link.
4341 proc appendwithlinks {text tags} {
4342 global ctext commitrow linknum curview
4344 set start [$ctext index "end - 1c"]
4345 $ctext insert end $text $tags
4346 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4350 set linkid [string range $text $s $e]
4351 if {![info exists commitrow($curview,$linkid)]} continue
4353 $ctext tag add link "$start + $s c" "$start + $e c"
4354 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4355 $ctext tag bind link$linknum <1> \
4356 [list selectline $commitrow($curview,$linkid) 1]
4359 $ctext tag conf link -foreground blue -underline 1
4360 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4361 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4364 proc viewnextline {dir} {
4368 set ymax [lindex [$canv cget -scrollregion] 3]
4369 set wnow [$canv yview]
4370 set wtop [expr {[lindex $wnow 0] * $ymax}]
4371 set newtop [expr {$wtop + $dir * $linespc}]
4374 } elseif {$newtop > $ymax} {
4377 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4380 # add a list of tag or branch names at position pos
4381 # returns the number of names inserted
4382 proc appendrefs {pos ids var} {
4383 global ctext commitrow linknum curview $var maxrefs
4385 if {[catch {$ctext index $pos}]} {
4388 $ctext conf -state normal
4389 $ctext delete $pos "$pos lineend"
4392 foreach tag [set $var\($id\)] {
4393 lappend tags [list $tag $id]
4396 if {[llength $tags] > $maxrefs} {
4397 $ctext insert $pos "many ([llength $tags])"
4399 set tags [lsort -index 0 -decreasing $tags]
4402 set id [lindex $ti 1]
4405 $ctext tag delete $lk
4406 $ctext insert $pos $sep
4407 $ctext insert $pos [lindex $ti 0] $lk
4408 if {[info exists commitrow($curview,$id)]} {
4409 $ctext tag conf $lk -foreground blue
4410 $ctext tag bind $lk <1> \
4411 [list selectline $commitrow($curview,$id) 1]
4412 $ctext tag conf $lk -underline 1
4413 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4414 $ctext tag bind $lk <Leave> \
4415 { %W configure -cursor $curtextcursor }
4420 $ctext conf -state disabled
4421 return [llength $tags]
4424 # called when we have finished computing the nearby tags
4425 proc dispneartags {delay} {
4426 global selectedline currentid showneartags tagphase
4428 if {![info exists selectedline] || !$showneartags} return
4429 after cancel dispnexttag
4431 after 200 dispnexttag
4434 after idle dispnexttag
4439 proc dispnexttag {} {
4440 global selectedline currentid showneartags tagphase ctext
4442 if {![info exists selectedline] || !$showneartags} return
4443 switch -- $tagphase {
4445 set dtags [desctags $currentid]
4447 appendrefs precedes $dtags idtags
4451 set atags [anctags $currentid]
4453 appendrefs follows $atags idtags
4457 set dheads [descheads $currentid]
4458 if {$dheads ne {}} {
4459 if {[appendrefs branch $dheads idheads] > 1
4460 && [$ctext get "branch -3c"] eq "h"} {
4461 # turn "Branch" into "Branches"
4462 $ctext conf -state normal
4463 $ctext insert "branch -2c" "es"
4464 $ctext conf -state disabled
4469 if {[incr tagphase] <= 2} {
4470 after idle dispnexttag
4474 proc selectline {l isnew} {
4475 global canv canv2 canv3 ctext commitinfo selectedline
4476 global displayorder linehtag linentag linedtag
4477 global canvy0 linespc parentlist children curview
4478 global currentid sha1entry
4479 global commentend idtags linknum
4480 global mergemax numcommits pending_select
4481 global cmitmode showneartags allcommits
4483 catch {unset pending_select}
4486 cancel_next_highlight
4487 if {$l < 0 || $l >= $numcommits} return
4488 set y [expr {$canvy0 + $l * $linespc}]
4489 set ymax [lindex [$canv cget -scrollregion] 3]
4490 set ytop [expr {$y - $linespc - 1}]
4491 set ybot [expr {$y + $linespc + 1}]
4492 set wnow [$canv yview]
4493 set wtop [expr {[lindex $wnow 0] * $ymax}]
4494 set wbot [expr {[lindex $wnow 1] * $ymax}]
4495 set wh [expr {$wbot - $wtop}]
4497 if {$ytop < $wtop} {
4498 if {$ybot < $wtop} {
4499 set newtop [expr {$y - $wh / 2.0}]
4502 if {$newtop > $wtop - $linespc} {
4503 set newtop [expr {$wtop - $linespc}]
4506 } elseif {$ybot > $wbot} {
4507 if {$ytop > $wbot} {
4508 set newtop [expr {$y - $wh / 2.0}]
4510 set newtop [expr {$ybot - $wh}]
4511 if {$newtop < $wtop + $linespc} {
4512 set newtop [expr {$wtop + $linespc}]
4516 if {$newtop != $wtop} {
4520 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4524 if {![info exists linehtag($l)]} return
4526 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4527 -tags secsel -fill [$canv cget -selectbackground]]
4529 $canv2 delete secsel
4530 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4531 -tags secsel -fill [$canv2 cget -selectbackground]]
4533 $canv3 delete secsel
4534 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4535 -tags secsel -fill [$canv3 cget -selectbackground]]
4539 addtohistory [list selectline $l 0]
4544 set id [lindex $displayorder $l]
4546 $sha1entry delete 0 end
4547 $sha1entry insert 0 $id
4548 $sha1entry selection from 0
4549 $sha1entry selection to end
4552 $ctext conf -state normal
4555 set info $commitinfo($id)
4556 set date [formatdate [lindex $info 2]]
4557 $ctext insert end "Author: [lindex $info 1] $date\n"
4558 set date [formatdate [lindex $info 4]]
4559 $ctext insert end "Committer: [lindex $info 3] $date\n"
4560 if {[info exists idtags($id)]} {
4561 $ctext insert end "Tags:"
4562 foreach tag $idtags($id) {
4563 $ctext insert end " $tag"
4565 $ctext insert end "\n"
4569 set olds [lindex $parentlist $l]
4570 if {[llength $olds] > 1} {
4573 if {$np >= $mergemax} {
4578 $ctext insert end "Parent: " $tag
4579 appendwithlinks [commit_descriptor $p] {}
4584 append headers "Parent: [commit_descriptor $p]"
4588 foreach c $children($curview,$id) {
4589 append headers "Child: [commit_descriptor $c]"
4592 # make anything that looks like a SHA1 ID be a clickable link
4593 appendwithlinks $headers {}
4594 if {$showneartags} {
4595 if {![info exists allcommits]} {
4598 $ctext insert end "Branch: "
4599 $ctext mark set branch "end -1c"
4600 $ctext mark gravity branch left
4601 $ctext insert end "\nFollows: "
4602 $ctext mark set follows "end -1c"
4603 $ctext mark gravity follows left
4604 $ctext insert end "\nPrecedes: "
4605 $ctext mark set precedes "end -1c"
4606 $ctext mark gravity precedes left
4607 $ctext insert end "\n"
4610 $ctext insert end "\n"
4611 set comment [lindex $info 5]
4612 if {[string first "\r" $comment] >= 0} {
4613 set comment [string map {"\r" "\n "} $comment]
4615 appendwithlinks $comment {comment}
4617 $ctext tag remove found 1.0 end
4618 $ctext conf -state disabled
4619 set commentend [$ctext index "end - 1c"]
4621 init_flist "Comments"
4622 if {$cmitmode eq "tree"} {
4624 } elseif {[llength $olds] <= 1} {
4631 proc selfirstline {} {
4636 proc sellastline {} {
4639 set l [expr {$numcommits - 1}]
4643 proc selnextline {dir} {
4646 if {![info exists selectedline]} return
4647 set l [expr {$selectedline + $dir}]
4652 proc selnextpage {dir} {
4653 global canv linespc selectedline numcommits
4655 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4659 allcanvs yview scroll [expr {$dir * $lpp}] units
4661 if {![info exists selectedline]} return
4662 set l [expr {$selectedline + $dir * $lpp}]
4665 } elseif {$l >= $numcommits} {
4666 set l [expr $numcommits - 1]
4672 proc unselectline {} {
4673 global selectedline currentid
4675 catch {unset selectedline}
4676 catch {unset currentid}
4677 allcanvs delete secsel
4679 cancel_next_highlight
4682 proc reselectline {} {
4685 if {[info exists selectedline]} {
4686 selectline $selectedline 0
4690 proc addtohistory {cmd} {
4691 global history historyindex curview
4693 set elt [list $curview $cmd]
4694 if {$historyindex > 0
4695 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4699 if {$historyindex < [llength $history]} {
4700 set history [lreplace $history $historyindex end $elt]
4702 lappend history $elt
4705 if {$historyindex > 1} {
4706 .tf.bar.leftbut conf -state normal
4708 .tf.bar.leftbut conf -state disabled
4710 .tf.bar.rightbut conf -state disabled
4716 set view [lindex $elt 0]
4717 set cmd [lindex $elt 1]
4718 if {$curview != $view} {
4725 global history historyindex
4728 if {$historyindex > 1} {
4729 incr historyindex -1
4730 godo [lindex $history [expr {$historyindex - 1}]]
4731 .tf.bar.rightbut conf -state normal
4733 if {$historyindex <= 1} {
4734 .tf.bar.leftbut conf -state disabled
4739 global history historyindex
4742 if {$historyindex < [llength $history]} {
4743 set cmd [lindex $history $historyindex]
4746 .tf.bar.leftbut conf -state normal
4748 if {$historyindex >= [llength $history]} {
4749 .tf.bar.rightbut conf -state disabled
4754 global treefilelist treeidlist diffids diffmergeid treepending
4755 global nullid nullid2
4758 catch {unset diffmergeid}
4759 if {![info exists treefilelist($id)]} {
4760 if {![info exists treepending]} {
4761 if {$id eq $nullid} {
4762 set cmd [list | git ls-files]
4763 } elseif {$id eq $nullid2} {
4764 set cmd [list | git ls-files --stage -t]
4766 set cmd [list | git ls-tree -r $id]
4768 if {[catch {set gtf [open $cmd r]}]} {
4772 set treefilelist($id) {}
4773 set treeidlist($id) {}
4774 fconfigure $gtf -blocking 0
4775 filerun $gtf [list gettreeline $gtf $id]
4782 proc gettreeline {gtf id} {
4783 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4786 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4787 if {$diffids eq $nullid} {
4790 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4791 set i [string first "\t" $line]
4792 if {$i < 0} continue
4793 set sha1 [lindex $line 2]
4794 set fname [string range $line [expr {$i+1}] end]
4795 if {[string index $fname 0] eq "\""} {
4796 set fname [lindex $fname 0]
4798 lappend treeidlist($id) $sha1
4800 lappend treefilelist($id) $fname
4803 return [expr {$nl >= 1000? 2: 1}]
4807 if {$cmitmode ne "tree"} {
4808 if {![info exists diffmergeid]} {
4809 gettreediffs $diffids
4811 } elseif {$id ne $diffids} {
4820 global treefilelist treeidlist diffids nullid nullid2
4821 global ctext commentend
4823 set i [lsearch -exact $treefilelist($diffids) $f]
4825 puts "oops, $f not in list for id $diffids"
4828 if {$diffids eq $nullid} {
4829 if {[catch {set bf [open $f r]} err]} {
4830 puts "oops, can't read $f: $err"
4834 set blob [lindex $treeidlist($diffids) $i]
4835 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4836 puts "oops, error reading blob $blob: $err"
4840 fconfigure $bf -blocking 0
4841 filerun $bf [list getblobline $bf $diffids]
4842 $ctext config -state normal
4843 clear_ctext $commentend
4844 $ctext insert end "\n"
4845 $ctext insert end "$f\n" filesep
4846 $ctext config -state disabled
4847 $ctext yview $commentend
4850 proc getblobline {bf id} {
4851 global diffids cmitmode ctext
4853 if {$id ne $diffids || $cmitmode ne "tree"} {
4857 $ctext config -state normal
4859 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4860 $ctext insert end "$line\n"
4863 # delete last newline
4864 $ctext delete "end - 2c" "end - 1c"
4868 $ctext config -state disabled
4869 return [expr {$nl >= 1000? 2: 1}]
4872 proc mergediff {id l} {
4873 global diffmergeid diffopts mdifffd
4879 # this doesn't seem to actually affect anything...
4880 set env(GIT_DIFF_OPTS) $diffopts
4881 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4882 if {[catch {set mdf [open $cmd r]} err]} {
4883 error_popup "Error getting merge diffs: $err"
4886 fconfigure $mdf -blocking 0
4887 set mdifffd($id) $mdf
4888 set np [llength [lindex $parentlist $l]]
4889 filerun $mdf [list getmergediffline $mdf $id $np]
4892 proc getmergediffline {mdf id np} {
4893 global diffmergeid ctext cflist mergemax
4894 global difffilestart mdifffd
4896 $ctext conf -state normal
4898 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4899 if {![info exists diffmergeid] || $id != $diffmergeid
4900 || $mdf != $mdifffd($id)} {
4904 if {[regexp {^diff --cc (.*)} $line match fname]} {
4905 # start of a new file
4906 $ctext insert end "\n"
4907 set here [$ctext index "end - 1c"]
4908 lappend difffilestart $here
4909 add_flist [list $fname]
4910 set l [expr {(78 - [string length $fname]) / 2}]
4911 set pad [string range "----------------------------------------" 1 $l]
4912 $ctext insert end "$pad $fname $pad\n" filesep
4913 } elseif {[regexp {^@@} $line]} {
4914 $ctext insert end "$line\n" hunksep
4915 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4918 # parse the prefix - one ' ', '-' or '+' for each parent
4923 for {set j 0} {$j < $np} {incr j} {
4924 set c [string range $line $j $j]
4927 } elseif {$c == "-"} {
4929 } elseif {$c == "+"} {
4938 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4939 # line doesn't appear in result, parents in $minuses have the line
4940 set num [lindex $minuses 0]
4941 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4942 # line appears in result, parents in $pluses don't have the line
4943 lappend tags mresult
4944 set num [lindex $spaces 0]
4947 if {$num >= $mergemax} {
4952 $ctext insert end "$line\n" $tags
4955 $ctext conf -state disabled
4960 return [expr {$nr >= 1000? 2: 1}]
4963 proc startdiff {ids} {
4964 global treediffs diffids treepending diffmergeid nullid nullid2
4967 catch {unset diffmergeid}
4968 if {![info exists treediffs($ids)] ||
4969 [lsearch -exact $ids $nullid] >= 0 ||
4970 [lsearch -exact $ids $nullid2] >= 0} {
4971 if {![info exists treepending]} {
4979 proc addtocflist {ids} {
4980 global treediffs cflist
4981 add_flist $treediffs($ids)
4985 proc diffcmd {ids flags} {
4986 global nullid nullid2
4988 set i [lsearch -exact $ids $nullid]
4989 set j [lsearch -exact $ids $nullid2]
4991 if {[llength $ids] > 1 && $j < 0} {
4992 # comparing working directory with some specific revision
4993 set cmd [concat | git diff-index $flags]
4995 lappend cmd -R [lindex $ids 1]
4997 lappend cmd [lindex $ids 0]
5000 # comparing working directory with index
5001 set cmd [concat | git diff-files $flags]
5006 } elseif {$j >= 0} {
5007 set cmd [concat | git diff-index --cached $flags]
5008 if {[llength $ids] > 1} {
5009 # comparing index with specific revision
5011 lappend cmd -R [lindex $ids 1]
5013 lappend cmd [lindex $ids 0]
5016 # comparing index with HEAD
5020 set cmd [concat | git diff-tree -r $flags $ids]
5025 proc gettreediffs {ids} {
5026 global treediff treepending
5028 set treepending $ids
5030 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5031 fconfigure $gdtf -blocking 0
5032 filerun $gdtf [list gettreediffline $gdtf $ids]
5035 proc gettreediffline {gdtf ids} {
5036 global treediff treediffs treepending diffids diffmergeid
5040 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5041 set i [string first "\t" $line]
5043 set file [string range $line [expr {$i+1}] end]
5044 if {[string index $file 0] eq "\""} {
5045 set file [lindex $file 0]
5047 lappend treediff $file
5051 return [expr {$nr >= 1000? 2: 1}]
5054 set treediffs($ids) $treediff
5056 if {$cmitmode eq "tree"} {
5058 } elseif {$ids != $diffids} {
5059 if {![info exists diffmergeid]} {
5060 gettreediffs $diffids
5068 # empty string or positive integer
5069 proc diffcontextvalidate {v} {
5070 return [regexp {^(|[1-9][0-9]*)$} $v]
5073 proc diffcontextchange {n1 n2 op} {
5074 global diffcontextstring diffcontext
5076 if {[string is integer -strict $diffcontextstring]} {
5077 if {$diffcontextstring > 0} {
5078 set diffcontext $diffcontextstring
5084 proc getblobdiffs {ids} {
5085 global diffopts blobdifffd diffids env
5086 global diffinhdr treediffs
5089 set env(GIT_DIFF_OPTS) $diffopts
5090 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5091 puts "error getting diffs: $err"
5095 fconfigure $bdf -blocking 0
5096 set blobdifffd($ids) $bdf
5097 filerun $bdf [list getblobdiffline $bdf $diffids]
5100 proc setinlist {var i val} {
5103 while {[llength [set $var]] < $i} {
5106 if {[llength [set $var]] == $i} {
5113 proc makediffhdr {fname ids} {
5114 global ctext curdiffstart treediffs
5116 set i [lsearch -exact $treediffs($ids) $fname]
5118 setinlist difffilestart $i $curdiffstart
5120 set l [expr {(78 - [string length $fname]) / 2}]
5121 set pad [string range "----------------------------------------" 1 $l]
5122 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5125 proc getblobdiffline {bdf ids} {
5126 global diffids blobdifffd ctext curdiffstart
5127 global diffnexthead diffnextnote difffilestart
5128 global diffinhdr treediffs
5131 $ctext conf -state normal
5132 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5133 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5137 if {![string compare -length 11 "diff --git " $line]} {
5138 # trim off "diff --git "
5139 set line [string range $line 11 end]
5141 # start of a new file
5142 $ctext insert end "\n"
5143 set curdiffstart [$ctext index "end - 1c"]
5144 $ctext insert end "\n" filesep
5145 # If the name hasn't changed the length will be odd,
5146 # the middle char will be a space, and the two bits either
5147 # side will be a/name and b/name, or "a/name" and "b/name".
5148 # If the name has changed we'll get "rename from" and
5149 # "rename to" lines following this, and we'll use them
5150 # to get the filenames.
5151 # This complexity is necessary because spaces in the filename(s)
5152 # don't get escaped.
5153 set l [string length $line]
5154 set i [expr {$l / 2}]
5155 if {!(($l & 1) && [string index $line $i] eq " " &&
5156 [string range $line 2 [expr {$i - 1}]] eq \
5157 [string range $line [expr {$i + 3}] end])} {
5160 # unescape if quoted and chop off the a/ from the front
5161 if {[string index $line 0] eq "\""} {
5162 set fname [string range [lindex $line 0] 2 end]
5164 set fname [string range $line 2 [expr {$i - 1}]]
5166 makediffhdr $fname $ids
5168 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5169 $line match f1l f1c f2l f2c rest]} {
5170 $ctext insert end "$line\n" hunksep
5173 } elseif {$diffinhdr} {
5174 if {![string compare -length 12 "rename from " $line]} {
5175 set fname [string range $line 12 end]
5176 if {[string index $fname 0] eq "\""} {
5177 set fname [lindex $fname 0]
5179 set i [lsearch -exact $treediffs($ids) $fname]
5181 setinlist difffilestart $i $curdiffstart
5183 } elseif {![string compare -length 10 $line "rename to "]} {
5184 set fname [string range $line 10 end]
5185 if {[string index $fname 0] eq "\""} {
5186 set fname [lindex $fname 0]
5188 makediffhdr $fname $ids
5189 } elseif {[string compare -length 3 $line "---"] == 0} {
5192 } elseif {[string compare -length 3 $line "+++"] == 0} {
5196 $ctext insert end "$line\n" filesep
5199 set x [string range $line 0 0]
5200 if {$x == "-" || $x == "+"} {
5201 set tag [expr {$x == "+"}]
5202 $ctext insert end "$line\n" d$tag
5203 } elseif {$x == " "} {
5204 $ctext insert end "$line\n"
5206 # "\ No newline at end of file",
5207 # or something else we don't recognize
5208 $ctext insert end "$line\n" hunksep
5212 $ctext conf -state disabled
5217 return [expr {$nr >= 1000? 2: 1}]
5220 proc changediffdisp {} {
5221 global ctext diffelide
5223 $ctext tag conf d0 -elide [lindex $diffelide 0]
5224 $ctext tag conf d1 -elide [lindex $diffelide 1]
5228 global difffilestart ctext
5229 set prev [lindex $difffilestart 0]
5230 set here [$ctext index @0,0]
5231 foreach loc $difffilestart {
5232 if {[$ctext compare $loc >= $here]} {
5242 global difffilestart ctext
5243 set here [$ctext index @0,0]
5244 foreach loc $difffilestart {
5245 if {[$ctext compare $loc > $here]} {
5252 proc clear_ctext {{first 1.0}} {
5253 global ctext smarktop smarkbot
5255 set l [lindex [split $first .] 0]
5256 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5259 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5262 $ctext delete $first end
5265 proc incrsearch {name ix op} {
5266 global ctext searchstring searchdirn
5268 $ctext tag remove found 1.0 end
5269 if {[catch {$ctext index anchor}]} {
5270 # no anchor set, use start of selection, or of visible area
5271 set sel [$ctext tag ranges sel]
5273 $ctext mark set anchor [lindex $sel 0]
5274 } elseif {$searchdirn eq "-forwards"} {
5275 $ctext mark set anchor @0,0
5277 $ctext mark set anchor @0,[winfo height $ctext]
5280 if {$searchstring ne {}} {
5281 set here [$ctext search $searchdirn -- $searchstring anchor]
5290 global sstring ctext searchstring searchdirn
5293 $sstring icursor end
5294 set searchdirn -forwards
5295 if {$searchstring ne {}} {
5296 set sel [$ctext tag ranges sel]
5298 set start "[lindex $sel 0] + 1c"
5299 } elseif {[catch {set start [$ctext index anchor]}]} {
5302 set match [$ctext search -count mlen -- $searchstring $start]
5303 $ctext tag remove sel 1.0 end
5309 set mend "$match + $mlen c"
5310 $ctext tag add sel $match $mend
5311 $ctext mark unset anchor
5315 proc dosearchback {} {
5316 global sstring ctext searchstring searchdirn
5319 $sstring icursor end
5320 set searchdirn -backwards
5321 if {$searchstring ne {}} {
5322 set sel [$ctext tag ranges sel]
5324 set start [lindex $sel 0]
5325 } elseif {[catch {set start [$ctext index anchor]}]} {
5326 set start @0,[winfo height $ctext]
5328 set match [$ctext search -backwards -count ml -- $searchstring $start]
5329 $ctext tag remove sel 1.0 end
5335 set mend "$match + $ml c"
5336 $ctext tag add sel $match $mend
5337 $ctext mark unset anchor
5341 proc searchmark {first last} {
5342 global ctext searchstring
5346 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5347 if {$match eq {}} break
5348 set mend "$match + $mlen c"
5349 $ctext tag add found $match $mend
5353 proc searchmarkvisible {doall} {
5354 global ctext smarktop smarkbot
5356 set topline [lindex [split [$ctext index @0,0] .] 0]
5357 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5358 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5359 # no overlap with previous
5360 searchmark $topline $botline
5361 set smarktop $topline
5362 set smarkbot $botline
5364 if {$topline < $smarktop} {
5365 searchmark $topline [expr {$smarktop-1}]
5366 set smarktop $topline
5368 if {$botline > $smarkbot} {
5369 searchmark [expr {$smarkbot+1}] $botline
5370 set smarkbot $botline
5375 proc scrolltext {f0 f1} {
5378 .bleft.sb set $f0 $f1
5379 if {$searchstring ne {}} {
5385 global linespc charspc canvx0 canvy0 mainfont
5386 global xspc1 xspc2 lthickness
5388 set linespc [font metrics $mainfont -linespace]
5389 set charspc [font measure $mainfont "m"]
5390 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5391 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5392 set lthickness [expr {int($linespc / 9) + 1}]
5393 set xspc1(0) $linespc
5401 set ymax [lindex [$canv cget -scrollregion] 3]
5402 if {$ymax eq {} || $ymax == 0} return
5403 set span [$canv yview]
5406 allcanvs yview moveto [lindex $span 0]
5408 if {[info exists selectedline]} {
5409 selectline $selectedline 0
5410 allcanvs yview moveto [lindex $span 0]
5414 proc incrfont {inc} {
5415 global mainfont textfont ctext canv phase cflist
5416 global charspc tabstop
5417 global stopped entries
5419 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5420 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5422 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5423 $cflist conf -font $textfont
5424 $ctext tag conf filesep -font [concat $textfont bold]
5425 foreach e $entries {
5426 $e conf -font $mainfont
5428 if {$phase eq "getcommits"} {
5429 $canv itemconf textitems -font $mainfont
5435 global sha1entry sha1string
5436 if {[string length $sha1string] == 40} {
5437 $sha1entry delete 0 end
5441 proc sha1change {n1 n2 op} {
5442 global sha1string currentid sha1but
5443 if {$sha1string == {}
5444 || ([info exists currentid] && $sha1string == $currentid)} {
5449 if {[$sha1but cget -state] == $state} return
5450 if {$state == "normal"} {
5451 $sha1but conf -state normal -relief raised -text "Goto: "
5453 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5457 proc gotocommit {} {
5458 global sha1string currentid commitrow tagids headids
5459 global displayorder numcommits curview
5461 if {$sha1string == {}
5462 || ([info exists currentid] && $sha1string == $currentid)} return
5463 if {[info exists tagids($sha1string)]} {
5464 set id $tagids($sha1string)
5465 } elseif {[info exists headids($sha1string)]} {
5466 set id $headids($sha1string)
5468 set id [string tolower $sha1string]
5469 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5471 foreach i $displayorder {
5472 if {[string match $id* $i]} {
5476 if {$matches ne {}} {
5477 if {[llength $matches] > 1} {
5478 error_popup "Short SHA1 id $id is ambiguous"
5481 set id [lindex $matches 0]
5485 if {[info exists commitrow($curview,$id)]} {
5486 selectline $commitrow($curview,$id) 1
5489 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5494 error_popup "$type $sha1string is not known"
5497 proc lineenter {x y id} {
5498 global hoverx hovery hoverid hovertimer
5499 global commitinfo canv
5501 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5505 if {[info exists hovertimer]} {
5506 after cancel $hovertimer
5508 set hovertimer [after 500 linehover]
5512 proc linemotion {x y id} {
5513 global hoverx hovery hoverid hovertimer
5515 if {[info exists hoverid] && $id == $hoverid} {
5518 if {[info exists hovertimer]} {
5519 after cancel $hovertimer
5521 set hovertimer [after 500 linehover]
5525 proc lineleave {id} {
5526 global hoverid hovertimer canv
5528 if {[info exists hoverid] && $id == $hoverid} {
5530 if {[info exists hovertimer]} {
5531 after cancel $hovertimer
5539 global hoverx hovery hoverid hovertimer
5540 global canv linespc lthickness
5541 global commitinfo mainfont
5543 set text [lindex $commitinfo($hoverid) 0]
5544 set ymax [lindex [$canv cget -scrollregion] 3]
5545 if {$ymax == {}} return
5546 set yfrac [lindex [$canv yview] 0]
5547 set x [expr {$hoverx + 2 * $linespc}]
5548 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5549 set x0 [expr {$x - 2 * $lthickness}]
5550 set y0 [expr {$y - 2 * $lthickness}]
5551 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5552 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5553 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5554 -fill \#ffff80 -outline black -width 1 -tags hover]
5556 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5561 proc clickisonarrow {id y} {
5564 set ranges [rowranges $id]
5565 set thresh [expr {2 * $lthickness + 6}]
5566 set n [expr {[llength $ranges] - 1}]
5567 for {set i 1} {$i < $n} {incr i} {
5568 set row [lindex $ranges $i]
5569 if {abs([yc $row] - $y) < $thresh} {
5576 proc arrowjump {id n y} {
5579 # 1 <-> 2, 3 <-> 4, etc...
5580 set n [expr {(($n - 1) ^ 1) + 1}]
5581 set row [lindex [rowranges $id] $n]
5583 set ymax [lindex [$canv cget -scrollregion] 3]
5584 if {$ymax eq {} || $ymax <= 0} return
5585 set view [$canv yview]
5586 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5587 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5591 allcanvs yview moveto $yfrac
5594 proc lineclick {x y id isnew} {
5595 global ctext commitinfo children canv thickerline curview
5597 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5602 # draw this line thicker than normal
5606 set ymax [lindex [$canv cget -scrollregion] 3]
5607 if {$ymax eq {}} return
5608 set yfrac [lindex [$canv yview] 0]
5609 set y [expr {$y + $yfrac * $ymax}]
5611 set dirn [clickisonarrow $id $y]
5613 arrowjump $id $dirn $y
5618 addtohistory [list lineclick $x $y $id 0]
5620 # fill the details pane with info about this line
5621 $ctext conf -state normal
5623 $ctext tag conf link -foreground blue -underline 1
5624 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5625 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5626 $ctext insert end "Parent:\t"
5627 $ctext insert end $id [list link link0]
5628 $ctext tag bind link0 <1> [list selbyid $id]
5629 set info $commitinfo($id)
5630 $ctext insert end "\n\t[lindex $info 0]\n"
5631 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5632 set date [formatdate [lindex $info 2]]
5633 $ctext insert end "\tDate:\t$date\n"
5634 set kids $children($curview,$id)
5636 $ctext insert end "\nChildren:"
5638 foreach child $kids {
5640 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5641 set info $commitinfo($child)
5642 $ctext insert end "\n\t"
5643 $ctext insert end $child [list link link$i]
5644 $ctext tag bind link$i <1> [list selbyid $child]
5645 $ctext insert end "\n\t[lindex $info 0]"
5646 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5647 set date [formatdate [lindex $info 2]]
5648 $ctext insert end "\n\tDate:\t$date\n"
5651 $ctext conf -state disabled
5655 proc normalline {} {
5657 if {[info exists thickerline]} {
5665 global commitrow curview
5666 if {[info exists commitrow($curview,$id)]} {
5667 selectline $commitrow($curview,$id) 1
5673 if {![info exists startmstime]} {
5674 set startmstime [clock clicks -milliseconds]
5676 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5679 proc rowmenu {x y id} {
5680 global rowctxmenu commitrow selectedline rowmenuid curview
5681 global nullid nullid2 fakerowmenu mainhead
5684 if {![info exists selectedline]
5685 || $commitrow($curview,$id) eq $selectedline} {
5690 if {$id ne $nullid && $id ne $nullid2} {
5691 set menu $rowctxmenu
5692 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5694 set menu $fakerowmenu
5696 $menu entryconfigure "Diff this*" -state $state
5697 $menu entryconfigure "Diff selected*" -state $state
5698 $menu entryconfigure "Make patch" -state $state
5699 tk_popup $menu $x $y
5702 proc diffvssel {dirn} {
5703 global rowmenuid selectedline displayorder
5705 if {![info exists selectedline]} return
5707 set oldid [lindex $displayorder $selectedline]
5708 set newid $rowmenuid
5710 set oldid $rowmenuid
5711 set newid [lindex $displayorder $selectedline]
5713 addtohistory [list doseldiff $oldid $newid]
5714 doseldiff $oldid $newid
5717 proc doseldiff {oldid newid} {
5721 $ctext conf -state normal
5724 $ctext insert end "From "
5725 $ctext tag conf link -foreground blue -underline 1
5726 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5727 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5728 $ctext tag bind link0 <1> [list selbyid $oldid]
5729 $ctext insert end $oldid [list link link0]
5730 $ctext insert end "\n "
5731 $ctext insert end [lindex $commitinfo($oldid) 0]
5732 $ctext insert end "\n\nTo "
5733 $ctext tag bind link1 <1> [list selbyid $newid]
5734 $ctext insert end $newid [list link link1]
5735 $ctext insert end "\n "
5736 $ctext insert end [lindex $commitinfo($newid) 0]
5737 $ctext insert end "\n"
5738 $ctext conf -state disabled
5739 $ctext tag remove found 1.0 end
5740 startdiff [list $oldid $newid]
5744 global rowmenuid currentid commitinfo patchtop patchnum
5746 if {![info exists currentid]} return
5747 set oldid $currentid
5748 set oldhead [lindex $commitinfo($oldid) 0]
5749 set newid $rowmenuid
5750 set newhead [lindex $commitinfo($newid) 0]
5753 catch {destroy $top}
5755 label $top.title -text "Generate patch"
5756 grid $top.title - -pady 10
5757 label $top.from -text "From:"
5758 entry $top.fromsha1 -width 40 -relief flat
5759 $top.fromsha1 insert 0 $oldid
5760 $top.fromsha1 conf -state readonly
5761 grid $top.from $top.fromsha1 -sticky w
5762 entry $top.fromhead -width 60 -relief flat
5763 $top.fromhead insert 0 $oldhead
5764 $top.fromhead conf -state readonly
5765 grid x $top.fromhead -sticky w
5766 label $top.to -text "To:"
5767 entry $top.tosha1 -width 40 -relief flat
5768 $top.tosha1 insert 0 $newid
5769 $top.tosha1 conf -state readonly
5770 grid $top.to $top.tosha1 -sticky w
5771 entry $top.tohead -width 60 -relief flat
5772 $top.tohead insert 0 $newhead
5773 $top.tohead conf -state readonly
5774 grid x $top.tohead -sticky w
5775 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5776 grid $top.rev x -pady 10
5777 label $top.flab -text "Output file:"
5778 entry $top.fname -width 60
5779 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5781 grid $top.flab $top.fname -sticky w
5783 button $top.buts.gen -text "Generate" -command mkpatchgo
5784 button $top.buts.can -text "Cancel" -command mkpatchcan
5785 grid $top.buts.gen $top.buts.can
5786 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5787 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5788 grid $top.buts - -pady 10 -sticky ew
5792 proc mkpatchrev {} {
5795 set oldid [$patchtop.fromsha1 get]
5796 set oldhead [$patchtop.fromhead get]
5797 set newid [$patchtop.tosha1 get]
5798 set newhead [$patchtop.tohead get]
5799 foreach e [list fromsha1 fromhead tosha1 tohead] \
5800 v [list $newid $newhead $oldid $oldhead] {
5801 $patchtop.$e conf -state normal
5802 $patchtop.$e delete 0 end
5803 $patchtop.$e insert 0 $v
5804 $patchtop.$e conf -state readonly
5809 global patchtop nullid nullid2
5811 set oldid [$patchtop.fromsha1 get]
5812 set newid [$patchtop.tosha1 get]
5813 set fname [$patchtop.fname get]
5814 set cmd [diffcmd [list $oldid $newid] -p]
5815 lappend cmd >$fname &
5816 if {[catch {eval exec $cmd} err]} {
5817 error_popup "Error creating patch: $err"
5819 catch {destroy $patchtop}
5823 proc mkpatchcan {} {
5826 catch {destroy $patchtop}
5831 global rowmenuid mktagtop commitinfo
5835 catch {destroy $top}
5837 label $top.title -text "Create tag"
5838 grid $top.title - -pady 10
5839 label $top.id -text "ID:"
5840 entry $top.sha1 -width 40 -relief flat
5841 $top.sha1 insert 0 $rowmenuid
5842 $top.sha1 conf -state readonly
5843 grid $top.id $top.sha1 -sticky w
5844 entry $top.head -width 60 -relief flat
5845 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5846 $top.head conf -state readonly
5847 grid x $top.head -sticky w
5848 label $top.tlab -text "Tag name:"
5849 entry $top.tag -width 60
5850 grid $top.tlab $top.tag -sticky w
5852 button $top.buts.gen -text "Create" -command mktaggo
5853 button $top.buts.can -text "Cancel" -command mktagcan
5854 grid $top.buts.gen $top.buts.can
5855 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5856 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5857 grid $top.buts - -pady 10 -sticky ew
5862 global mktagtop env tagids idtags
5864 set id [$mktagtop.sha1 get]
5865 set tag [$mktagtop.tag get]
5867 error_popup "No tag name specified"
5870 if {[info exists tagids($tag)]} {
5871 error_popup "Tag \"$tag\" already exists"
5876 set fname [file join $dir "refs/tags" $tag]
5877 set f [open $fname w]
5881 error_popup "Error creating tag: $err"
5885 set tagids($tag) $id
5886 lappend idtags($id) $tag
5891 proc redrawtags {id} {
5892 global canv linehtag commitrow idpos selectedline curview
5893 global mainfont canvxmax iddrawn
5895 if {![info exists commitrow($curview,$id)]} return
5896 if {![info exists iddrawn($id)]} return
5897 drawcommits $commitrow($curview,$id)
5898 $canv delete tag.$id
5899 set xt [eval drawtags $id $idpos($id)]
5900 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5901 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5902 set xr [expr {$xt + [font measure $mainfont $text]}]
5903 if {$xr > $canvxmax} {
5907 if {[info exists selectedline]
5908 && $selectedline == $commitrow($curview,$id)} {
5909 selectline $selectedline 0
5916 catch {destroy $mktagtop}
5925 proc writecommit {} {
5926 global rowmenuid wrcomtop commitinfo wrcomcmd
5928 set top .writecommit
5930 catch {destroy $top}
5932 label $top.title -text "Write commit to file"
5933 grid $top.title - -pady 10
5934 label $top.id -text "ID:"
5935 entry $top.sha1 -width 40 -relief flat
5936 $top.sha1 insert 0 $rowmenuid
5937 $top.sha1 conf -state readonly
5938 grid $top.id $top.sha1 -sticky w
5939 entry $top.head -width 60 -relief flat
5940 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5941 $top.head conf -state readonly
5942 grid x $top.head -sticky w
5943 label $top.clab -text "Command:"
5944 entry $top.cmd -width 60 -textvariable wrcomcmd
5945 grid $top.clab $top.cmd -sticky w -pady 10
5946 label $top.flab -text "Output file:"
5947 entry $top.fname -width 60
5948 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5949 grid $top.flab $top.fname -sticky w
5951 button $top.buts.gen -text "Write" -command wrcomgo
5952 button $top.buts.can -text "Cancel" -command wrcomcan
5953 grid $top.buts.gen $top.buts.can
5954 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5955 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5956 grid $top.buts - -pady 10 -sticky ew
5963 set id [$wrcomtop.sha1 get]
5964 set cmd "echo $id | [$wrcomtop.cmd get]"
5965 set fname [$wrcomtop.fname get]
5966 if {[catch {exec sh -c $cmd >$fname &} err]} {
5967 error_popup "Error writing commit: $err"
5969 catch {destroy $wrcomtop}
5976 catch {destroy $wrcomtop}
5981 global rowmenuid mkbrtop
5984 catch {destroy $top}
5986 label $top.title -text "Create new branch"
5987 grid $top.title - -pady 10
5988 label $top.id -text "ID:"
5989 entry $top.sha1 -width 40 -relief flat
5990 $top.sha1 insert 0 $rowmenuid
5991 $top.sha1 conf -state readonly
5992 grid $top.id $top.sha1 -sticky w
5993 label $top.nlab -text "Name:"
5994 entry $top.name -width 40
5995 grid $top.nlab $top.name -sticky w
5997 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5998 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5999 grid $top.buts.go $top.buts.can
6000 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6001 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6002 grid $top.buts - -pady 10 -sticky ew
6007 global headids idheads
6009 set name [$top.name get]
6010 set id [$top.sha1 get]
6012 error_popup "Please specify a name for the new branch"
6015 catch {destroy $top}
6019 exec git branch $name $id
6024 set headids($name) $id
6025 lappend idheads($id) $name
6033 proc cherrypick {} {
6034 global rowmenuid curview commitrow
6037 set oldhead [exec git rev-parse HEAD]
6038 set dheads [descheads $rowmenuid]
6039 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6040 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6041 included in branch $mainhead -- really re-apply it?"]
6046 # Unfortunately git-cherry-pick writes stuff to stderr even when
6047 # no error occurs, and exec takes that as an indication of error...
6048 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6053 set newhead [exec git rev-parse HEAD]
6054 if {$newhead eq $oldhead} {
6056 error_popup "No changes committed"
6059 addnewchild $newhead $oldhead
6060 if {[info exists commitrow($curview,$oldhead)]} {
6061 insertrow $commitrow($curview,$oldhead) $newhead
6062 if {$mainhead ne {}} {
6063 movehead $newhead $mainhead
6064 movedhead $newhead $mainhead
6073 global mainheadid mainhead rowmenuid confirm_ok resettype
6074 global showlocalchanges
6077 set w ".confirmreset"
6080 wm title $w "Confirm reset"
6081 message $w.m -text \
6082 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6083 -justify center -aspect 1000
6084 pack $w.m -side top -fill x -padx 20 -pady 20
6085 frame $w.f -relief sunken -border 2
6086 message $w.f.rt -text "Reset type:" -aspect 1000
6087 grid $w.f.rt -sticky w
6089 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6090 -text "Soft: Leave working tree and index untouched"
6091 grid $w.f.soft -sticky w
6092 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6093 -text "Mixed: Leave working tree untouched, reset index"
6094 grid $w.f.mixed -sticky w
6095 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6096 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6097 grid $w.f.hard -sticky w
6098 pack $w.f -side top -fill x
6099 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6100 pack $w.ok -side left -fill x -padx 20 -pady 20
6101 button $w.cancel -text Cancel -command "destroy $w"
6102 pack $w.cancel -side right -fill x -padx 20 -pady 20
6103 bind $w <Visibility> "grab $w; focus $w"
6105 if {!$confirm_ok} return
6106 if {[catch {set fd [open \
6107 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6111 set w ".resetprogress"
6112 filerun $fd [list readresetstat $fd $w]
6115 wm title $w "Reset progress"
6116 message $w.m -text "Reset in progress, please wait..." \
6117 -justify center -aspect 1000
6118 pack $w.m -side top -fill x -padx 20 -pady 5
6119 canvas $w.c -width 150 -height 20 -bg white
6120 $w.c create rect 0 0 0 20 -fill green -tags rect
6121 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6126 proc readresetstat {fd w} {
6127 global mainhead mainheadid showlocalchanges
6129 if {[gets $fd line] >= 0} {
6130 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6131 set x [expr {($m * 150) / $n}]
6132 $w.c coords rect 0 0 $x 20
6138 if {[catch {close $fd} err]} {
6141 set oldhead $mainheadid
6142 set newhead [exec git rev-parse HEAD]
6143 if {$newhead ne $oldhead} {
6144 movehead $newhead $mainhead
6145 movedhead $newhead $mainhead
6146 set mainheadid $newhead
6150 if {$showlocalchanges} {
6156 # context menu for a head
6157 proc headmenu {x y id head} {
6158 global headmenuid headmenuhead headctxmenu mainhead
6161 set headmenuhead $head
6163 if {$head eq $mainhead} {
6166 $headctxmenu entryconfigure 0 -state $state
6167 $headctxmenu entryconfigure 1 -state $state
6168 tk_popup $headctxmenu $x $y
6172 global headmenuid headmenuhead mainhead headids
6173 global showlocalchanges mainheadid
6175 # check the tree is clean first??
6176 set oldmainhead $mainhead
6181 exec git checkout -q $headmenuhead
6187 set mainhead $headmenuhead
6188 set mainheadid $headmenuid
6189 if {[info exists headids($oldmainhead)]} {
6190 redrawtags $headids($oldmainhead)
6192 redrawtags $headmenuid
6194 if {$showlocalchanges} {
6200 global headmenuid headmenuhead mainhead
6203 set head $headmenuhead
6205 # this check shouldn't be needed any more...
6206 if {$head eq $mainhead} {
6207 error_popup "Cannot delete the currently checked-out branch"
6210 set dheads [descheads $id]
6211 if {$idheads($dheads) eq $head} {
6212 # the stuff on this branch isn't on any other branch
6213 if {![confirm_popup "The commits on branch $head aren't on any other\
6214 branch.\nReally delete branch $head?"]} return
6218 if {[catch {exec git branch -D $head} err]} {
6223 removehead $id $head
6224 removedhead $id $head
6230 # Stuff for finding nearby tags
6231 proc getallcommits {} {
6232 global allcommits allids nbmp nextarc seeds
6234 if {![info exists allcommits]} {
6242 set cmd [concat | git rev-list --all --parents]
6246 set fd [open $cmd r]
6247 fconfigure $fd -blocking 0
6250 filerun $fd [list getallclines $fd]
6253 # Since most commits have 1 parent and 1 child, we group strings of
6254 # such commits into "arcs" joining branch/merge points (BMPs), which
6255 # are commits that either don't have 1 parent or don't have 1 child.
6257 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6258 # arcout(id) - outgoing arcs for BMP
6259 # arcids(a) - list of IDs on arc including end but not start
6260 # arcstart(a) - BMP ID at start of arc
6261 # arcend(a) - BMP ID at end of arc
6262 # growing(a) - arc a is still growing
6263 # arctags(a) - IDs out of arcids (excluding end) that have tags
6264 # archeads(a) - IDs out of arcids (excluding end) that have heads
6265 # The start of an arc is at the descendent end, so "incoming" means
6266 # coming from descendents, and "outgoing" means going towards ancestors.
6268 proc getallclines {fd} {
6269 global allids allparents allchildren idtags idheads nextarc nbmp
6270 global arcnos arcids arctags arcout arcend arcstart archeads growing
6271 global seeds allcommits
6274 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6275 set id [lindex $line 0]
6276 if {[info exists allparents($id)]} {
6281 set olds [lrange $line 1 end]
6282 set allparents($id) $olds
6283 if {![info exists allchildren($id)]} {
6284 set allchildren($id) {}
6289 if {[llength $olds] == 1 && [llength $a] == 1} {
6290 lappend arcids($a) $id
6291 if {[info exists idtags($id)]} {
6292 lappend arctags($a) $id
6294 if {[info exists idheads($id)]} {
6295 lappend archeads($a) $id
6297 if {[info exists allparents($olds)]} {
6298 # seen parent already
6299 if {![info exists arcout($olds)]} {
6302 lappend arcids($a) $olds
6303 set arcend($a) $olds
6306 lappend allchildren($olds) $id
6307 lappend arcnos($olds) $a
6312 foreach a $arcnos($id) {
6313 lappend arcids($a) $id
6320 lappend allchildren($p) $id
6321 set a [incr nextarc]
6322 set arcstart($a) $id
6329 if {[info exists allparents($p)]} {
6330 # seen it already, may need to make a new branch
6331 if {![info exists arcout($p)]} {
6334 lappend arcids($a) $p
6338 lappend arcnos($p) $a
6343 global cached_dheads cached_dtags cached_atags
6344 catch {unset cached_dheads}
6345 catch {unset cached_dtags}
6346 catch {unset cached_atags}
6349 return [expr {$nid >= 1000? 2: 1}]
6352 if {[incr allcommits -1] == 0} {
6359 proc recalcarc {a} {
6360 global arctags archeads arcids idtags idheads
6364 foreach id [lrange $arcids($a) 0 end-1] {
6365 if {[info exists idtags($id)]} {
6368 if {[info exists idheads($id)]} {
6373 set archeads($a) $ah
6377 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6378 global arcstart arcend arcout allparents growing
6381 if {[llength $a] != 1} {
6382 puts "oops splitarc called but [llength $a] arcs already"
6386 set i [lsearch -exact $arcids($a) $p]
6388 puts "oops splitarc $p not in arc $a"
6391 set na [incr nextarc]
6392 if {[info exists arcend($a)]} {
6393 set arcend($na) $arcend($a)
6395 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6396 set j [lsearch -exact $arcnos($l) $a]
6397 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6399 set tail [lrange $arcids($a) [expr {$i+1}] end]
6400 set arcids($a) [lrange $arcids($a) 0 $i]
6402 set arcstart($na) $p
6404 set arcids($na) $tail
6405 if {[info exists growing($a)]} {
6412 if {[llength $arcnos($id)] == 1} {
6415 set j [lsearch -exact $arcnos($id) $a]
6416 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6420 # reconstruct tags and heads lists
6421 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6426 set archeads($na) {}
6430 # Update things for a new commit added that is a child of one
6431 # existing commit. Used when cherry-picking.
6432 proc addnewchild {id p} {
6433 global allids allparents allchildren idtags nextarc nbmp
6434 global arcnos arcids arctags arcout arcend arcstart archeads growing
6438 set allparents($id) [list $p]
6439 set allchildren($id) {}
6443 lappend allchildren($p) $id
6444 set a [incr nextarc]
6445 set arcstart($a) $id
6448 set arcids($a) [list $p]
6450 if {![info exists arcout($p)]} {
6453 lappend arcnos($p) $a
6454 set arcout($id) [list $a]
6457 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6458 # or 0 if neither is true.
6459 proc anc_or_desc {a b} {
6460 global arcout arcstart arcend arcnos cached_isanc
6462 if {$arcnos($a) eq $arcnos($b)} {
6463 # Both are on the same arc(s); either both are the same BMP,
6464 # or if one is not a BMP, the other is also not a BMP or is
6465 # the BMP at end of the arc (and it only has 1 incoming arc).
6466 # Or both can be BMPs with no incoming arcs.
6467 if {$a eq $b || $arcnos($a) eq {}} {
6470 # assert {[llength $arcnos($a)] == 1}
6471 set arc [lindex $arcnos($a) 0]
6472 set i [lsearch -exact $arcids($arc) $a]
6473 set j [lsearch -exact $arcids($arc) $b]
6474 if {$i < 0 || $i > $j} {
6481 if {![info exists arcout($a)]} {
6482 set arc [lindex $arcnos($a) 0]
6483 if {[info exists arcend($arc)]} {
6484 set aend $arcend($arc)
6488 set a $arcstart($arc)
6492 if {![info exists arcout($b)]} {
6493 set arc [lindex $arcnos($b) 0]
6494 if {[info exists arcend($arc)]} {
6495 set bend $arcend($arc)
6499 set b $arcstart($arc)
6509 if {[info exists cached_isanc($a,$bend)]} {
6510 if {$cached_isanc($a,$bend)} {
6514 if {[info exists cached_isanc($b,$aend)]} {
6515 if {$cached_isanc($b,$aend)} {
6518 if {[info exists cached_isanc($a,$bend)]} {
6523 set todo [list $a $b]
6526 for {set i 0} {$i < [llength $todo]} {incr i} {
6527 set x [lindex $todo $i]
6528 if {$anc($x) eq {}} {
6531 foreach arc $arcnos($x) {
6532 set xd $arcstart($arc)
6534 set cached_isanc($a,$bend) 1
6535 set cached_isanc($b,$aend) 0
6537 } elseif {$xd eq $aend} {
6538 set cached_isanc($b,$aend) 1
6539 set cached_isanc($a,$bend) 0
6542 if {![info exists anc($xd)]} {
6543 set anc($xd) $anc($x)
6545 } elseif {$anc($xd) ne $anc($x)} {
6550 set cached_isanc($a,$bend) 0
6551 set cached_isanc($b,$aend) 0
6555 # This identifies whether $desc has an ancestor that is
6556 # a growing tip of the graph and which is not an ancestor of $anc
6557 # and returns 0 if so and 1 if not.
6558 # If we subsequently discover a tag on such a growing tip, and that
6559 # turns out to be a descendent of $anc (which it could, since we
6560 # don't necessarily see children before parents), then $desc
6561 # isn't a good choice to display as a descendent tag of
6562 # $anc (since it is the descendent of another tag which is
6563 # a descendent of $anc). Similarly, $anc isn't a good choice to
6564 # display as a ancestor tag of $desc.
6566 proc is_certain {desc anc} {
6567 global arcnos arcout arcstart arcend growing problems
6570 if {[llength $arcnos($anc)] == 1} {
6571 # tags on the same arc are certain
6572 if {$arcnos($desc) eq $arcnos($anc)} {
6575 if {![info exists arcout($anc)]} {
6576 # if $anc is partway along an arc, use the start of the arc instead
6577 set a [lindex $arcnos($anc) 0]
6578 set anc $arcstart($a)
6581 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6584 set a [lindex $arcnos($desc) 0]
6590 set anclist [list $x]
6594 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6595 set x [lindex $anclist $i]
6600 foreach a $arcout($x) {
6601 if {[info exists growing($a)]} {
6602 if {![info exists growanc($x)] && $dl($x)} {
6608 if {[info exists dl($y)]} {
6612 if {![info exists done($y)]} {
6615 if {[info exists growanc($x)]} {
6619 for {set k 0} {$k < [llength $xl]} {incr k} {
6620 set z [lindex $xl $k]
6621 foreach c $arcout($z) {
6622 if {[info exists arcend($c)]} {
6624 if {[info exists dl($v)] && $dl($v)} {
6626 if {![info exists done($v)]} {
6629 if {[info exists growanc($v)]} {
6639 } elseif {$y eq $anc || !$dl($x)} {
6650 foreach x [array names growanc] {
6659 proc validate_arctags {a} {
6660 global arctags idtags
6664 foreach id $arctags($a) {
6666 if {![info exists idtags($id)]} {
6667 set na [lreplace $na $i $i]
6674 proc validate_archeads {a} {
6675 global archeads idheads
6678 set na $archeads($a)
6679 foreach id $archeads($a) {
6681 if {![info exists idheads($id)]} {
6682 set na [lreplace $na $i $i]
6686 set archeads($a) $na
6689 # Return the list of IDs that have tags that are descendents of id,
6690 # ignoring IDs that are descendents of IDs already reported.
6691 proc desctags {id} {
6692 global arcnos arcstart arcids arctags idtags allparents
6693 global growing cached_dtags
6695 if {![info exists allparents($id)]} {
6698 set t1 [clock clicks -milliseconds]
6700 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6701 # part-way along an arc; check that arc first
6702 set a [lindex $arcnos($id) 0]
6703 if {$arctags($a) ne {}} {
6705 set i [lsearch -exact $arcids($a) $id]
6707 foreach t $arctags($a) {
6708 set j [lsearch -exact $arcids($a) $t]
6716 set id $arcstart($a)
6717 if {[info exists idtags($id)]} {
6721 if {[info exists cached_dtags($id)]} {
6722 return $cached_dtags($id)
6729 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6730 set id [lindex $todo $i]
6732 set ta [info exists hastaggedancestor($id)]
6736 # ignore tags on starting node
6737 if {!$ta && $i > 0} {
6738 if {[info exists idtags($id)]} {
6741 } elseif {[info exists cached_dtags($id)]} {
6742 set tagloc($id) $cached_dtags($id)
6746 foreach a $arcnos($id) {
6748 if {!$ta && $arctags($a) ne {}} {
6750 if {$arctags($a) ne {}} {
6751 lappend tagloc($id) [lindex $arctags($a) end]
6754 if {$ta || $arctags($a) ne {}} {
6755 set tomark [list $d]
6756 for {set j 0} {$j < [llength $tomark]} {incr j} {
6757 set dd [lindex $tomark $j]
6758 if {![info exists hastaggedancestor($dd)]} {
6759 if {[info exists done($dd)]} {
6760 foreach b $arcnos($dd) {
6761 lappend tomark $arcstart($b)
6763 if {[info exists tagloc($dd)]} {
6766 } elseif {[info exists queued($dd)]} {
6769 set hastaggedancestor($dd) 1
6773 if {![info exists queued($d)]} {
6776 if {![info exists hastaggedancestor($d)]} {
6783 foreach id [array names tagloc] {
6784 if {![info exists hastaggedancestor($id)]} {
6785 foreach t $tagloc($id) {
6786 if {[lsearch -exact $tags $t] < 0} {
6792 set t2 [clock clicks -milliseconds]
6795 # remove tags that are descendents of other tags
6796 for {set i 0} {$i < [llength $tags]} {incr i} {
6797 set a [lindex $tags $i]
6798 for {set j 0} {$j < $i} {incr j} {
6799 set b [lindex $tags $j]
6800 set r [anc_or_desc $a $b]
6802 set tags [lreplace $tags $j $j]
6805 } elseif {$r == -1} {
6806 set tags [lreplace $tags $i $i]
6813 if {[array names growing] ne {}} {
6814 # graph isn't finished, need to check if any tag could get
6815 # eclipsed by another tag coming later. Simply ignore any
6816 # tags that could later get eclipsed.
6819 if {[is_certain $t $origid]} {
6823 if {$tags eq $ctags} {
6824 set cached_dtags($origid) $tags
6829 set cached_dtags($origid) $tags
6831 set t3 [clock clicks -milliseconds]
6832 if {0 && $t3 - $t1 >= 100} {
6833 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6834 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6840 global arcnos arcids arcout arcend arctags idtags allparents
6841 global growing cached_atags
6843 if {![info exists allparents($id)]} {
6846 set t1 [clock clicks -milliseconds]
6848 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6849 # part-way along an arc; check that arc first
6850 set a [lindex $arcnos($id) 0]
6851 if {$arctags($a) ne {}} {
6853 set i [lsearch -exact $arcids($a) $id]
6854 foreach t $arctags($a) {
6855 set j [lsearch -exact $arcids($a) $t]
6861 if {![info exists arcend($a)]} {
6865 if {[info exists idtags($id)]} {
6869 if {[info exists cached_atags($id)]} {
6870 return $cached_atags($id)
6878 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6879 set id [lindex $todo $i]
6881 set td [info exists hastaggeddescendent($id)]
6885 # ignore tags on starting node
6886 if {!$td && $i > 0} {
6887 if {[info exists idtags($id)]} {
6890 } elseif {[info exists cached_atags($id)]} {
6891 set tagloc($id) $cached_atags($id)
6895 foreach a $arcout($id) {
6896 if {!$td && $arctags($a) ne {}} {
6898 if {$arctags($a) ne {}} {
6899 lappend tagloc($id) [lindex $arctags($a) 0]
6902 if {![info exists arcend($a)]} continue
6904 if {$td || $arctags($a) ne {}} {
6905 set tomark [list $d]
6906 for {set j 0} {$j < [llength $tomark]} {incr j} {
6907 set dd [lindex $tomark $j]
6908 if {![info exists hastaggeddescendent($dd)]} {
6909 if {[info exists done($dd)]} {
6910 foreach b $arcout($dd) {
6911 if {[info exists arcend($b)]} {
6912 lappend tomark $arcend($b)
6915 if {[info exists tagloc($dd)]} {
6918 } elseif {[info exists queued($dd)]} {
6921 set hastaggeddescendent($dd) 1
6925 if {![info exists queued($d)]} {
6928 if {![info exists hastaggeddescendent($d)]} {
6934 set t2 [clock clicks -milliseconds]
6937 foreach id [array names tagloc] {
6938 if {![info exists hastaggeddescendent($id)]} {
6939 foreach t $tagloc($id) {
6940 if {[lsearch -exact $tags $t] < 0} {
6947 # remove tags that are ancestors of other tags
6948 for {set i 0} {$i < [llength $tags]} {incr i} {
6949 set a [lindex $tags $i]
6950 for {set j 0} {$j < $i} {incr j} {
6951 set b [lindex $tags $j]
6952 set r [anc_or_desc $a $b]
6954 set tags [lreplace $tags $j $j]
6957 } elseif {$r == 1} {
6958 set tags [lreplace $tags $i $i]
6965 if {[array names growing] ne {}} {
6966 # graph isn't finished, need to check if any tag could get
6967 # eclipsed by another tag coming later. Simply ignore any
6968 # tags that could later get eclipsed.
6971 if {[is_certain $origid $t]} {
6975 if {$tags eq $ctags} {
6976 set cached_atags($origid) $tags
6981 set cached_atags($origid) $tags
6983 set t3 [clock clicks -milliseconds]
6984 if {0 && $t3 - $t1 >= 100} {
6985 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6986 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6991 # Return the list of IDs that have heads that are descendents of id,
6992 # including id itself if it has a head.
6993 proc descheads {id} {
6994 global arcnos arcstart arcids archeads idheads cached_dheads
6997 if {![info exists allparents($id)]} {
7001 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7002 # part-way along an arc; check it first
7003 set a [lindex $arcnos($id) 0]
7004 if {$archeads($a) ne {}} {
7005 validate_archeads $a
7006 set i [lsearch -exact $arcids($a) $id]
7007 foreach t $archeads($a) {
7008 set j [lsearch -exact $arcids($a) $t]
7013 set id $arcstart($a)
7019 for {set i 0} {$i < [llength $todo]} {incr i} {
7020 set id [lindex $todo $i]
7021 if {[info exists cached_dheads($id)]} {
7022 set ret [concat $ret $cached_dheads($id)]
7024 if {[info exists idheads($id)]} {
7027 foreach a $arcnos($id) {
7028 if {$archeads($a) ne {}} {
7029 validate_archeads $a
7030 if {$archeads($a) ne {}} {
7031 set ret [concat $ret $archeads($a)]
7035 if {![info exists seen($d)]} {
7042 set ret [lsort -unique $ret]
7043 set cached_dheads($origid) $ret
7044 return [concat $ret $aret]
7047 proc addedtag {id} {
7048 global arcnos arcout cached_dtags cached_atags
7050 if {![info exists arcnos($id)]} return
7051 if {![info exists arcout($id)]} {
7052 recalcarc [lindex $arcnos($id) 0]
7054 catch {unset cached_dtags}
7055 catch {unset cached_atags}
7058 proc addedhead {hid head} {
7059 global arcnos arcout cached_dheads
7061 if {![info exists arcnos($hid)]} return
7062 if {![info exists arcout($hid)]} {
7063 recalcarc [lindex $arcnos($hid) 0]
7065 catch {unset cached_dheads}
7068 proc removedhead {hid head} {
7069 global cached_dheads
7071 catch {unset cached_dheads}
7074 proc movedhead {hid head} {
7075 global arcnos arcout cached_dheads
7077 if {![info exists arcnos($hid)]} return
7078 if {![info exists arcout($hid)]} {
7079 recalcarc [lindex $arcnos($hid) 0]
7081 catch {unset cached_dheads}
7084 proc changedrefs {} {
7085 global cached_dheads cached_dtags cached_atags
7086 global arctags archeads arcnos arcout idheads idtags
7088 foreach id [concat [array names idheads] [array names idtags]] {
7089 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7090 set a [lindex $arcnos($id) 0]
7091 if {![info exists donearc($a)]} {
7097 catch {unset cached_dtags}
7098 catch {unset cached_atags}
7099 catch {unset cached_dheads}
7102 proc rereadrefs {} {
7103 global idtags idheads idotherrefs mainhead
7105 set refids [concat [array names idtags] \
7106 [array names idheads] [array names idotherrefs]]
7107 foreach id $refids {
7108 if {![info exists ref($id)]} {
7109 set ref($id) [listrefs $id]
7112 set oldmainhead $mainhead
7115 set refids [lsort -unique [concat $refids [array names idtags] \
7116 [array names idheads] [array names idotherrefs]]]
7117 foreach id $refids {
7118 set v [listrefs $id]
7119 if {![info exists ref($id)] || $ref($id) != $v ||
7120 ($id eq $oldmainhead && $id ne $mainhead) ||
7121 ($id eq $mainhead && $id ne $oldmainhead)} {
7127 proc listrefs {id} {
7128 global idtags idheads idotherrefs
7131 if {[info exists idtags($id)]} {
7135 if {[info exists idheads($id)]} {
7139 if {[info exists idotherrefs($id)]} {
7140 set z $idotherrefs($id)
7142 return [list $x $y $z]
7145 proc showtag {tag isnew} {
7146 global ctext tagcontents tagids linknum tagobjid
7149 addtohistory [list showtag $tag 0]
7151 $ctext conf -state normal
7154 if {![info exists tagcontents($tag)]} {
7156 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7159 if {[info exists tagcontents($tag)]} {
7160 set text $tagcontents($tag)
7162 set text "Tag: $tag\nId: $tagids($tag)"
7164 appendwithlinks $text {}
7165 $ctext conf -state disabled
7177 global maxwidth maxgraphpct diffopts
7178 global oldprefs prefstop showneartags showlocalchanges
7179 global bgcolor fgcolor ctext diffcolors selectbgcolor
7180 global uifont tabstop
7184 if {[winfo exists $top]} {
7188 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7189 set oldprefs($v) [set $v]
7192 wm title $top "Gitk preferences"
7193 label $top.ldisp -text "Commit list display options"
7194 $top.ldisp configure -font $uifont
7195 grid $top.ldisp - -sticky w -pady 10
7196 label $top.spacer -text " "
7197 label $top.maxwidthl -text "Maximum graph width (lines)" \
7199 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7200 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7201 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7203 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7204 grid x $top.maxpctl $top.maxpct -sticky w
7205 frame $top.showlocal
7206 label $top.showlocal.l -text "Show local changes" -font optionfont
7207 checkbutton $top.showlocal.b -variable showlocalchanges
7208 pack $top.showlocal.b $top.showlocal.l -side left
7209 grid x $top.showlocal -sticky w
7211 label $top.ddisp -text "Diff display options"
7212 $top.ddisp configure -font $uifont
7213 grid $top.ddisp - -sticky w -pady 10
7214 label $top.diffoptl -text "Options for diff program" \
7216 entry $top.diffopt -width 20 -textvariable diffopts
7217 grid x $top.diffoptl $top.diffopt -sticky w
7219 label $top.ntag.l -text "Display nearby tags" -font optionfont
7220 checkbutton $top.ntag.b -variable showneartags
7221 pack $top.ntag.b $top.ntag.l -side left
7222 grid x $top.ntag -sticky w
7223 label $top.tabstopl -text "tabstop" -font optionfont
7224 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7225 grid x $top.tabstopl $top.tabstop -sticky w
7227 label $top.cdisp -text "Colors: press to choose"
7228 $top.cdisp configure -font $uifont
7229 grid $top.cdisp - -sticky w -pady 10
7230 label $top.bg -padx 40 -relief sunk -background $bgcolor
7231 button $top.bgbut -text "Background" -font optionfont \
7232 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7233 grid x $top.bgbut $top.bg -sticky w
7234 label $top.fg -padx 40 -relief sunk -background $fgcolor
7235 button $top.fgbut -text "Foreground" -font optionfont \
7236 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7237 grid x $top.fgbut $top.fg -sticky w
7238 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7239 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7240 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7241 [list $ctext tag conf d0 -foreground]]
7242 grid x $top.diffoldbut $top.diffold -sticky w
7243 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7244 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7245 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7246 [list $ctext tag conf d1 -foreground]]
7247 grid x $top.diffnewbut $top.diffnew -sticky w
7248 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7249 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7250 -command [list choosecolor diffcolors 2 $top.hunksep \
7251 "diff hunk header" \
7252 [list $ctext tag conf hunksep -foreground]]
7253 grid x $top.hunksepbut $top.hunksep -sticky w
7254 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7255 button $top.selbgbut -text "Select bg" -font optionfont \
7256 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7257 grid x $top.selbgbut $top.selbgsep -sticky w
7260 button $top.buts.ok -text "OK" -command prefsok -default active
7261 $top.buts.ok configure -font $uifont
7262 button $top.buts.can -text "Cancel" -command prefscan -default normal
7263 $top.buts.can configure -font $uifont
7264 grid $top.buts.ok $top.buts.can
7265 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7266 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7267 grid $top.buts - - -pady 10 -sticky ew
7268 bind $top <Visibility> "focus $top.buts.ok"
7271 proc choosecolor {v vi w x cmd} {
7274 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7275 -title "Gitk: choose color for $x"]
7276 if {$c eq {}} return
7277 $w conf -background $c
7283 global bglist cflist
7285 $w configure -selectbackground $c
7287 $cflist tag configure highlight \
7288 -background [$cflist cget -selectbackground]
7289 allcanvs itemconf secsel -fill $c
7296 $w conf -background $c
7304 $w conf -foreground $c
7306 allcanvs itemconf text -fill $c
7307 $canv itemconf circle -outline $c
7311 global maxwidth maxgraphpct diffopts
7312 global oldprefs prefstop showneartags showlocalchanges
7314 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7315 set $v $oldprefs($v)
7317 catch {destroy $prefstop}
7322 global maxwidth maxgraphpct
7323 global oldprefs prefstop showneartags showlocalchanges
7324 global charspc ctext tabstop
7326 catch {destroy $prefstop}
7328 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7329 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7330 if {$showlocalchanges} {
7336 if {$maxwidth != $oldprefs(maxwidth)
7337 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7339 } elseif {$showneartags != $oldprefs(showneartags)} {
7344 proc formatdate {d} {
7345 global datetimeformat
7347 set d [clock format $d -format $datetimeformat]
7352 # This list of encoding names and aliases is distilled from
7353 # http://www.iana.org/assignments/character-sets.
7354 # Not all of them are supported by Tcl.
7355 set encoding_aliases {
7356 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7357 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7358 { ISO-10646-UTF-1 csISO10646UTF1 }
7359 { ISO_646.basic:1983 ref csISO646basic1983 }
7360 { INVARIANT csINVARIANT }
7361 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7362 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7363 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7364 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7365 { NATS-DANO iso-ir-9-1 csNATSDANO }
7366 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7367 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7368 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7369 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7370 { ISO-2022-KR csISO2022KR }
7372 { ISO-2022-JP csISO2022JP }
7373 { ISO-2022-JP-2 csISO2022JP2 }
7374 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7376 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7377 { IT iso-ir-15 ISO646-IT csISO15Italian }
7378 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7379 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7380 { greek7-old iso-ir-18 csISO18Greek7Old }
7381 { latin-greek iso-ir-19 csISO19LatinGreek }
7382 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7383 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7384 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7385 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7386 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7387 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7388 { INIS iso-ir-49 csISO49INIS }
7389 { INIS-8 iso-ir-50 csISO50INIS8 }
7390 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7391 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7392 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7393 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7394 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7395 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7397 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7398 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7399 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7400 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7401 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7402 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7403 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7404 { greek7 iso-ir-88 csISO88Greek7 }
7405 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7406 { iso-ir-90 csISO90 }
7407 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7408 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7409 csISO92JISC62991984b }
7410 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7411 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7412 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7413 csISO95JIS62291984handadd }
7414 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7415 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7416 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7417 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7419 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7420 { T.61-7bit iso-ir-102 csISO102T617bit }
7421 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7422 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7423 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7424 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7425 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7426 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7427 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7428 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7429 arabic csISOLatinArabic }
7430 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7431 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7432 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7433 greek greek8 csISOLatinGreek }
7434 { T.101-G2 iso-ir-128 csISO128T101G2 }
7435 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7437 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7438 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7439 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7440 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7441 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7442 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7443 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7444 csISOLatinCyrillic }
7445 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7446 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7447 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7448 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7449 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7450 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7451 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7452 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7453 { ISO_10367-box iso-ir-155 csISO10367Box }
7454 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7455 { latin-lap lap iso-ir-158 csISO158Lap }
7456 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7457 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7460 { JIS_X0201 X0201 csHalfWidthKatakana }
7461 { KSC5636 ISO646-KR csKSC5636 }
7462 { ISO-10646-UCS-2 csUnicode }
7463 { ISO-10646-UCS-4 csUCS4 }
7464 { DEC-MCS dec csDECMCS }
7465 { hp-roman8 roman8 r8 csHPRoman8 }
7466 { macintosh mac csMacintosh }
7467 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7469 { IBM038 EBCDIC-INT cp038 csIBM038 }
7470 { IBM273 CP273 csIBM273 }
7471 { IBM274 EBCDIC-BE CP274 csIBM274 }
7472 { IBM275 EBCDIC-BR cp275 csIBM275 }
7473 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7474 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7475 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7476 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7477 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7478 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7479 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7480 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7481 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7482 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7483 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7484 { IBM437 cp437 437 csPC8CodePage437 }
7485 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7486 { IBM775 cp775 csPC775Baltic }
7487 { IBM850 cp850 850 csPC850Multilingual }
7488 { IBM851 cp851 851 csIBM851 }
7489 { IBM852 cp852 852 csPCp852 }
7490 { IBM855 cp855 855 csIBM855 }
7491 { IBM857 cp857 857 csIBM857 }
7492 { IBM860 cp860 860 csIBM860 }
7493 { IBM861 cp861 861 cp-is csIBM861 }
7494 { IBM862 cp862 862 csPC862LatinHebrew }
7495 { IBM863 cp863 863 csIBM863 }
7496 { IBM864 cp864 csIBM864 }
7497 { IBM865 cp865 865 csIBM865 }
7498 { IBM866 cp866 866 csIBM866 }
7499 { IBM868 CP868 cp-ar csIBM868 }
7500 { IBM869 cp869 869 cp-gr csIBM869 }
7501 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7502 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7503 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7504 { IBM891 cp891 csIBM891 }
7505 { IBM903 cp903 csIBM903 }
7506 { IBM904 cp904 904 csIBBM904 }
7507 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7508 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7509 { IBM1026 CP1026 csIBM1026 }
7510 { EBCDIC-AT-DE csIBMEBCDICATDE }
7511 { EBCDIC-AT-DE-A csEBCDICATDEA }
7512 { EBCDIC-CA-FR csEBCDICCAFR }
7513 { EBCDIC-DK-NO csEBCDICDKNO }
7514 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7515 { EBCDIC-FI-SE csEBCDICFISE }
7516 { EBCDIC-FI-SE-A csEBCDICFISEA }
7517 { EBCDIC-FR csEBCDICFR }
7518 { EBCDIC-IT csEBCDICIT }
7519 { EBCDIC-PT csEBCDICPT }
7520 { EBCDIC-ES csEBCDICES }
7521 { EBCDIC-ES-A csEBCDICESA }
7522 { EBCDIC-ES-S csEBCDICESS }
7523 { EBCDIC-UK csEBCDICUK }
7524 { EBCDIC-US csEBCDICUS }
7525 { UNKNOWN-8BIT csUnknown8BiT }
7526 { MNEMONIC csMnemonic }
7531 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7532 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7533 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7534 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7535 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7536 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7537 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7538 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7539 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7540 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7541 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7542 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7543 { IBM1047 IBM-1047 }
7544 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7545 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7546 { UNICODE-1-1 csUnicode11 }
7549 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7550 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7552 { ISO-8859-15 ISO_8859-15 Latin-9 }
7553 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7554 { GBK CP936 MS936 windows-936 }
7555 { JIS_Encoding csJISEncoding }
7556 { Shift_JIS MS_Kanji csShiftJIS }
7557 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7559 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7560 { ISO-10646-UCS-Basic csUnicodeASCII }
7561 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7562 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7563 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7564 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7565 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7566 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7567 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7568 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7569 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7570 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7571 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7572 { Ventura-US csVenturaUS }
7573 { Ventura-International csVenturaInternational }
7574 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7575 { PC8-Turkish csPC8Turkish }
7576 { IBM-Symbols csIBMSymbols }
7577 { IBM-Thai csIBMThai }
7578 { HP-Legal csHPLegal }
7579 { HP-Pi-font csHPPiFont }
7580 { HP-Math8 csHPMath8 }
7581 { Adobe-Symbol-Encoding csHPPSMath }
7582 { HP-DeskTop csHPDesktop }
7583 { Ventura-Math csVenturaMath }
7584 { Microsoft-Publishing csMicrosoftPublishing }
7585 { Windows-31J csWindows31J }
7590 proc tcl_encoding {enc} {
7591 global encoding_aliases
7592 set names [encoding names]
7593 set lcnames [string tolower $names]
7594 set enc [string tolower $enc]
7595 set i [lsearch -exact $lcnames $enc]
7597 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7598 if {[regsub {^iso[-_]} $enc iso encx]} {
7599 set i [lsearch -exact $lcnames $encx]
7603 foreach l $encoding_aliases {
7604 set ll [string tolower $l]
7605 if {[lsearch -exact $ll $enc] < 0} continue
7606 # look through the aliases for one that tcl knows about
7608 set i [lsearch -exact $lcnames $e]
7610 if {[regsub {^iso[-_]} $e iso ex]} {
7611 set i [lsearch -exact $lcnames $ex]
7620 return [lindex $names $i]
7627 set diffopts "-U 5 -p"
7628 set wrcomcmd "git diff-tree --stdin -p --pretty"
7632 set gitencoding [exec git config --get i18n.commitencoding]
7634 if {$gitencoding == ""} {
7635 set gitencoding "utf-8"
7637 set tclencoding [tcl_encoding $gitencoding]
7638 if {$tclencoding == {}} {
7639 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7642 set mainfont {Helvetica 9}
7643 set textfont {Courier 9}
7644 set uifont {Helvetica 9 bold}
7646 set findmergefiles 0
7654 set cmitmode "patch"
7655 set wrapcomment "none"
7659 set showlocalchanges 1
7660 set datetimeformat "%Y-%m-%d %H:%M:%S"
7662 set colors {green red blue magenta darkgrey brown orange}
7665 set diffcolors {red "#00a000" blue}
7667 set selectbgcolor gray85
7669 catch {source ~/.gitk}
7671 font create optionfont -family sans-serif -size -12
7673 # check that we can find a .git directory somewhere...
7674 if {[catch {set gitdir [gitdir]}]} {
7675 show_error {} . "Cannot find a git repository here."
7678 if {![file isdirectory $gitdir]} {
7679 show_error {} . "Cannot find the git directory \"$gitdir\"."
7684 set cmdline_files {}
7689 "-d" { set datemode 1 }
7691 set cmdline_files [lrange $argv [expr {$i + 1}] end]
7695 lappend revtreeargs $arg
7701 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7702 # no -- on command line, but some arguments (other than -d)
7704 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7705 set cmdline_files [split $f "\n"]
7706 set n [llength $cmdline_files]
7707 set revtreeargs [lrange $revtreeargs 0 end-$n]
7708 # Unfortunately git rev-parse doesn't produce an error when
7709 # something is both a revision and a filename. To be consistent
7710 # with git log and git rev-list, check revtreeargs for filenames.
7711 foreach arg $revtreeargs {
7712 if {[file exists $arg]} {
7713 show_error {} . "Ambiguous argument '$arg': both revision\
7719 # unfortunately we get both stdout and stderr in $err,
7720 # so look for "fatal:".
7721 set i [string first "fatal:" $err]
7723 set err [string range $err [expr {$i + 6}] end]
7725 show_error {} . "Bad arguments to gitk:\n$err"
7730 set nullid "0000000000000000000000000000000000000000"
7731 set nullid2 "0000000000000000000000000000000000000001"
7739 set highlight_paths {}
7740 set searchdirn -forwards
7744 set markingmatches 0
7751 set selectedhlview None
7760 set lookingforhead 0
7766 # wait for the window to become visible
7768 wm title . "[file tail $argv0]: [file tail [pwd]]"
7771 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7772 # create a view for the files/dirs specified on the command line
7776 set viewname(1) "Command line"
7777 set viewfiles(1) $cmdline_files
7778 set viewargs(1) $revtreeargs
7781 .bar.view entryconf Edit* -state normal
7782 .bar.view entryconf Delete* -state normal
7785 if {[info exists permviews]} {
7786 foreach v $permviews {
7789 set viewname($n) [lindex $v 0]
7790 set viewfiles($n) [lindex $v 1]
7791 set viewargs($n) [lindex $v 2]