Merge branch 'master' into dev
[git.git] / gitk
blob135511e9fb3e93a54ebb0301e3d15ddceba4ce38
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
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.
24 proc run args {
25 global isonrunq runq
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {}} {
30 after idle dorunq
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} {
41 global runq
43 fileevent $fd readable {}
44 if {$runq eq {}} {
45 after idle dorunq
47 lappend runq [list $fd $script]
50 proc dorunq {} {
51 global isonrunq runq
53 set tstart [clock clicks -milliseconds]
54 set t0 $tstart
55 while {$runq ne {}} {
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]
67 } else {
68 fileevent $fd readable [list filereadable $fd $script]
70 } elseif {$fd eq {}} {
71 unset isonrunq($script)
73 set t0 $t1
74 if {$t1 - $tstart >= 80} break
76 if {$runq ne {}} {
77 after idle dorunq
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list {view} {
83 global startmsecs
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx viewcomplete vnextroot
86 global showlocalchanges commitinterest mainheadid
87 global progressdirn progresscoords proglastnc curview
89 set startmsecs [clock clicks -milliseconds]
90 set commitidx($view) 0
91 set viewcomplete($view) 0
92 set vnextroot($view) 0
93 set order "--topo-order"
94 if {$datemode} {
95 set order "--date-order"
97 if {[catch {
98 set fd [open [concat | git log --no-color -z --pretty=raw $order --parents \
99 --boundary $viewargs($view) "--" $viewfiles($view)] r]
100 } err]} {
101 error_popup "Error executing git rev-list: $err"
102 exit 1
104 set commfd($view) $fd
105 set leftover($view) {}
106 if {$showlocalchanges} {
107 lappend commitinterest($mainheadid) {dodiffindex}
109 fconfigure $fd -blocking 0 -translation lf -eofchar {}
110 if {$tclencoding != {}} {
111 fconfigure $fd -encoding $tclencoding
113 filerun $fd [list getcommitlines $fd $view]
114 nowbusy $view "Reading"
115 if {$view == $curview} {
116 set progressdirn 1
117 set progresscoords {0 0}
118 set proglastnc 0
122 proc stop_rev_list {} {
123 global commfd curview
125 if {![info exists commfd($curview)]} return
126 set fd $commfd($curview)
127 catch {
128 set pid [pid $fd]
129 exec kill $pid
131 catch {close $fd}
132 unset commfd($curview)
135 proc getcommits {} {
136 global phase canv curview
138 set phase getcommits
139 initlayout
140 start_rev_list $curview
141 show_status "Reading commits..."
144 # This makes a string representation of a positive integer which
145 # sorts as a string in numerical order
146 proc strrep {n} {
147 if {$n < 16} {
148 return [format "%x" $n]
149 } elseif {$n < 256} {
150 return [format "x%.2x" $n]
151 } elseif {$n < 65536} {
152 return [format "y%.4x" $n]
154 return [format "z%.8x" $n]
157 proc getcommitlines {fd view} {
158 global commitlisted commitinterest
159 global leftover commfd
160 global displayorder commitidx viewcomplete commitrow commitdata
161 global parentlist children curview hlview
162 global vparentlist vdisporder vcmitlisted
163 global ordertok vnextroot idpending
165 set stuff [read $fd 500000]
166 # git log doesn't terminate the last commit with a null...
167 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
168 set stuff "\0"
170 if {$stuff == {}} {
171 if {![eof $fd]} {
172 return 1
174 # Check if we have seen any ids listed as parents that haven't
175 # appeared in the list
176 foreach vid [array names idpending "$view,*"] {
177 # should only get here if git log is buggy
178 set id [lindex [split $vid ","] 1]
179 set commitrow($vid) $commitidx($view)
180 incr commitidx($view)
181 if {$view == $curview} {
182 lappend parentlist {}
183 lappend displayorder $id
184 lappend commitlisted 0
185 } else {
186 lappend vparentlist($view) {}
187 lappend vdisporder($view) $id
188 lappend vcmitlisted($view) 0
191 set viewcomplete($view) 1
192 global viewname progresscoords
193 unset commfd($view)
194 notbusy $view
195 set progresscoords {0 0}
196 adjustprogress
197 # set it blocking so we wait for the process to terminate
198 fconfigure $fd -blocking 1
199 if {[catch {close $fd} err]} {
200 set fv {}
201 if {$view != $curview} {
202 set fv " for the \"$viewname($view)\" view"
204 if {[string range $err 0 4] == "usage"} {
205 set err "Gitk: error reading commits$fv:\
206 bad arguments to git rev-list."
207 if {$viewname($view) eq "Command line"} {
208 append err \
209 " (Note: arguments to gitk are passed to git rev-list\
210 to allow selection of commits to be displayed.)"
212 } else {
213 set err "Error reading commits$fv: $err"
215 error_popup $err
217 if {$view == $curview} {
218 run chewcommits $view
220 return 0
222 set start 0
223 set gotsome 0
224 while 1 {
225 set i [string first "\0" $stuff $start]
226 if {$i < 0} {
227 append leftover($view) [string range $stuff $start end]
228 break
230 if {$start == 0} {
231 set cmit $leftover($view)
232 append cmit [string range $stuff 0 [expr {$i - 1}]]
233 set leftover($view) {}
234 } else {
235 set cmit [string range $stuff $start [expr {$i - 1}]]
237 set start [expr {$i + 1}]
238 set j [string first "\n" $cmit]
239 set ok 0
240 set listed 1
241 if {$j >= 0 && [string match "commit *" $cmit]} {
242 set ids [string range $cmit 7 [expr {$j - 1}]]
243 if {[string match {[-<>]*} $ids]} {
244 switch -- [string index $ids 0] {
245 "-" {set listed 0}
246 "<" {set listed 2}
247 ">" {set listed 3}
249 set ids [string range $ids 1 end]
251 set ok 1
252 foreach id $ids {
253 if {[string length $id] != 40} {
254 set ok 0
255 break
259 if {!$ok} {
260 set shortcmit $cmit
261 if {[string length $shortcmit] > 80} {
262 set shortcmit "[string range $shortcmit 0 80]..."
264 error_popup "Can't parse git log output: {$shortcmit}"
265 exit 1
267 set id [lindex $ids 0]
268 if {![info exists ordertok($view,$id)]} {
269 set otok "o[strrep $vnextroot($view)]"
270 incr vnextroot($view)
271 set ordertok($view,$id) $otok
272 } else {
273 set otok $ordertok($view,$id)
274 unset idpending($view,$id)
276 if {$listed} {
277 set olds [lrange $ids 1 end]
278 if {[llength $olds] == 1} {
279 set p [lindex $olds 0]
280 lappend children($view,$p) $id
281 if {![info exists ordertok($view,$p)]} {
282 set ordertok($view,$p) $ordertok($view,$id)
283 set idpending($view,$p) 1
285 } else {
286 set i 0
287 foreach p $olds {
288 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
289 lappend children($view,$p) $id
291 if {![info exists ordertok($view,$p)]} {
292 set ordertok($view,$p) "$otok[strrep $i]]"
293 set idpending($view,$p) 1
295 incr i
298 } else {
299 set olds {}
301 if {![info exists children($view,$id)]} {
302 set children($view,$id) {}
304 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
305 set commitrow($view,$id) $commitidx($view)
306 incr commitidx($view)
307 if {$view == $curview} {
308 lappend parentlist $olds
309 lappend displayorder $id
310 lappend commitlisted $listed
311 } else {
312 lappend vparentlist($view) $olds
313 lappend vdisporder($view) $id
314 lappend vcmitlisted($view) $listed
316 if {[info exists commitinterest($id)]} {
317 foreach script $commitinterest($id) {
318 eval [string map [list "%I" $id] $script]
320 unset commitinterest($id)
322 set gotsome 1
324 if {$gotsome} {
325 run chewcommits $view
326 if {$view == $curview} {
327 # update progress bar
328 global progressdirn progresscoords proglastnc
329 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
330 set proglastnc $commitidx($view)
331 set l [lindex $progresscoords 0]
332 set r [lindex $progresscoords 1]
333 if {$progressdirn} {
334 set r [expr {$r + $inc}]
335 if {$r >= 1.0} {
336 set r 1.0
337 set progressdirn 0
339 if {$r > 0.2} {
340 set l [expr {$r - 0.2}]
342 } else {
343 set l [expr {$l - $inc}]
344 if {$l <= 0.0} {
345 set l 0.0
346 set progressdirn 1
348 set r [expr {$l + 0.2}]
350 set progresscoords [list $l $r]
351 adjustprogress
354 return 2
357 proc chewcommits {view} {
358 global curview hlview viewcomplete
359 global selectedline pending_select
361 if {$view == $curview} {
362 layoutmore
363 if {$viewcomplete($view)} {
364 global displayorder commitidx phase
365 global numcommits startmsecs
367 if {[info exists pending_select]} {
368 set row [first_real_row]
369 selectline $row 1
371 if {$commitidx($curview) > 0} {
372 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
373 #puts "overall $ms ms for $numcommits commits"
374 } else {
375 show_status "No commits selected"
377 notbusy layout
378 set phase {}
381 if {[info exists hlview] && $view == $hlview} {
382 vhighlightmore
384 return 0
387 proc readcommit {id} {
388 if {[catch {set contents [exec git cat-file commit $id]}]} return
389 parsecommit $id $contents 0
392 proc updatecommits {} {
393 global viewdata curview phase displayorder ordertok idpending
394 global children commitrow selectedline thickerline showneartags
396 if {$phase ne {}} {
397 stop_rev_list
398 set phase {}
400 set n $curview
401 foreach id $displayorder {
402 catch {unset children($n,$id)}
403 catch {unset commitrow($n,$id)}
404 catch {unset ordertok($n,$id)}
406 foreach vid [array names idpending "$n,*"] {
407 unset idpending($vid)
409 set curview -1
410 catch {unset selectedline}
411 catch {unset thickerline}
412 catch {unset viewdata($n)}
413 readrefs
414 changedrefs
415 if {$showneartags} {
416 getallcommits
418 showview $n
421 proc parsecommit {id contents listed} {
422 global commitinfo cdate
424 set inhdr 1
425 set comment {}
426 set headline {}
427 set auname {}
428 set audate {}
429 set comname {}
430 set comdate {}
431 set hdrend [string first "\n\n" $contents]
432 if {$hdrend < 0} {
433 # should never happen...
434 set hdrend [string length $contents]
436 set header [string range $contents 0 [expr {$hdrend - 1}]]
437 set comment [string range $contents [expr {$hdrend + 2}] end]
438 foreach line [split $header "\n"] {
439 set tag [lindex $line 0]
440 if {$tag == "author"} {
441 set audate [lindex $line end-1]
442 set auname [lrange $line 1 end-2]
443 } elseif {$tag == "committer"} {
444 set comdate [lindex $line end-1]
445 set comname [lrange $line 1 end-2]
448 set headline {}
449 # take the first non-blank line of the comment as the headline
450 set headline [string trimleft $comment]
451 set i [string first "\n" $headline]
452 if {$i >= 0} {
453 set headline [string range $headline 0 $i]
455 set headline [string trimright $headline]
456 set i [string first "\r" $headline]
457 if {$i >= 0} {
458 set headline [string trimright [string range $headline 0 $i]]
460 if {!$listed} {
461 # git rev-list indents the comment by 4 spaces;
462 # if we got this via git cat-file, add the indentation
463 set newcomment {}
464 foreach line [split $comment "\n"] {
465 append newcomment " "
466 append newcomment $line
467 append newcomment "\n"
469 set comment $newcomment
471 if {$comdate != {}} {
472 set cdate($id) $comdate
474 set commitinfo($id) [list $headline $auname $audate \
475 $comname $comdate $comment]
478 proc getcommit {id} {
479 global commitdata commitinfo
481 if {[info exists commitdata($id)]} {
482 parsecommit $id $commitdata($id) 1
483 } else {
484 readcommit $id
485 if {![info exists commitinfo($id)]} {
486 set commitinfo($id) {"No commit information available"}
489 return 1
492 proc readrefs {} {
493 global tagids idtags headids idheads tagobjid
494 global otherrefids idotherrefs mainhead mainheadid
496 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
497 catch {unset $v}
499 set refd [open [list | git show-ref -d] r]
500 while {[gets $refd line] >= 0} {
501 if {[string index $line 40] ne " "} continue
502 set id [string range $line 0 39]
503 set ref [string range $line 41 end]
504 if {![string match "refs/*" $ref]} continue
505 set name [string range $ref 5 end]
506 if {[string match "remotes/*" $name]} {
507 if {![string match "*/HEAD" $name]} {
508 set headids($name) $id
509 lappend idheads($id) $name
511 } elseif {[string match "heads/*" $name]} {
512 set name [string range $name 6 end]
513 set headids($name) $id
514 lappend idheads($id) $name
515 } elseif {[string match "tags/*" $name]} {
516 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
517 # which is what we want since the former is the commit ID
518 set name [string range $name 5 end]
519 if {[string match "*^{}" $name]} {
520 set name [string range $name 0 end-3]
521 } else {
522 set tagobjid($name) $id
524 set tagids($name) $id
525 lappend idtags($id) $name
526 } else {
527 set otherrefids($name) $id
528 lappend idotherrefs($id) $name
531 catch {close $refd}
532 set mainhead {}
533 set mainheadid {}
534 catch {
535 set thehead [exec git symbolic-ref HEAD]
536 if {[string match "refs/heads/*" $thehead]} {
537 set mainhead [string range $thehead 11 end]
538 if {[info exists headids($mainhead)]} {
539 set mainheadid $headids($mainhead)
545 # skip over fake commits
546 proc first_real_row {} {
547 global nullid nullid2 displayorder numcommits
549 for {set row 0} {$row < $numcommits} {incr row} {
550 set id [lindex $displayorder $row]
551 if {$id ne $nullid && $id ne $nullid2} {
552 break
555 return $row
558 # update things for a head moved to a child of its previous location
559 proc movehead {id name} {
560 global headids idheads
562 removehead $headids($name) $name
563 set headids($name) $id
564 lappend idheads($id) $name
567 # update things when a head has been removed
568 proc removehead {id name} {
569 global headids idheads
571 if {$idheads($id) eq $name} {
572 unset idheads($id)
573 } else {
574 set i [lsearch -exact $idheads($id) $name]
575 if {$i >= 0} {
576 set idheads($id) [lreplace $idheads($id) $i $i]
579 unset headids($name)
582 proc show_error {w top msg} {
583 message $w.m -text $msg -justify center -aspect 400
584 pack $w.m -side top -fill x -padx 20 -pady 20
585 button $w.ok -text OK -command "destroy $top"
586 pack $w.ok -side bottom -fill x
587 bind $top <Visibility> "grab $top; focus $top"
588 bind $top <Key-Return> "destroy $top"
589 tkwait window $top
592 proc error_popup msg {
593 set w .error
594 toplevel $w
595 wm transient $w .
596 show_error $w $w $msg
599 proc confirm_popup msg {
600 global confirm_ok
601 set confirm_ok 0
602 set w .confirm
603 toplevel $w
604 wm transient $w .
605 message $w.m -text $msg -justify center -aspect 400
606 pack $w.m -side top -fill x -padx 20 -pady 20
607 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text Cancel -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
612 tkwait window $w
613 return $confirm_ok
616 proc makewindow {} {
617 global canv canv2 canv3 linespc charspc ctext cflist
618 global tabstop
619 global findtype findtypemenu findloc findstring fstring geometry
620 global entries sha1entry sha1string sha1but
621 global diffcontextstring diffcontext
622 global maincursor textcursor curtextcursor
623 global rowctxmenu fakerowmenu mergemax wrapcomment
624 global highlight_files gdttype
625 global searchstring sstring
626 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
627 global headctxmenu progresscanv progressitem progresscoords statusw
628 global fprogitem fprogcoord lastprogupdate progupdatepending
629 global rprogitem rprogcoord
630 global have_tk85
632 menu .bar
633 .bar add cascade -label "File" -menu .bar.file
634 .bar configure -font uifont
635 menu .bar.file
636 .bar.file add command -label "Update" -command updatecommits
637 .bar.file add command -label "Reread references" -command rereadrefs
638 .bar.file add command -label "List references" -command showrefs
639 .bar.file add command -label "Quit" -command doquit
640 .bar.file configure -font uifont
641 menu .bar.edit
642 .bar add cascade -label "Edit" -menu .bar.edit
643 .bar.edit add command -label "Preferences" -command doprefs
644 .bar.edit configure -font uifont
646 menu .bar.view -font uifont
647 .bar add cascade -label "View" -menu .bar.view
648 .bar.view add command -label "New view..." -command {newview 0}
649 .bar.view add command -label "Edit view..." -command editview \
650 -state disabled
651 .bar.view add command -label "Delete view" -command delview -state disabled
652 .bar.view add separator
653 .bar.view add radiobutton -label "All files" -command {showview 0} \
654 -variable selectedview -value 0
656 menu .bar.help
657 .bar add cascade -label "Help" -menu .bar.help
658 .bar.help add command -label "About gitk" -command about
659 .bar.help add command -label "Key bindings" -command keys
660 .bar.help configure -font uifont
661 . configure -menu .bar
663 # the gui has upper and lower half, parts of a paned window.
664 panedwindow .ctop -orient vertical
666 # possibly use assumed geometry
667 if {![info exists geometry(pwsash0)]} {
668 set geometry(topheight) [expr {15 * $linespc}]
669 set geometry(topwidth) [expr {80 * $charspc}]
670 set geometry(botheight) [expr {15 * $linespc}]
671 set geometry(botwidth) [expr {50 * $charspc}]
672 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
673 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
676 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
677 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
678 frame .tf.histframe
679 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
681 # create three canvases
682 set cscroll .tf.histframe.csb
683 set canv .tf.histframe.pwclist.canv
684 canvas $canv \
685 -selectbackground $selectbgcolor \
686 -background $bgcolor -bd 0 \
687 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
688 .tf.histframe.pwclist add $canv
689 set canv2 .tf.histframe.pwclist.canv2
690 canvas $canv2 \
691 -selectbackground $selectbgcolor \
692 -background $bgcolor -bd 0 -yscrollincr $linespc
693 .tf.histframe.pwclist add $canv2
694 set canv3 .tf.histframe.pwclist.canv3
695 canvas $canv3 \
696 -selectbackground $selectbgcolor \
697 -background $bgcolor -bd 0 -yscrollincr $linespc
698 .tf.histframe.pwclist add $canv3
699 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
700 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
702 # a scroll bar to rule them
703 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
704 pack $cscroll -side right -fill y
705 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
706 lappend bglist $canv $canv2 $canv3
707 pack .tf.histframe.pwclist -fill both -expand 1 -side left
709 # we have two button bars at bottom of top frame. Bar 1
710 frame .tf.bar
711 frame .tf.lbar -height 15
713 set sha1entry .tf.bar.sha1
714 set entries $sha1entry
715 set sha1but .tf.bar.sha1label
716 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
717 -command gotocommit -width 8 -font uifont
718 $sha1but conf -disabledforeground [$sha1but cget -foreground]
719 pack .tf.bar.sha1label -side left
720 entry $sha1entry -width 40 -font textfont -textvariable sha1string
721 trace add variable sha1string write sha1change
722 pack $sha1entry -side left -pady 2
724 image create bitmap bm-left -data {
725 #define left_width 16
726 #define left_height 16
727 static unsigned char left_bits[] = {
728 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
729 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
730 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
732 image create bitmap bm-right -data {
733 #define right_width 16
734 #define right_height 16
735 static unsigned char right_bits[] = {
736 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
737 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
738 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
740 button .tf.bar.leftbut -image bm-left -command goback \
741 -state disabled -width 26
742 pack .tf.bar.leftbut -side left -fill y
743 button .tf.bar.rightbut -image bm-right -command goforw \
744 -state disabled -width 26
745 pack .tf.bar.rightbut -side left -fill y
747 # Status label and progress bar
748 set statusw .tf.bar.status
749 label $statusw -width 15 -relief sunken -font uifont
750 pack $statusw -side left -padx 5
751 set h [expr {[font metrics uifont -linespace] + 2}]
752 set progresscanv .tf.bar.progress
753 canvas $progresscanv -relief sunken -height $h -borderwidth 2
754 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
755 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
756 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
757 pack $progresscanv -side right -expand 1 -fill x
758 set progresscoords {0 0}
759 set fprogcoord 0
760 set rprogcoord 0
761 bind $progresscanv <Configure> adjustprogress
762 set lastprogupdate [clock clicks -milliseconds]
763 set progupdatepending 0
765 # build up the bottom bar of upper window
766 label .tf.lbar.flabel -text "Find " -font uifont
767 button .tf.lbar.fnext -text "next" -command dofind -font uifont
768 button .tf.lbar.fprev -text "prev" -command {dofind 1} -font uifont
769 label .tf.lbar.flab2 -text " commit " -font uifont
770 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
771 -side left -fill y
772 set gdttype "containing:"
773 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
774 "containing:" \
775 "touching paths:" \
776 "adding/removing string:"]
777 trace add variable gdttype write gdttype_change
778 $gm conf -font uifont
779 .tf.lbar.gdttype conf -font uifont
780 pack .tf.lbar.gdttype -side left -fill y
782 set findstring {}
783 set fstring .tf.lbar.findstring
784 lappend entries $fstring
785 entry $fstring -width 30 -font textfont -textvariable findstring
786 trace add variable findstring write find_change
787 set findtype Exact
788 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
789 findtype Exact IgnCase Regexp]
790 trace add variable findtype write findcom_change
791 .tf.lbar.findtype configure -font uifont
792 .tf.lbar.findtype.menu configure -font uifont
793 set findloc "All fields"
794 tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
795 Comments Author Committer
796 trace add variable findloc write find_change
797 .tf.lbar.findloc configure -font uifont
798 .tf.lbar.findloc.menu configure -font uifont
799 pack .tf.lbar.findloc -side right
800 pack .tf.lbar.findtype -side right
801 pack $fstring -side left -expand 1 -fill x
803 # Finish putting the upper half of the viewer together
804 pack .tf.lbar -in .tf -side bottom -fill x
805 pack .tf.bar -in .tf -side bottom -fill x
806 pack .tf.histframe -fill both -side top -expand 1
807 .ctop add .tf
808 .ctop paneconfigure .tf -height $geometry(topheight)
809 .ctop paneconfigure .tf -width $geometry(topwidth)
811 # now build up the bottom
812 panedwindow .pwbottom -orient horizontal
814 # lower left, a text box over search bar, scroll bar to the right
815 # if we know window height, then that will set the lower text height, otherwise
816 # we set lower text height which will drive window height
817 if {[info exists geometry(main)]} {
818 frame .bleft -width $geometry(botwidth)
819 } else {
820 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
822 frame .bleft.top
823 frame .bleft.mid
825 button .bleft.top.search -text "Search" -command dosearch \
826 -font uifont
827 pack .bleft.top.search -side left -padx 5
828 set sstring .bleft.top.sstring
829 entry $sstring -width 20 -font textfont -textvariable searchstring
830 lappend entries $sstring
831 trace add variable searchstring write incrsearch
832 pack $sstring -side left -expand 1 -fill x
833 radiobutton .bleft.mid.diff -text "Diff" \
834 -command changediffdisp -variable diffelide -value {0 0}
835 radiobutton .bleft.mid.old -text "Old version" \
836 -command changediffdisp -variable diffelide -value {0 1}
837 radiobutton .bleft.mid.new -text "New version" \
838 -command changediffdisp -variable diffelide -value {1 0}
839 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
840 -font uifont
841 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
842 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
843 -from 1 -increment 1 -to 10000000 \
844 -validate all -validatecommand "diffcontextvalidate %P" \
845 -textvariable diffcontextstring
846 .bleft.mid.diffcontext set $diffcontext
847 trace add variable diffcontextstring write diffcontextchange
848 lappend entries .bleft.mid.diffcontext
849 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
850 set ctext .bleft.ctext
851 text $ctext -background $bgcolor -foreground $fgcolor \
852 -state disabled -font textfont \
853 -yscrollcommand scrolltext -wrap none
854 if {$have_tk85} {
855 $ctext conf -tabstyle wordprocessor
857 scrollbar .bleft.sb -command "$ctext yview"
858 pack .bleft.top -side top -fill x
859 pack .bleft.mid -side top -fill x
860 pack .bleft.sb -side right -fill y
861 pack $ctext -side left -fill both -expand 1
862 lappend bglist $ctext
863 lappend fglist $ctext
865 $ctext tag conf comment -wrap $wrapcomment
866 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
867 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
868 $ctext tag conf d0 -fore [lindex $diffcolors 0]
869 $ctext tag conf d1 -fore [lindex $diffcolors 1]
870 $ctext tag conf m0 -fore red
871 $ctext tag conf m1 -fore blue
872 $ctext tag conf m2 -fore green
873 $ctext tag conf m3 -fore purple
874 $ctext tag conf m4 -fore brown
875 $ctext tag conf m5 -fore "#009090"
876 $ctext tag conf m6 -fore magenta
877 $ctext tag conf m7 -fore "#808000"
878 $ctext tag conf m8 -fore "#009000"
879 $ctext tag conf m9 -fore "#ff0080"
880 $ctext tag conf m10 -fore cyan
881 $ctext tag conf m11 -fore "#b07070"
882 $ctext tag conf m12 -fore "#70b0f0"
883 $ctext tag conf m13 -fore "#70f0b0"
884 $ctext tag conf m14 -fore "#f0b070"
885 $ctext tag conf m15 -fore "#ff70b0"
886 $ctext tag conf mmax -fore darkgrey
887 set mergemax 16
888 $ctext tag conf mresult -font textfontbold
889 $ctext tag conf msep -font textfontbold
890 $ctext tag conf found -back yellow
892 .pwbottom add .bleft
893 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
895 # lower right
896 frame .bright
897 frame .bright.mode
898 radiobutton .bright.mode.patch -text "Patch" \
899 -command reselectline -variable cmitmode -value "patch"
900 .bright.mode.patch configure -font uifont
901 radiobutton .bright.mode.tree -text "Tree" \
902 -command reselectline -variable cmitmode -value "tree"
903 .bright.mode.tree configure -font uifont
904 grid .bright.mode.patch .bright.mode.tree -sticky ew
905 pack .bright.mode -side top -fill x
906 set cflist .bright.cfiles
907 set indent [font measure mainfont "nn"]
908 text $cflist \
909 -selectbackground $selectbgcolor \
910 -background $bgcolor -foreground $fgcolor \
911 -font mainfont \
912 -tabs [list $indent [expr {2 * $indent}]] \
913 -yscrollcommand ".bright.sb set" \
914 -cursor [. cget -cursor] \
915 -spacing1 1 -spacing3 1
916 lappend bglist $cflist
917 lappend fglist $cflist
918 scrollbar .bright.sb -command "$cflist yview"
919 pack .bright.sb -side right -fill y
920 pack $cflist -side left -fill both -expand 1
921 $cflist tag configure highlight \
922 -background [$cflist cget -selectbackground]
923 $cflist tag configure bold -font mainfontbold
925 .pwbottom add .bright
926 .ctop add .pwbottom
928 # restore window position if known
929 if {[info exists geometry(main)]} {
930 wm geometry . "$geometry(main)"
933 if {[tk windowingsystem] eq {aqua}} {
934 set M1B M1
935 } else {
936 set M1B Control
939 bind .pwbottom <Configure> {resizecdetpanes %W %w}
940 pack .ctop -fill both -expand 1
941 bindall <1> {selcanvline %W %x %y}
942 #bindall <B1-Motion> {selcanvline %W %x %y}
943 if {[tk windowingsystem] == "win32"} {
944 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
945 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
946 } else {
947 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
948 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
949 if {[tk windowingsystem] eq "aqua"} {
950 bindall <MouseWheel> {
951 set delta [expr {- (%D)}]
952 allcanvs yview scroll $delta units
956 bindall <2> "canvscan mark %W %x %y"
957 bindall <B2-Motion> "canvscan dragto %W %x %y"
958 bindkey <Home> selfirstline
959 bindkey <End> sellastline
960 bind . <Key-Up> "selnextline -1"
961 bind . <Key-Down> "selnextline 1"
962 bindkey <Key-Right> "goforw"
963 bindkey <Key-Left> "goback"
964 bind . <Key-Prior> "selnextpage -1"
965 bind . <Key-Next> "selnextpage 1"
966 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
967 bind . <$M1B-End> "allcanvs yview moveto 1.0"
968 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
969 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
970 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
971 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
972 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
973 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
974 bindkey <Key-space> "$ctext yview scroll 1 pages"
975 bindkey p "selnextline -1"
976 bindkey n "selnextline 1"
977 bindkey z "goback"
978 bindkey x "goforw"
979 bindkey i "selnextline -1"
980 bindkey k "selnextline 1"
981 bindkey j "goback"
982 bindkey l "goforw"
983 bindkey b "$ctext yview scroll -1 pages"
984 bindkey d "$ctext yview scroll 18 units"
985 bindkey u "$ctext yview scroll -18 units"
986 bindkey / {findnext 1}
987 bindkey <Key-Return> {findnext 0}
988 bindkey ? findprev
989 bindkey f nextfile
990 bindkey <F5> updatecommits
991 bind . <$M1B-q> doquit
992 bind . <$M1B-f> dofind
993 bind . <$M1B-g> {findnext 0}
994 bind . <$M1B-r> dosearchback
995 bind . <$M1B-s> dosearch
996 bind . <$M1B-equal> {incrfont 1}
997 bind . <$M1B-KP_Add> {incrfont 1}
998 bind . <$M1B-minus> {incrfont -1}
999 bind . <$M1B-KP_Subtract> {incrfont -1}
1000 wm protocol . WM_DELETE_WINDOW doquit
1001 bind . <Button-1> "click %W"
1002 bind $fstring <Key-Return> dofind
1003 bind $sha1entry <Key-Return> gotocommit
1004 bind $sha1entry <<PasteSelection>> clearsha1
1005 bind $cflist <1> {sel_flist %W %x %y; break}
1006 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1007 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1008 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1010 set maincursor [. cget -cursor]
1011 set textcursor [$ctext cget -cursor]
1012 set curtextcursor $textcursor
1014 set rowctxmenu .rowctxmenu
1015 menu $rowctxmenu -tearoff 0
1016 $rowctxmenu add command -label "Diff this -> selected" \
1017 -command {diffvssel 0}
1018 $rowctxmenu add command -label "Diff selected -> this" \
1019 -command {diffvssel 1}
1020 $rowctxmenu add command -label "Make patch" -command mkpatch
1021 $rowctxmenu add command -label "Create tag" -command mktag
1022 $rowctxmenu add command -label "Write commit to file" -command writecommit
1023 $rowctxmenu add command -label "Create new branch" -command mkbranch
1024 $rowctxmenu add command -label "Cherry-pick this commit" \
1025 -command cherrypick
1026 $rowctxmenu add command -label "Reset HEAD branch to here" \
1027 -command resethead
1029 set fakerowmenu .fakerowmenu
1030 menu $fakerowmenu -tearoff 0
1031 $fakerowmenu add command -label "Diff this -> selected" \
1032 -command {diffvssel 0}
1033 $fakerowmenu add command -label "Diff selected -> this" \
1034 -command {diffvssel 1}
1035 $fakerowmenu add command -label "Make patch" -command mkpatch
1036 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
1037 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
1038 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
1040 set headctxmenu .headctxmenu
1041 menu $headctxmenu -tearoff 0
1042 $headctxmenu add command -label "Check out this branch" \
1043 -command cobranch
1044 $headctxmenu add command -label "Remove this branch" \
1045 -command rmbranch
1047 global flist_menu
1048 set flist_menu .flistctxmenu
1049 menu $flist_menu -tearoff 0
1050 $flist_menu add command -label "Highlight this too" \
1051 -command {flist_hl 0}
1052 $flist_menu add command -label "Highlight this only" \
1053 -command {flist_hl 1}
1056 # Windows sends all mouse wheel events to the current focused window, not
1057 # the one where the mouse hovers, so bind those events here and redirect
1058 # to the correct window
1059 proc windows_mousewheel_redirector {W X Y D} {
1060 global canv canv2 canv3
1061 set w [winfo containing -displayof $W $X $Y]
1062 if {$w ne ""} {
1063 set u [expr {$D < 0 ? 5 : -5}]
1064 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1065 allcanvs yview scroll $u units
1066 } else {
1067 catch {
1068 $w yview scroll $u units
1074 # mouse-2 makes all windows scan vertically, but only the one
1075 # the cursor is in scans horizontally
1076 proc canvscan {op w x y} {
1077 global canv canv2 canv3
1078 foreach c [list $canv $canv2 $canv3] {
1079 if {$c == $w} {
1080 $c scan $op $x $y
1081 } else {
1082 $c scan $op 0 $y
1087 proc scrollcanv {cscroll f0 f1} {
1088 $cscroll set $f0 $f1
1089 drawfrac $f0 $f1
1090 flushhighlights
1093 # when we make a key binding for the toplevel, make sure
1094 # it doesn't get triggered when that key is pressed in the
1095 # find string entry widget.
1096 proc bindkey {ev script} {
1097 global entries
1098 bind . $ev $script
1099 set escript [bind Entry $ev]
1100 if {$escript == {}} {
1101 set escript [bind Entry <Key>]
1103 foreach e $entries {
1104 bind $e $ev "$escript; break"
1108 # set the focus back to the toplevel for any click outside
1109 # the entry widgets
1110 proc click {w} {
1111 global ctext entries
1112 foreach e [concat $entries $ctext] {
1113 if {$w == $e} return
1115 focus .
1118 # Adjust the progress bar for a change in requested extent or canvas size
1119 proc adjustprogress {} {
1120 global progresscanv progressitem progresscoords
1121 global fprogitem fprogcoord lastprogupdate progupdatepending
1122 global rprogitem rprogcoord
1124 set w [expr {[winfo width $progresscanv] - 4}]
1125 set x0 [expr {$w * [lindex $progresscoords 0]}]
1126 set x1 [expr {$w * [lindex $progresscoords 1]}]
1127 set h [winfo height $progresscanv]
1128 $progresscanv coords $progressitem $x0 0 $x1 $h
1129 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1130 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1131 set now [clock clicks -milliseconds]
1132 if {$now >= $lastprogupdate + 100} {
1133 set progupdatepending 0
1134 update
1135 } elseif {!$progupdatepending} {
1136 set progupdatepending 1
1137 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1141 proc doprogupdate {} {
1142 global lastprogupdate progupdatepending
1144 if {$progupdatepending} {
1145 set progupdatepending 0
1146 set lastprogupdate [clock clicks -milliseconds]
1147 update
1151 proc savestuff {w} {
1152 global canv canv2 canv3 mainfont textfont uifont tabstop
1153 global stuffsaved findmergefiles maxgraphpct
1154 global maxwidth showneartags showlocalchanges
1155 global viewname viewfiles viewargs viewperm nextviewnum
1156 global cmitmode wrapcomment datetimeformat limitdiffs
1157 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1159 if {$stuffsaved} return
1160 if {![winfo viewable .]} return
1161 catch {
1162 set f [open "~/.gitk-new" w]
1163 puts $f [list set mainfont $mainfont]
1164 puts $f [list set textfont $textfont]
1165 puts $f [list set uifont $uifont]
1166 puts $f [list set tabstop $tabstop]
1167 puts $f [list set findmergefiles $findmergefiles]
1168 puts $f [list set maxgraphpct $maxgraphpct]
1169 puts $f [list set maxwidth $maxwidth]
1170 puts $f [list set cmitmode $cmitmode]
1171 puts $f [list set wrapcomment $wrapcomment]
1172 puts $f [list set showneartags $showneartags]
1173 puts $f [list set showlocalchanges $showlocalchanges]
1174 puts $f [list set datetimeformat $datetimeformat]
1175 puts $f [list set limitdiffs $limitdiffs]
1176 puts $f [list set bgcolor $bgcolor]
1177 puts $f [list set fgcolor $fgcolor]
1178 puts $f [list set colors $colors]
1179 puts $f [list set diffcolors $diffcolors]
1180 puts $f [list set diffcontext $diffcontext]
1181 puts $f [list set selectbgcolor $selectbgcolor]
1183 puts $f "set geometry(main) [wm geometry .]"
1184 puts $f "set geometry(topwidth) [winfo width .tf]"
1185 puts $f "set geometry(topheight) [winfo height .tf]"
1186 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1187 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1188 puts $f "set geometry(botwidth) [winfo width .bleft]"
1189 puts $f "set geometry(botheight) [winfo height .bleft]"
1191 puts -nonewline $f "set permviews {"
1192 for {set v 0} {$v < $nextviewnum} {incr v} {
1193 if {$viewperm($v)} {
1194 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1197 puts $f "}"
1198 close $f
1199 file rename -force "~/.gitk-new" "~/.gitk"
1201 set stuffsaved 1
1204 proc resizeclistpanes {win w} {
1205 global oldwidth
1206 if {[info exists oldwidth($win)]} {
1207 set s0 [$win sash coord 0]
1208 set s1 [$win sash coord 1]
1209 if {$w < 60} {
1210 set sash0 [expr {int($w/2 - 2)}]
1211 set sash1 [expr {int($w*5/6 - 2)}]
1212 } else {
1213 set factor [expr {1.0 * $w / $oldwidth($win)}]
1214 set sash0 [expr {int($factor * [lindex $s0 0])}]
1215 set sash1 [expr {int($factor * [lindex $s1 0])}]
1216 if {$sash0 < 30} {
1217 set sash0 30
1219 if {$sash1 < $sash0 + 20} {
1220 set sash1 [expr {$sash0 + 20}]
1222 if {$sash1 > $w - 10} {
1223 set sash1 [expr {$w - 10}]
1224 if {$sash0 > $sash1 - 20} {
1225 set sash0 [expr {$sash1 - 20}]
1229 $win sash place 0 $sash0 [lindex $s0 1]
1230 $win sash place 1 $sash1 [lindex $s1 1]
1232 set oldwidth($win) $w
1235 proc resizecdetpanes {win w} {
1236 global oldwidth
1237 if {[info exists oldwidth($win)]} {
1238 set s0 [$win sash coord 0]
1239 if {$w < 60} {
1240 set sash0 [expr {int($w*3/4 - 2)}]
1241 } else {
1242 set factor [expr {1.0 * $w / $oldwidth($win)}]
1243 set sash0 [expr {int($factor * [lindex $s0 0])}]
1244 if {$sash0 < 45} {
1245 set sash0 45
1247 if {$sash0 > $w - 15} {
1248 set sash0 [expr {$w - 15}]
1251 $win sash place 0 $sash0 [lindex $s0 1]
1253 set oldwidth($win) $w
1256 proc allcanvs args {
1257 global canv canv2 canv3
1258 eval $canv $args
1259 eval $canv2 $args
1260 eval $canv3 $args
1263 proc bindall {event action} {
1264 global canv canv2 canv3
1265 bind $canv $event $action
1266 bind $canv2 $event $action
1267 bind $canv3 $event $action
1270 proc about {} {
1271 global uifont
1272 set w .about
1273 if {[winfo exists $w]} {
1274 raise $w
1275 return
1277 toplevel $w
1278 wm title $w "About gitk"
1279 message $w.m -text {
1280 Gitk - a commit viewer for git
1282 Copyright © 2005-2006 Paul Mackerras
1284 Use and redistribute under the terms of the GNU General Public License} \
1285 -justify center -aspect 400 -border 2 -bg white -relief groove
1286 pack $w.m -side top -fill x -padx 2 -pady 2
1287 $w.m configure -font uifont
1288 button $w.ok -text Close -command "destroy $w" -default active
1289 pack $w.ok -side bottom
1290 $w.ok configure -font uifont
1291 bind $w <Visibility> "focus $w.ok"
1292 bind $w <Key-Escape> "destroy $w"
1293 bind $w <Key-Return> "destroy $w"
1296 proc keys {} {
1297 global uifont
1298 set w .keys
1299 if {[winfo exists $w]} {
1300 raise $w
1301 return
1303 if {[tk windowingsystem] eq {aqua}} {
1304 set M1T Cmd
1305 } else {
1306 set M1T Ctrl
1308 toplevel $w
1309 wm title $w "Gitk key bindings"
1310 message $w.m -text "
1311 Gitk key bindings:
1313 <$M1T-Q> Quit
1314 <Home> Move to first commit
1315 <End> Move to last commit
1316 <Up>, p, i Move up one commit
1317 <Down>, n, k Move down one commit
1318 <Left>, z, j Go back in history list
1319 <Right>, x, l Go forward in history list
1320 <PageUp> Move up one page in commit list
1321 <PageDown> Move down one page in commit list
1322 <$M1T-Home> Scroll to top of commit list
1323 <$M1T-End> Scroll to bottom of commit list
1324 <$M1T-Up> Scroll commit list up one line
1325 <$M1T-Down> Scroll commit list down one line
1326 <$M1T-PageUp> Scroll commit list up one page
1327 <$M1T-PageDown> Scroll commit list down one page
1328 <Shift-Up> Move to previous highlighted line
1329 <Shift-Down> Move to next highlighted line
1330 <Delete>, b Scroll diff view up one page
1331 <Backspace> Scroll diff view up one page
1332 <Space> Scroll diff view down one page
1333 u Scroll diff view up 18 lines
1334 d Scroll diff view down 18 lines
1335 <$M1T-F> Find
1336 <$M1T-G> Move to next find hit
1337 <Return> Move to next find hit
1338 / Move to next find hit, or redo find
1339 ? Move to previous find hit
1340 f Scroll diff view to next file
1341 <$M1T-S> Search for next hit in diff view
1342 <$M1T-R> Search for previous hit in diff view
1343 <$M1T-KP+> Increase font size
1344 <$M1T-plus> Increase font size
1345 <$M1T-KP-> Decrease font size
1346 <$M1T-minus> Decrease font size
1347 <F5> Update
1349 -justify left -bg white -border 2 -relief groove
1350 pack $w.m -side top -fill both -padx 2 -pady 2
1351 $w.m configure -font uifont
1352 button $w.ok -text Close -command "destroy $w" -default active
1353 pack $w.ok -side bottom
1354 $w.ok configure -font uifont
1355 bind $w <Visibility> "focus $w.ok"
1356 bind $w <Key-Escape> "destroy $w"
1357 bind $w <Key-Return> "destroy $w"
1360 # Procedures for manipulating the file list window at the
1361 # bottom right of the overall window.
1363 proc treeview {w l openlevs} {
1364 global treecontents treediropen treeheight treeparent treeindex
1366 set ix 0
1367 set treeindex() 0
1368 set lev 0
1369 set prefix {}
1370 set prefixend -1
1371 set prefendstack {}
1372 set htstack {}
1373 set ht 0
1374 set treecontents() {}
1375 $w conf -state normal
1376 foreach f $l {
1377 while {[string range $f 0 $prefixend] ne $prefix} {
1378 if {$lev <= $openlevs} {
1379 $w mark set e:$treeindex($prefix) "end -1c"
1380 $w mark gravity e:$treeindex($prefix) left
1382 set treeheight($prefix) $ht
1383 incr ht [lindex $htstack end]
1384 set htstack [lreplace $htstack end end]
1385 set prefixend [lindex $prefendstack end]
1386 set prefendstack [lreplace $prefendstack end end]
1387 set prefix [string range $prefix 0 $prefixend]
1388 incr lev -1
1390 set tail [string range $f [expr {$prefixend+1}] end]
1391 while {[set slash [string first "/" $tail]] >= 0} {
1392 lappend htstack $ht
1393 set ht 0
1394 lappend prefendstack $prefixend
1395 incr prefixend [expr {$slash + 1}]
1396 set d [string range $tail 0 $slash]
1397 lappend treecontents($prefix) $d
1398 set oldprefix $prefix
1399 append prefix $d
1400 set treecontents($prefix) {}
1401 set treeindex($prefix) [incr ix]
1402 set treeparent($prefix) $oldprefix
1403 set tail [string range $tail [expr {$slash+1}] end]
1404 if {$lev <= $openlevs} {
1405 set ht 1
1406 set treediropen($prefix) [expr {$lev < $openlevs}]
1407 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1408 $w mark set d:$ix "end -1c"
1409 $w mark gravity d:$ix left
1410 set str "\n"
1411 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1412 $w insert end $str
1413 $w image create end -align center -image $bm -padx 1 \
1414 -name a:$ix
1415 $w insert end $d [highlight_tag $prefix]
1416 $w mark set s:$ix "end -1c"
1417 $w mark gravity s:$ix left
1419 incr lev
1421 if {$tail ne {}} {
1422 if {$lev <= $openlevs} {
1423 incr ht
1424 set str "\n"
1425 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1426 $w insert end $str
1427 $w insert end $tail [highlight_tag $f]
1429 lappend treecontents($prefix) $tail
1432 while {$htstack ne {}} {
1433 set treeheight($prefix) $ht
1434 incr ht [lindex $htstack end]
1435 set htstack [lreplace $htstack end end]
1436 set prefixend [lindex $prefendstack end]
1437 set prefendstack [lreplace $prefendstack end end]
1438 set prefix [string range $prefix 0 $prefixend]
1440 $w conf -state disabled
1443 proc linetoelt {l} {
1444 global treeheight treecontents
1446 set y 2
1447 set prefix {}
1448 while {1} {
1449 foreach e $treecontents($prefix) {
1450 if {$y == $l} {
1451 return "$prefix$e"
1453 set n 1
1454 if {[string index $e end] eq "/"} {
1455 set n $treeheight($prefix$e)
1456 if {$y + $n > $l} {
1457 append prefix $e
1458 incr y
1459 break
1462 incr y $n
1467 proc highlight_tree {y prefix} {
1468 global treeheight treecontents cflist
1470 foreach e $treecontents($prefix) {
1471 set path $prefix$e
1472 if {[highlight_tag $path] ne {}} {
1473 $cflist tag add bold $y.0 "$y.0 lineend"
1475 incr y
1476 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1477 set y [highlight_tree $y $path]
1480 return $y
1483 proc treeclosedir {w dir} {
1484 global treediropen treeheight treeparent treeindex
1486 set ix $treeindex($dir)
1487 $w conf -state normal
1488 $w delete s:$ix e:$ix
1489 set treediropen($dir) 0
1490 $w image configure a:$ix -image tri-rt
1491 $w conf -state disabled
1492 set n [expr {1 - $treeheight($dir)}]
1493 while {$dir ne {}} {
1494 incr treeheight($dir) $n
1495 set dir $treeparent($dir)
1499 proc treeopendir {w dir} {
1500 global treediropen treeheight treeparent treecontents treeindex
1502 set ix $treeindex($dir)
1503 $w conf -state normal
1504 $w image configure a:$ix -image tri-dn
1505 $w mark set e:$ix s:$ix
1506 $w mark gravity e:$ix right
1507 set lev 0
1508 set str "\n"
1509 set n [llength $treecontents($dir)]
1510 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1511 incr lev
1512 append str "\t"
1513 incr treeheight($x) $n
1515 foreach e $treecontents($dir) {
1516 set de $dir$e
1517 if {[string index $e end] eq "/"} {
1518 set iy $treeindex($de)
1519 $w mark set d:$iy e:$ix
1520 $w mark gravity d:$iy left
1521 $w insert e:$ix $str
1522 set treediropen($de) 0
1523 $w image create e:$ix -align center -image tri-rt -padx 1 \
1524 -name a:$iy
1525 $w insert e:$ix $e [highlight_tag $de]
1526 $w mark set s:$iy e:$ix
1527 $w mark gravity s:$iy left
1528 set treeheight($de) 1
1529 } else {
1530 $w insert e:$ix $str
1531 $w insert e:$ix $e [highlight_tag $de]
1534 $w mark gravity e:$ix left
1535 $w conf -state disabled
1536 set treediropen($dir) 1
1537 set top [lindex [split [$w index @0,0] .] 0]
1538 set ht [$w cget -height]
1539 set l [lindex [split [$w index s:$ix] .] 0]
1540 if {$l < $top} {
1541 $w yview $l.0
1542 } elseif {$l + $n + 1 > $top + $ht} {
1543 set top [expr {$l + $n + 2 - $ht}]
1544 if {$l < $top} {
1545 set top $l
1547 $w yview $top.0
1551 proc treeclick {w x y} {
1552 global treediropen cmitmode ctext cflist cflist_top
1554 if {$cmitmode ne "tree"} return
1555 if {![info exists cflist_top]} return
1556 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1557 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1558 $cflist tag add highlight $l.0 "$l.0 lineend"
1559 set cflist_top $l
1560 if {$l == 1} {
1561 $ctext yview 1.0
1562 return
1564 set e [linetoelt $l]
1565 if {[string index $e end] ne "/"} {
1566 showfile $e
1567 } elseif {$treediropen($e)} {
1568 treeclosedir $w $e
1569 } else {
1570 treeopendir $w $e
1574 proc setfilelist {id} {
1575 global treefilelist cflist
1577 treeview $cflist $treefilelist($id) 0
1580 image create bitmap tri-rt -background black -foreground blue -data {
1581 #define tri-rt_width 13
1582 #define tri-rt_height 13
1583 static unsigned char tri-rt_bits[] = {
1584 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1585 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1586 0x00, 0x00};
1587 } -maskdata {
1588 #define tri-rt-mask_width 13
1589 #define tri-rt-mask_height 13
1590 static unsigned char tri-rt-mask_bits[] = {
1591 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1592 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1593 0x08, 0x00};
1595 image create bitmap tri-dn -background black -foreground blue -data {
1596 #define tri-dn_width 13
1597 #define tri-dn_height 13
1598 static unsigned char tri-dn_bits[] = {
1599 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1600 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1601 0x00, 0x00};
1602 } -maskdata {
1603 #define tri-dn-mask_width 13
1604 #define tri-dn-mask_height 13
1605 static unsigned char tri-dn-mask_bits[] = {
1606 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1607 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1608 0x00, 0x00};
1611 image create bitmap reficon-T -background black -foreground yellow -data {
1612 #define tagicon_width 13
1613 #define tagicon_height 9
1614 static unsigned char tagicon_bits[] = {
1615 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1616 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1617 } -maskdata {
1618 #define tagicon-mask_width 13
1619 #define tagicon-mask_height 9
1620 static unsigned char tagicon-mask_bits[] = {
1621 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1622 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1624 set rectdata {
1625 #define headicon_width 13
1626 #define headicon_height 9
1627 static unsigned char headicon_bits[] = {
1628 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1629 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1631 set rectmask {
1632 #define headicon-mask_width 13
1633 #define headicon-mask_height 9
1634 static unsigned char headicon-mask_bits[] = {
1635 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1636 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1638 image create bitmap reficon-H -background black -foreground green \
1639 -data $rectdata -maskdata $rectmask
1640 image create bitmap reficon-o -background black -foreground "#ddddff" \
1641 -data $rectdata -maskdata $rectmask
1643 proc init_flist {first} {
1644 global cflist cflist_top selectedline difffilestart
1646 $cflist conf -state normal
1647 $cflist delete 0.0 end
1648 if {$first ne {}} {
1649 $cflist insert end $first
1650 set cflist_top 1
1651 $cflist tag add highlight 1.0 "1.0 lineend"
1652 } else {
1653 catch {unset cflist_top}
1655 $cflist conf -state disabled
1656 set difffilestart {}
1659 proc highlight_tag {f} {
1660 global highlight_paths
1662 foreach p $highlight_paths {
1663 if {[string match $p $f]} {
1664 return "bold"
1667 return {}
1670 proc highlight_filelist {} {
1671 global cmitmode cflist
1673 $cflist conf -state normal
1674 if {$cmitmode ne "tree"} {
1675 set end [lindex [split [$cflist index end] .] 0]
1676 for {set l 2} {$l < $end} {incr l} {
1677 set line [$cflist get $l.0 "$l.0 lineend"]
1678 if {[highlight_tag $line] ne {}} {
1679 $cflist tag add bold $l.0 "$l.0 lineend"
1682 } else {
1683 highlight_tree 2 {}
1685 $cflist conf -state disabled
1688 proc unhighlight_filelist {} {
1689 global cflist
1691 $cflist conf -state normal
1692 $cflist tag remove bold 1.0 end
1693 $cflist conf -state disabled
1696 proc add_flist {fl} {
1697 global cflist
1699 $cflist conf -state normal
1700 foreach f $fl {
1701 $cflist insert end "\n"
1702 $cflist insert end $f [highlight_tag $f]
1704 $cflist conf -state disabled
1707 proc sel_flist {w x y} {
1708 global ctext difffilestart cflist cflist_top cmitmode
1710 if {$cmitmode eq "tree"} return
1711 if {![info exists cflist_top]} return
1712 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1713 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1714 $cflist tag add highlight $l.0 "$l.0 lineend"
1715 set cflist_top $l
1716 if {$l == 1} {
1717 $ctext yview 1.0
1718 } else {
1719 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1723 proc pop_flist_menu {w X Y x y} {
1724 global ctext cflist cmitmode flist_menu flist_menu_file
1725 global treediffs diffids
1727 stopfinding
1728 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1729 if {$l <= 1} return
1730 if {$cmitmode eq "tree"} {
1731 set e [linetoelt $l]
1732 if {[string index $e end] eq "/"} return
1733 } else {
1734 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1736 set flist_menu_file $e
1737 tk_popup $flist_menu $X $Y
1740 proc flist_hl {only} {
1741 global flist_menu_file findstring gdttype
1743 set x [shellquote $flist_menu_file]
1744 if {$only || $findstring eq {} || $gdttype ne "touching paths:"} {
1745 set findstring $x
1746 } else {
1747 append findstring " " $x
1749 set gdttype "touching paths:"
1752 # Functions for adding and removing shell-type quoting
1754 proc shellquote {str} {
1755 if {![string match "*\['\"\\ \t]*" $str]} {
1756 return $str
1758 if {![string match "*\['\"\\]*" $str]} {
1759 return "\"$str\""
1761 if {![string match "*'*" $str]} {
1762 return "'$str'"
1764 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1767 proc shellarglist {l} {
1768 set str {}
1769 foreach a $l {
1770 if {$str ne {}} {
1771 append str " "
1773 append str [shellquote $a]
1775 return $str
1778 proc shelldequote {str} {
1779 set ret {}
1780 set used -1
1781 while {1} {
1782 incr used
1783 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1784 append ret [string range $str $used end]
1785 set used [string length $str]
1786 break
1788 set first [lindex $first 0]
1789 set ch [string index $str $first]
1790 if {$first > $used} {
1791 append ret [string range $str $used [expr {$first - 1}]]
1792 set used $first
1794 if {$ch eq " " || $ch eq "\t"} break
1795 incr used
1796 if {$ch eq "'"} {
1797 set first [string first "'" $str $used]
1798 if {$first < 0} {
1799 error "unmatched single-quote"
1801 append ret [string range $str $used [expr {$first - 1}]]
1802 set used $first
1803 continue
1805 if {$ch eq "\\"} {
1806 if {$used >= [string length $str]} {
1807 error "trailing backslash"
1809 append ret [string index $str $used]
1810 continue
1812 # here ch == "\""
1813 while {1} {
1814 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1815 error "unmatched double-quote"
1817 set first [lindex $first 0]
1818 set ch [string index $str $first]
1819 if {$first > $used} {
1820 append ret [string range $str $used [expr {$first - 1}]]
1821 set used $first
1823 if {$ch eq "\""} break
1824 incr used
1825 append ret [string index $str $used]
1826 incr used
1829 return [list $used $ret]
1832 proc shellsplit {str} {
1833 set l {}
1834 while {1} {
1835 set str [string trimleft $str]
1836 if {$str eq {}} break
1837 set dq [shelldequote $str]
1838 set n [lindex $dq 0]
1839 set word [lindex $dq 1]
1840 set str [string range $str $n end]
1841 lappend l $word
1843 return $l
1846 # Code to implement multiple views
1848 proc newview {ishighlight} {
1849 global nextviewnum newviewname newviewperm uifont newishighlight
1850 global newviewargs revtreeargs
1852 set newishighlight $ishighlight
1853 set top .gitkview
1854 if {[winfo exists $top]} {
1855 raise $top
1856 return
1858 set newviewname($nextviewnum) "View $nextviewnum"
1859 set newviewperm($nextviewnum) 0
1860 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1861 vieweditor $top $nextviewnum "Gitk view definition"
1864 proc editview {} {
1865 global curview
1866 global viewname viewperm newviewname newviewperm
1867 global viewargs newviewargs
1869 set top .gitkvedit-$curview
1870 if {[winfo exists $top]} {
1871 raise $top
1872 return
1874 set newviewname($curview) $viewname($curview)
1875 set newviewperm($curview) $viewperm($curview)
1876 set newviewargs($curview) [shellarglist $viewargs($curview)]
1877 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1880 proc vieweditor {top n title} {
1881 global newviewname newviewperm viewfiles
1882 global uifont
1884 toplevel $top
1885 wm title $top $title
1886 label $top.nl -text "Name" -font uifont
1887 entry $top.name -width 20 -textvariable newviewname($n) -font uifont
1888 grid $top.nl $top.name -sticky w -pady 5
1889 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1890 -font uifont
1891 grid $top.perm - -pady 5 -sticky w
1892 message $top.al -aspect 1000 -font uifont \
1893 -text "Commits to include (arguments to git rev-list):"
1894 grid $top.al - -sticky w -pady 5
1895 entry $top.args -width 50 -textvariable newviewargs($n) \
1896 -background white -font uifont
1897 grid $top.args - -sticky ew -padx 5
1898 message $top.l -aspect 1000 -font uifont \
1899 -text "Enter files and directories to include, one per line:"
1900 grid $top.l - -sticky w
1901 text $top.t -width 40 -height 10 -background white -font uifont
1902 if {[info exists viewfiles($n)]} {
1903 foreach f $viewfiles($n) {
1904 $top.t insert end $f
1905 $top.t insert end "\n"
1907 $top.t delete {end - 1c} end
1908 $top.t mark set insert 0.0
1910 grid $top.t - -sticky ew -padx 5
1911 frame $top.buts
1912 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1913 -font uifont
1914 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1915 -font uifont
1916 grid $top.buts.ok $top.buts.can
1917 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1918 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1919 grid $top.buts - -pady 10 -sticky ew
1920 focus $top.t
1923 proc doviewmenu {m first cmd op argv} {
1924 set nmenu [$m index end]
1925 for {set i $first} {$i <= $nmenu} {incr i} {
1926 if {[$m entrycget $i -command] eq $cmd} {
1927 eval $m $op $i $argv
1928 break
1933 proc allviewmenus {n op args} {
1934 # global viewhlmenu
1936 doviewmenu .bar.view 5 [list showview $n] $op $args
1937 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1940 proc newviewok {top n} {
1941 global nextviewnum newviewperm newviewname newishighlight
1942 global viewname viewfiles viewperm selectedview curview
1943 global viewargs newviewargs viewhlmenu
1945 if {[catch {
1946 set newargs [shellsplit $newviewargs($n)]
1947 } err]} {
1948 error_popup "Error in commit selection arguments: $err"
1949 wm raise $top
1950 focus $top
1951 return
1953 set files {}
1954 foreach f [split [$top.t get 0.0 end] "\n"] {
1955 set ft [string trim $f]
1956 if {$ft ne {}} {
1957 lappend files $ft
1960 if {![info exists viewfiles($n)]} {
1961 # creating a new view
1962 incr nextviewnum
1963 set viewname($n) $newviewname($n)
1964 set viewperm($n) $newviewperm($n)
1965 set viewfiles($n) $files
1966 set viewargs($n) $newargs
1967 addviewmenu $n
1968 if {!$newishighlight} {
1969 run showview $n
1970 } else {
1971 run addvhighlight $n
1973 } else {
1974 # editing an existing view
1975 set viewperm($n) $newviewperm($n)
1976 if {$newviewname($n) ne $viewname($n)} {
1977 set viewname($n) $newviewname($n)
1978 doviewmenu .bar.view 5 [list showview $n] \
1979 entryconf [list -label $viewname($n)]
1980 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1981 # entryconf [list -label $viewname($n) -value $viewname($n)]
1983 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1984 set viewfiles($n) $files
1985 set viewargs($n) $newargs
1986 if {$curview == $n} {
1987 run updatecommits
1991 catch {destroy $top}
1994 proc delview {} {
1995 global curview viewdata viewperm hlview selectedhlview
1997 if {$curview == 0} return
1998 if {[info exists hlview] && $hlview == $curview} {
1999 set selectedhlview None
2000 unset hlview
2002 allviewmenus $curview delete
2003 set viewdata($curview) {}
2004 set viewperm($curview) 0
2005 showview 0
2008 proc addviewmenu {n} {
2009 global viewname viewhlmenu
2011 .bar.view add radiobutton -label $viewname($n) \
2012 -command [list showview $n] -variable selectedview -value $n
2013 #$viewhlmenu add radiobutton -label $viewname($n) \
2014 # -command [list addvhighlight $n] -variable selectedhlview
2017 proc flatten {var} {
2018 global $var
2020 set ret {}
2021 foreach i [array names $var] {
2022 lappend ret $i [set $var\($i\)]
2024 return $ret
2027 proc unflatten {var l} {
2028 global $var
2030 catch {unset $var}
2031 foreach {i v} $l {
2032 set $var\($i\) $v
2036 proc showview {n} {
2037 global curview viewdata viewfiles
2038 global displayorder parentlist rowidlist rowisopt rowfinal
2039 global colormap rowtextx commitrow nextcolor canvxmax
2040 global numcommits commitlisted
2041 global selectedline currentid canv canvy0
2042 global treediffs
2043 global pending_select phase
2044 global commitidx
2045 global commfd
2046 global selectedview selectfirst
2047 global vparentlist vdisporder vcmitlisted
2048 global hlview selectedhlview commitinterest
2050 if {$n == $curview} return
2051 set selid {}
2052 if {[info exists selectedline]} {
2053 set selid $currentid
2054 set y [yc $selectedline]
2055 set ymax [lindex [$canv cget -scrollregion] 3]
2056 set span [$canv yview]
2057 set ytop [expr {[lindex $span 0] * $ymax}]
2058 set ybot [expr {[lindex $span 1] * $ymax}]
2059 if {$ytop < $y && $y < $ybot} {
2060 set yscreen [expr {$y - $ytop}]
2061 } else {
2062 set yscreen [expr {($ybot - $ytop) / 2}]
2064 } elseif {[info exists pending_select]} {
2065 set selid $pending_select
2066 unset pending_select
2068 unselectline
2069 normalline
2070 if {$curview >= 0} {
2071 set vparentlist($curview) $parentlist
2072 set vdisporder($curview) $displayorder
2073 set vcmitlisted($curview) $commitlisted
2074 if {$phase ne {} ||
2075 ![info exists viewdata($curview)] ||
2076 [lindex $viewdata($curview) 0] ne {}} {
2077 set viewdata($curview) \
2078 [list $phase $rowidlist $rowisopt $rowfinal]
2081 catch {unset treediffs}
2082 clear_display
2083 if {[info exists hlview] && $hlview == $n} {
2084 unset hlview
2085 set selectedhlview None
2087 catch {unset commitinterest}
2089 set curview $n
2090 set selectedview $n
2091 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2092 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2094 run refill_reflist
2095 if {![info exists viewdata($n)]} {
2096 if {$selid ne {}} {
2097 set pending_select $selid
2099 getcommits
2100 return
2103 set v $viewdata($n)
2104 set phase [lindex $v 0]
2105 set displayorder $vdisporder($n)
2106 set parentlist $vparentlist($n)
2107 set commitlisted $vcmitlisted($n)
2108 set rowidlist [lindex $v 1]
2109 set rowisopt [lindex $v 2]
2110 set rowfinal [lindex $v 3]
2111 set numcommits $commitidx($n)
2113 catch {unset colormap}
2114 catch {unset rowtextx}
2115 set nextcolor 0
2116 set canvxmax [$canv cget -width]
2117 set curview $n
2118 set row 0
2119 setcanvscroll
2120 set yf 0
2121 set row {}
2122 set selectfirst 0
2123 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2124 set row $commitrow($n,$selid)
2125 # try to get the selected row in the same position on the screen
2126 set ymax [lindex [$canv cget -scrollregion] 3]
2127 set ytop [expr {[yc $row] - $yscreen}]
2128 if {$ytop < 0} {
2129 set ytop 0
2131 set yf [expr {$ytop * 1.0 / $ymax}]
2133 allcanvs yview moveto $yf
2134 drawvisible
2135 if {$row ne {}} {
2136 selectline $row 0
2137 } elseif {$selid ne {}} {
2138 set pending_select $selid
2139 } else {
2140 set row [first_real_row]
2141 if {$row < $numcommits} {
2142 selectline $row 0
2143 } else {
2144 set selectfirst 1
2147 if {$phase ne {}} {
2148 if {$phase eq "getcommits"} {
2149 show_status "Reading commits..."
2151 run chewcommits $n
2152 } elseif {$numcommits == 0} {
2153 show_status "No commits selected"
2157 # Stuff relating to the highlighting facility
2159 proc ishighlighted {row} {
2160 global vhighlights fhighlights nhighlights rhighlights
2162 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2163 return $nhighlights($row)
2165 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2166 return $vhighlights($row)
2168 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2169 return $fhighlights($row)
2171 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2172 return $rhighlights($row)
2174 return 0
2177 proc bolden {row font} {
2178 global canv linehtag selectedline boldrows
2180 lappend boldrows $row
2181 $canv itemconf $linehtag($row) -font $font
2182 if {[info exists selectedline] && $row == $selectedline} {
2183 $canv delete secsel
2184 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2185 -outline {{}} -tags secsel \
2186 -fill [$canv cget -selectbackground]]
2187 $canv lower $t
2191 proc bolden_name {row font} {
2192 global canv2 linentag selectedline boldnamerows
2194 lappend boldnamerows $row
2195 $canv2 itemconf $linentag($row) -font $font
2196 if {[info exists selectedline] && $row == $selectedline} {
2197 $canv2 delete secsel
2198 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2199 -outline {{}} -tags secsel \
2200 -fill [$canv2 cget -selectbackground]]
2201 $canv2 lower $t
2205 proc unbolden {} {
2206 global boldrows
2208 set stillbold {}
2209 foreach row $boldrows {
2210 if {![ishighlighted $row]} {
2211 bolden $row mainfont
2212 } else {
2213 lappend stillbold $row
2216 set boldrows $stillbold
2219 proc addvhighlight {n} {
2220 global hlview curview viewdata vhl_done vhighlights commitidx
2222 if {[info exists hlview]} {
2223 delvhighlight
2225 set hlview $n
2226 if {$n != $curview && ![info exists viewdata($n)]} {
2227 set viewdata($n) [list getcommits {{}} 0 0 0]
2228 set vparentlist($n) {}
2229 set vdisporder($n) {}
2230 set vcmitlisted($n) {}
2231 start_rev_list $n
2233 set vhl_done $commitidx($hlview)
2234 if {$vhl_done > 0} {
2235 drawvisible
2239 proc delvhighlight {} {
2240 global hlview vhighlights
2242 if {![info exists hlview]} return
2243 unset hlview
2244 catch {unset vhighlights}
2245 unbolden
2248 proc vhighlightmore {} {
2249 global hlview vhl_done commitidx vhighlights
2250 global displayorder vdisporder curview
2252 set max $commitidx($hlview)
2253 if {$hlview == $curview} {
2254 set disp $displayorder
2255 } else {
2256 set disp $vdisporder($hlview)
2258 set vr [visiblerows]
2259 set r0 [lindex $vr 0]
2260 set r1 [lindex $vr 1]
2261 for {set i $vhl_done} {$i < $max} {incr i} {
2262 set id [lindex $disp $i]
2263 if {[info exists commitrow($curview,$id)]} {
2264 set row $commitrow($curview,$id)
2265 if {$r0 <= $row && $row <= $r1} {
2266 if {![highlighted $row]} {
2267 bolden $row mainfontbold
2269 set vhighlights($row) 1
2273 set vhl_done $max
2276 proc askvhighlight {row id} {
2277 global hlview vhighlights commitrow iddrawn
2279 if {[info exists commitrow($hlview,$id)]} {
2280 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2281 bolden $row mainfontbold
2283 set vhighlights($row) 1
2284 } else {
2285 set vhighlights($row) 0
2289 proc hfiles_change {} {
2290 global highlight_files filehighlight fhighlights fh_serial
2291 global highlight_paths gdttype
2293 if {[info exists filehighlight]} {
2294 # delete previous highlights
2295 catch {close $filehighlight}
2296 unset filehighlight
2297 catch {unset fhighlights}
2298 unbolden
2299 unhighlight_filelist
2301 set highlight_paths {}
2302 after cancel do_file_hl $fh_serial
2303 incr fh_serial
2304 if {$highlight_files ne {}} {
2305 after 300 do_file_hl $fh_serial
2309 proc gdttype_change {name ix op} {
2310 global gdttype highlight_files findstring findpattern
2312 stopfinding
2313 if {$findstring ne {}} {
2314 if {$gdttype eq "containing:"} {
2315 if {$highlight_files ne {}} {
2316 set highlight_files {}
2317 hfiles_change
2319 findcom_change
2320 } else {
2321 if {$findpattern ne {}} {
2322 set findpattern {}
2323 findcom_change
2325 set highlight_files $findstring
2326 hfiles_change
2328 drawvisible
2330 # enable/disable findtype/findloc menus too
2333 proc find_change {name ix op} {
2334 global gdttype findstring highlight_files
2336 stopfinding
2337 if {$gdttype eq "containing:"} {
2338 findcom_change
2339 } else {
2340 if {$highlight_files ne $findstring} {
2341 set highlight_files $findstring
2342 hfiles_change
2345 drawvisible
2348 proc findcom_change args {
2349 global nhighlights boldnamerows
2350 global findpattern findtype findstring gdttype
2352 stopfinding
2353 # delete previous highlights, if any
2354 foreach row $boldnamerows {
2355 bolden_name $row mainfont
2357 set boldnamerows {}
2358 catch {unset nhighlights}
2359 unbolden
2360 unmarkmatches
2361 if {$gdttype ne "containing:" || $findstring eq {}} {
2362 set findpattern {}
2363 } elseif {$findtype eq "Regexp"} {
2364 set findpattern $findstring
2365 } else {
2366 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2367 $findstring]
2368 set findpattern "*$e*"
2372 proc makepatterns {l} {
2373 set ret {}
2374 foreach e $l {
2375 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2376 if {[string index $ee end] eq "/"} {
2377 lappend ret "$ee*"
2378 } else {
2379 lappend ret $ee
2380 lappend ret "$ee/*"
2383 return $ret
2386 proc do_file_hl {serial} {
2387 global highlight_files filehighlight highlight_paths gdttype fhl_list
2389 if {$gdttype eq "touching paths:"} {
2390 if {[catch {set paths [shellsplit $highlight_files]}]} return
2391 set highlight_paths [makepatterns $paths]
2392 highlight_filelist
2393 set gdtargs [concat -- $paths]
2394 } elseif {$gdttype eq "adding/removing string:"} {
2395 set gdtargs [list "-S$highlight_files"]
2396 } else {
2397 # must be "containing:", i.e. we're searching commit info
2398 return
2400 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2401 set filehighlight [open $cmd r+]
2402 fconfigure $filehighlight -blocking 0
2403 filerun $filehighlight readfhighlight
2404 set fhl_list {}
2405 drawvisible
2406 flushhighlights
2409 proc flushhighlights {} {
2410 global filehighlight fhl_list
2412 if {[info exists filehighlight]} {
2413 lappend fhl_list {}
2414 puts $filehighlight ""
2415 flush $filehighlight
2419 proc askfilehighlight {row id} {
2420 global filehighlight fhighlights fhl_list
2422 lappend fhl_list $id
2423 set fhighlights($row) -1
2424 puts $filehighlight $id
2427 proc readfhighlight {} {
2428 global filehighlight fhighlights commitrow curview iddrawn
2429 global fhl_list find_dirn
2431 if {![info exists filehighlight]} {
2432 return 0
2434 set nr 0
2435 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2436 set line [string trim $line]
2437 set i [lsearch -exact $fhl_list $line]
2438 if {$i < 0} continue
2439 for {set j 0} {$j < $i} {incr j} {
2440 set id [lindex $fhl_list $j]
2441 if {[info exists commitrow($curview,$id)]} {
2442 set fhighlights($commitrow($curview,$id)) 0
2445 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2446 if {$line eq {}} continue
2447 if {![info exists commitrow($curview,$line)]} continue
2448 set row $commitrow($curview,$line)
2449 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2450 bolden $row mainfontbold
2452 set fhighlights($row) 1
2454 if {[eof $filehighlight]} {
2455 # strange...
2456 puts "oops, git diff-tree died"
2457 catch {close $filehighlight}
2458 unset filehighlight
2459 return 0
2461 if {[info exists find_dirn]} {
2462 if {$find_dirn > 0} {
2463 run findmore
2464 } else {
2465 run findmorerev
2468 return 1
2471 proc doesmatch {f} {
2472 global findtype findpattern
2474 if {$findtype eq "Regexp"} {
2475 return [regexp $findpattern $f]
2476 } elseif {$findtype eq "IgnCase"} {
2477 return [string match -nocase $findpattern $f]
2478 } else {
2479 return [string match $findpattern $f]
2483 proc askfindhighlight {row id} {
2484 global nhighlights commitinfo iddrawn
2485 global findloc
2486 global markingmatches
2488 if {![info exists commitinfo($id)]} {
2489 getcommit $id
2491 set info $commitinfo($id)
2492 set isbold 0
2493 set fldtypes {Headline Author Date Committer CDate Comments}
2494 foreach f $info ty $fldtypes {
2495 if {($findloc eq "All fields" || $findloc eq $ty) &&
2496 [doesmatch $f]} {
2497 if {$ty eq "Author"} {
2498 set isbold 2
2499 break
2501 set isbold 1
2504 if {$isbold && [info exists iddrawn($id)]} {
2505 if {![ishighlighted $row]} {
2506 bolden $row mainfontbold
2507 if {$isbold > 1} {
2508 bolden_name $row mainfontbold
2511 if {$markingmatches} {
2512 markrowmatches $row $id
2515 set nhighlights($row) $isbold
2518 proc markrowmatches {row id} {
2519 global canv canv2 linehtag linentag commitinfo findloc
2521 set headline [lindex $commitinfo($id) 0]
2522 set author [lindex $commitinfo($id) 1]
2523 $canv delete match$row
2524 $canv2 delete match$row
2525 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2526 set m [findmatches $headline]
2527 if {$m ne {}} {
2528 markmatches $canv $row $headline $linehtag($row) $m \
2529 [$canv itemcget $linehtag($row) -font] $row
2532 if {$findloc eq "All fields" || $findloc eq "Author"} {
2533 set m [findmatches $author]
2534 if {$m ne {}} {
2535 markmatches $canv2 $row $author $linentag($row) $m \
2536 [$canv2 itemcget $linentag($row) -font] $row
2541 proc vrel_change {name ix op} {
2542 global highlight_related
2544 rhighlight_none
2545 if {$highlight_related ne "None"} {
2546 run drawvisible
2550 # prepare for testing whether commits are descendents or ancestors of a
2551 proc rhighlight_sel {a} {
2552 global descendent desc_todo ancestor anc_todo
2553 global highlight_related rhighlights
2555 catch {unset descendent}
2556 set desc_todo [list $a]
2557 catch {unset ancestor}
2558 set anc_todo [list $a]
2559 if {$highlight_related ne "None"} {
2560 rhighlight_none
2561 run drawvisible
2565 proc rhighlight_none {} {
2566 global rhighlights
2568 catch {unset rhighlights}
2569 unbolden
2572 proc is_descendent {a} {
2573 global curview children commitrow descendent desc_todo
2575 set v $curview
2576 set la $commitrow($v,$a)
2577 set todo $desc_todo
2578 set leftover {}
2579 set done 0
2580 for {set i 0} {$i < [llength $todo]} {incr i} {
2581 set do [lindex $todo $i]
2582 if {$commitrow($v,$do) < $la} {
2583 lappend leftover $do
2584 continue
2586 foreach nk $children($v,$do) {
2587 if {![info exists descendent($nk)]} {
2588 set descendent($nk) 1
2589 lappend todo $nk
2590 if {$nk eq $a} {
2591 set done 1
2595 if {$done} {
2596 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2597 return
2600 set descendent($a) 0
2601 set desc_todo $leftover
2604 proc is_ancestor {a} {
2605 global curview parentlist commitrow ancestor anc_todo
2607 set v $curview
2608 set la $commitrow($v,$a)
2609 set todo $anc_todo
2610 set leftover {}
2611 set done 0
2612 for {set i 0} {$i < [llength $todo]} {incr i} {
2613 set do [lindex $todo $i]
2614 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2615 lappend leftover $do
2616 continue
2618 foreach np [lindex $parentlist $commitrow($v,$do)] {
2619 if {![info exists ancestor($np)]} {
2620 set ancestor($np) 1
2621 lappend todo $np
2622 if {$np eq $a} {
2623 set done 1
2627 if {$done} {
2628 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2629 return
2632 set ancestor($a) 0
2633 set anc_todo $leftover
2636 proc askrelhighlight {row id} {
2637 global descendent highlight_related iddrawn rhighlights
2638 global selectedline ancestor
2640 if {![info exists selectedline]} return
2641 set isbold 0
2642 if {$highlight_related eq "Descendent" ||
2643 $highlight_related eq "Not descendent"} {
2644 if {![info exists descendent($id)]} {
2645 is_descendent $id
2647 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2648 set isbold 1
2650 } elseif {$highlight_related eq "Ancestor" ||
2651 $highlight_related eq "Not ancestor"} {
2652 if {![info exists ancestor($id)]} {
2653 is_ancestor $id
2655 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2656 set isbold 1
2659 if {[info exists iddrawn($id)]} {
2660 if {$isbold && ![ishighlighted $row]} {
2661 bolden $row mainfontbold
2664 set rhighlights($row) $isbold
2667 # Graph layout functions
2669 proc shortids {ids} {
2670 set res {}
2671 foreach id $ids {
2672 if {[llength $id] > 1} {
2673 lappend res [shortids $id]
2674 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2675 lappend res [string range $id 0 7]
2676 } else {
2677 lappend res $id
2680 return $res
2683 proc ntimes {n o} {
2684 set ret {}
2685 set o [list $o]
2686 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2687 if {($n & $mask) != 0} {
2688 set ret [concat $ret $o]
2690 set o [concat $o $o]
2692 return $ret
2695 # Work out where id should go in idlist so that order-token
2696 # values increase from left to right
2697 proc idcol {idlist id {i 0}} {
2698 global ordertok curview
2700 set t $ordertok($curview,$id)
2701 if {$i >= [llength $idlist] ||
2702 $t < $ordertok($curview,[lindex $idlist $i])} {
2703 if {$i > [llength $idlist]} {
2704 set i [llength $idlist]
2706 while {[incr i -1] >= 0 &&
2707 $t < $ordertok($curview,[lindex $idlist $i])} {}
2708 incr i
2709 } else {
2710 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2711 while {[incr i] < [llength $idlist] &&
2712 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2715 return $i
2718 proc initlayout {} {
2719 global rowidlist rowisopt rowfinal displayorder commitlisted
2720 global numcommits canvxmax canv
2721 global nextcolor
2722 global parentlist
2723 global colormap rowtextx
2724 global selectfirst
2726 set numcommits 0
2727 set displayorder {}
2728 set commitlisted {}
2729 set parentlist {}
2730 set nextcolor 0
2731 set rowidlist {}
2732 set rowisopt {}
2733 set rowfinal {}
2734 set canvxmax [$canv cget -width]
2735 catch {unset colormap}
2736 catch {unset rowtextx}
2737 set selectfirst 1
2740 proc setcanvscroll {} {
2741 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2743 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2744 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2745 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2746 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2749 proc visiblerows {} {
2750 global canv numcommits linespc
2752 set ymax [lindex [$canv cget -scrollregion] 3]
2753 if {$ymax eq {} || $ymax == 0} return
2754 set f [$canv yview]
2755 set y0 [expr {int([lindex $f 0] * $ymax)}]
2756 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2757 if {$r0 < 0} {
2758 set r0 0
2760 set y1 [expr {int([lindex $f 1] * $ymax)}]
2761 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2762 if {$r1 >= $numcommits} {
2763 set r1 [expr {$numcommits - 1}]
2765 return [list $r0 $r1]
2768 proc layoutmore {} {
2769 global commitidx viewcomplete numcommits
2770 global uparrowlen downarrowlen mingaplen curview
2772 set show $commitidx($curview)
2773 if {$show > $numcommits || $viewcomplete($curview)} {
2774 showstuff $show $viewcomplete($curview)
2778 proc showstuff {canshow last} {
2779 global numcommits commitrow pending_select selectedline curview
2780 global mainheadid displayorder selectfirst
2781 global lastscrollset commitinterest
2783 if {$numcommits == 0} {
2784 global phase
2785 set phase "incrdraw"
2786 allcanvs delete all
2788 set r0 $numcommits
2789 set prev $numcommits
2790 set numcommits $canshow
2791 set t [clock clicks -milliseconds]
2792 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2793 set lastscrollset $t
2794 setcanvscroll
2796 set rows [visiblerows]
2797 set r1 [lindex $rows 1]
2798 if {$r1 >= $canshow} {
2799 set r1 [expr {$canshow - 1}]
2801 if {$r0 <= $r1} {
2802 drawcommits $r0 $r1
2804 if {[info exists pending_select] &&
2805 [info exists commitrow($curview,$pending_select)] &&
2806 $commitrow($curview,$pending_select) < $numcommits} {
2807 selectline $commitrow($curview,$pending_select) 1
2809 if {$selectfirst} {
2810 if {[info exists selectedline] || [info exists pending_select]} {
2811 set selectfirst 0
2812 } else {
2813 set l [first_real_row]
2814 selectline $l 1
2815 set selectfirst 0
2820 proc doshowlocalchanges {} {
2821 global curview mainheadid phase commitrow
2823 if {[info exists commitrow($curview,$mainheadid)] &&
2824 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2825 dodiffindex
2826 } elseif {$phase ne {}} {
2827 lappend commitinterest($mainheadid) {}
2831 proc dohidelocalchanges {} {
2832 global localfrow localirow lserial
2834 if {$localfrow >= 0} {
2835 removerow $localfrow
2836 set localfrow -1
2837 if {$localirow > 0} {
2838 incr localirow -1
2841 if {$localirow >= 0} {
2842 removerow $localirow
2843 set localirow -1
2845 incr lserial
2848 # spawn off a process to do git diff-index --cached HEAD
2849 proc dodiffindex {} {
2850 global localirow localfrow lserial showlocalchanges
2852 if {!$showlocalchanges} return
2853 incr lserial
2854 set localfrow -1
2855 set localirow -1
2856 set fd [open "|git diff-index --cached HEAD" r]
2857 fconfigure $fd -blocking 0
2858 filerun $fd [list readdiffindex $fd $lserial]
2861 proc readdiffindex {fd serial} {
2862 global localirow commitrow mainheadid nullid2 curview
2863 global commitinfo commitdata lserial
2865 set isdiff 1
2866 if {[gets $fd line] < 0} {
2867 if {![eof $fd]} {
2868 return 1
2870 set isdiff 0
2872 # we only need to see one line and we don't really care what it says...
2873 close $fd
2875 # now see if there are any local changes not checked in to the index
2876 if {$serial == $lserial} {
2877 set fd [open "|git diff-files" r]
2878 fconfigure $fd -blocking 0
2879 filerun $fd [list readdifffiles $fd $serial]
2882 if {$isdiff && $serial == $lserial && $localirow == -1} {
2883 # add the line for the changes in the index to the graph
2884 set localirow $commitrow($curview,$mainheadid)
2885 set hl "Local changes checked in to index but not committed"
2886 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2887 set commitdata($nullid2) "\n $hl\n"
2888 insertrow $localirow $nullid2
2890 return 0
2893 proc readdifffiles {fd serial} {
2894 global localirow localfrow commitrow mainheadid nullid curview
2895 global commitinfo commitdata lserial
2897 set isdiff 1
2898 if {[gets $fd line] < 0} {
2899 if {![eof $fd]} {
2900 return 1
2902 set isdiff 0
2904 # we only need to see one line and we don't really care what it says...
2905 close $fd
2907 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2908 # add the line for the local diff to the graph
2909 if {$localirow >= 0} {
2910 set localfrow $localirow
2911 incr localirow
2912 } else {
2913 set localfrow $commitrow($curview,$mainheadid)
2915 set hl "Local uncommitted changes, not checked in to index"
2916 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2917 set commitdata($nullid) "\n $hl\n"
2918 insertrow $localfrow $nullid
2920 return 0
2923 proc nextuse {id row} {
2924 global commitrow curview children
2926 if {[info exists children($curview,$id)]} {
2927 foreach kid $children($curview,$id) {
2928 if {![info exists commitrow($curview,$kid)]} {
2929 return -1
2931 if {$commitrow($curview,$kid) > $row} {
2932 return $commitrow($curview,$kid)
2936 if {[info exists commitrow($curview,$id)]} {
2937 return $commitrow($curview,$id)
2939 return -1
2942 proc prevuse {id row} {
2943 global commitrow curview children
2945 set ret -1
2946 if {[info exists children($curview,$id)]} {
2947 foreach kid $children($curview,$id) {
2948 if {![info exists commitrow($curview,$kid)]} break
2949 if {$commitrow($curview,$kid) < $row} {
2950 set ret $commitrow($curview,$kid)
2954 return $ret
2957 proc make_idlist {row} {
2958 global displayorder parentlist uparrowlen downarrowlen mingaplen
2959 global commitidx curview ordertok children commitrow
2961 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2962 if {$r < 0} {
2963 set r 0
2965 set ra [expr {$row - $downarrowlen}]
2966 if {$ra < 0} {
2967 set ra 0
2969 set rb [expr {$row + $uparrowlen}]
2970 if {$rb > $commitidx($curview)} {
2971 set rb $commitidx($curview)
2973 set ids {}
2974 for {} {$r < $ra} {incr r} {
2975 set nextid [lindex $displayorder [expr {$r + 1}]]
2976 foreach p [lindex $parentlist $r] {
2977 if {$p eq $nextid} continue
2978 set rn [nextuse $p $r]
2979 if {$rn >= $row &&
2980 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2981 lappend ids [list $ordertok($curview,$p) $p]
2985 for {} {$r < $row} {incr r} {
2986 set nextid [lindex $displayorder [expr {$r + 1}]]
2987 foreach p [lindex $parentlist $r] {
2988 if {$p eq $nextid} continue
2989 set rn [nextuse $p $r]
2990 if {$rn < 0 || $rn >= $row} {
2991 lappend ids [list $ordertok($curview,$p) $p]
2995 set id [lindex $displayorder $row]
2996 lappend ids [list $ordertok($curview,$id) $id]
2997 while {$r < $rb} {
2998 foreach p [lindex $parentlist $r] {
2999 set firstkid [lindex $children($curview,$p) 0]
3000 if {$commitrow($curview,$firstkid) < $row} {
3001 lappend ids [list $ordertok($curview,$p) $p]
3004 incr r
3005 set id [lindex $displayorder $r]
3006 if {$id ne {}} {
3007 set firstkid [lindex $children($curview,$id) 0]
3008 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3009 lappend ids [list $ordertok($curview,$id) $id]
3013 set idlist {}
3014 foreach idx [lsort -unique $ids] {
3015 lappend idlist [lindex $idx 1]
3017 return $idlist
3020 proc rowsequal {a b} {
3021 while {[set i [lsearch -exact $a {}]] >= 0} {
3022 set a [lreplace $a $i $i]
3024 while {[set i [lsearch -exact $b {}]] >= 0} {
3025 set b [lreplace $b $i $i]
3027 return [expr {$a eq $b}]
3030 proc makeupline {id row rend col} {
3031 global rowidlist uparrowlen downarrowlen mingaplen
3033 for {set r $rend} {1} {set r $rstart} {
3034 set rstart [prevuse $id $r]
3035 if {$rstart < 0} return
3036 if {$rstart < $row} break
3038 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3039 set rstart [expr {$rend - $uparrowlen - 1}]
3041 for {set r $rstart} {[incr r] <= $row} {} {
3042 set idlist [lindex $rowidlist $r]
3043 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3044 set col [idcol $idlist $id $col]
3045 lset rowidlist $r [linsert $idlist $col $id]
3046 changedrow $r
3051 proc layoutrows {row endrow} {
3052 global rowidlist rowisopt rowfinal displayorder
3053 global uparrowlen downarrowlen maxwidth mingaplen
3054 global children parentlist
3055 global commitidx viewcomplete curview commitrow
3057 set idlist {}
3058 if {$row > 0} {
3059 set rm1 [expr {$row - 1}]
3060 foreach id [lindex $rowidlist $rm1] {
3061 if {$id ne {}} {
3062 lappend idlist $id
3065 set final [lindex $rowfinal $rm1]
3067 for {} {$row < $endrow} {incr row} {
3068 set rm1 [expr {$row - 1}]
3069 if {$rm1 < 0 || $idlist eq {}} {
3070 set idlist [make_idlist $row]
3071 set final 1
3072 } else {
3073 set id [lindex $displayorder $rm1]
3074 set col [lsearch -exact $idlist $id]
3075 set idlist [lreplace $idlist $col $col]
3076 foreach p [lindex $parentlist $rm1] {
3077 if {[lsearch -exact $idlist $p] < 0} {
3078 set col [idcol $idlist $p $col]
3079 set idlist [linsert $idlist $col $p]
3080 # if not the first child, we have to insert a line going up
3081 if {$id ne [lindex $children($curview,$p) 0]} {
3082 makeupline $p $rm1 $row $col
3086 set id [lindex $displayorder $row]
3087 if {$row > $downarrowlen} {
3088 set termrow [expr {$row - $downarrowlen - 1}]
3089 foreach p [lindex $parentlist $termrow] {
3090 set i [lsearch -exact $idlist $p]
3091 if {$i < 0} continue
3092 set nr [nextuse $p $termrow]
3093 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3094 set idlist [lreplace $idlist $i $i]
3098 set col [lsearch -exact $idlist $id]
3099 if {$col < 0} {
3100 set col [idcol $idlist $id]
3101 set idlist [linsert $idlist $col $id]
3102 if {$children($curview,$id) ne {}} {
3103 makeupline $id $rm1 $row $col
3106 set r [expr {$row + $uparrowlen - 1}]
3107 if {$r < $commitidx($curview)} {
3108 set x $col
3109 foreach p [lindex $parentlist $r] {
3110 if {[lsearch -exact $idlist $p] >= 0} continue
3111 set fk [lindex $children($curview,$p) 0]
3112 if {$commitrow($curview,$fk) < $row} {
3113 set x [idcol $idlist $p $x]
3114 set idlist [linsert $idlist $x $p]
3117 if {[incr r] < $commitidx($curview)} {
3118 set p [lindex $displayorder $r]
3119 if {[lsearch -exact $idlist $p] < 0} {
3120 set fk [lindex $children($curview,$p) 0]
3121 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3122 set x [idcol $idlist $p $x]
3123 set idlist [linsert $idlist $x $p]
3129 if {$final && !$viewcomplete($curview) &&
3130 $row + $uparrowlen + $mingaplen + $downarrowlen
3131 >= $commitidx($curview)} {
3132 set final 0
3134 set l [llength $rowidlist]
3135 if {$row == $l} {
3136 lappend rowidlist $idlist
3137 lappend rowisopt 0
3138 lappend rowfinal $final
3139 } elseif {$row < $l} {
3140 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3141 lset rowidlist $row $idlist
3142 changedrow $row
3144 lset rowfinal $row $final
3145 } else {
3146 set pad [ntimes [expr {$row - $l}] {}]
3147 set rowidlist [concat $rowidlist $pad]
3148 lappend rowidlist $idlist
3149 set rowfinal [concat $rowfinal $pad]
3150 lappend rowfinal $final
3151 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3154 return $row
3157 proc changedrow {row} {
3158 global displayorder iddrawn rowisopt need_redisplay
3160 set l [llength $rowisopt]
3161 if {$row < $l} {
3162 lset rowisopt $row 0
3163 if {$row + 1 < $l} {
3164 lset rowisopt [expr {$row + 1}] 0
3165 if {$row + 2 < $l} {
3166 lset rowisopt [expr {$row + 2}] 0
3170 set id [lindex $displayorder $row]
3171 if {[info exists iddrawn($id)]} {
3172 set need_redisplay 1
3176 proc insert_pad {row col npad} {
3177 global rowidlist
3179 set pad [ntimes $npad {}]
3180 set idlist [lindex $rowidlist $row]
3181 set bef [lrange $idlist 0 [expr {$col - 1}]]
3182 set aft [lrange $idlist $col end]
3183 set i [lsearch -exact $aft {}]
3184 if {$i > 0} {
3185 set aft [lreplace $aft $i $i]
3187 lset rowidlist $row [concat $bef $pad $aft]
3188 changedrow $row
3191 proc optimize_rows {row col endrow} {
3192 global rowidlist rowisopt displayorder curview children
3194 if {$row < 1} {
3195 set row 1
3197 for {} {$row < $endrow} {incr row; set col 0} {
3198 if {[lindex $rowisopt $row]} continue
3199 set haspad 0
3200 set y0 [expr {$row - 1}]
3201 set ym [expr {$row - 2}]
3202 set idlist [lindex $rowidlist $row]
3203 set previdlist [lindex $rowidlist $y0]
3204 if {$idlist eq {} || $previdlist eq {}} continue
3205 if {$ym >= 0} {
3206 set pprevidlist [lindex $rowidlist $ym]
3207 if {$pprevidlist eq {}} continue
3208 } else {
3209 set pprevidlist {}
3211 set x0 -1
3212 set xm -1
3213 for {} {$col < [llength $idlist]} {incr col} {
3214 set id [lindex $idlist $col]
3215 if {[lindex $previdlist $col] eq $id} continue
3216 if {$id eq {}} {
3217 set haspad 1
3218 continue
3220 set x0 [lsearch -exact $previdlist $id]
3221 if {$x0 < 0} continue
3222 set z [expr {$x0 - $col}]
3223 set isarrow 0
3224 set z0 {}
3225 if {$ym >= 0} {
3226 set xm [lsearch -exact $pprevidlist $id]
3227 if {$xm >= 0} {
3228 set z0 [expr {$xm - $x0}]
3231 if {$z0 eq {}} {
3232 # if row y0 is the first child of $id then it's not an arrow
3233 if {[lindex $children($curview,$id) 0] ne
3234 [lindex $displayorder $y0]} {
3235 set isarrow 1
3238 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3239 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3240 set isarrow 1
3242 # Looking at lines from this row to the previous row,
3243 # make them go straight up if they end in an arrow on
3244 # the previous row; otherwise make them go straight up
3245 # or at 45 degrees.
3246 if {$z < -1 || ($z < 0 && $isarrow)} {
3247 # Line currently goes left too much;
3248 # insert pads in the previous row, then optimize it
3249 set npad [expr {-1 - $z + $isarrow}]
3250 insert_pad $y0 $x0 $npad
3251 if {$y0 > 0} {
3252 optimize_rows $y0 $x0 $row
3254 set previdlist [lindex $rowidlist $y0]
3255 set x0 [lsearch -exact $previdlist $id]
3256 set z [expr {$x0 - $col}]
3257 if {$z0 ne {}} {
3258 set pprevidlist [lindex $rowidlist $ym]
3259 set xm [lsearch -exact $pprevidlist $id]
3260 set z0 [expr {$xm - $x0}]
3262 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3263 # Line currently goes right too much;
3264 # insert pads in this line
3265 set npad [expr {$z - 1 + $isarrow}]
3266 insert_pad $row $col $npad
3267 set idlist [lindex $rowidlist $row]
3268 incr col $npad
3269 set z [expr {$x0 - $col}]
3270 set haspad 1
3272 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3273 # this line links to its first child on row $row-2
3274 set id [lindex $displayorder $ym]
3275 set xc [lsearch -exact $pprevidlist $id]
3276 if {$xc >= 0} {
3277 set z0 [expr {$xc - $x0}]
3280 # avoid lines jigging left then immediately right
3281 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3282 insert_pad $y0 $x0 1
3283 incr x0
3284 optimize_rows $y0 $x0 $row
3285 set previdlist [lindex $rowidlist $y0]
3288 if {!$haspad} {
3289 # Find the first column that doesn't have a line going right
3290 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3291 set id [lindex $idlist $col]
3292 if {$id eq {}} break
3293 set x0 [lsearch -exact $previdlist $id]
3294 if {$x0 < 0} {
3295 # check if this is the link to the first child
3296 set kid [lindex $displayorder $y0]
3297 if {[lindex $children($curview,$id) 0] eq $kid} {
3298 # it is, work out offset to child
3299 set x0 [lsearch -exact $previdlist $kid]
3302 if {$x0 <= $col} break
3304 # Insert a pad at that column as long as it has a line and
3305 # isn't the last column
3306 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3307 set idlist [linsert $idlist $col {}]
3308 lset rowidlist $row $idlist
3309 changedrow $row
3315 proc xc {row col} {
3316 global canvx0 linespc
3317 return [expr {$canvx0 + $col * $linespc}]
3320 proc yc {row} {
3321 global canvy0 linespc
3322 return [expr {$canvy0 + $row * $linespc}]
3325 proc linewidth {id} {
3326 global thickerline lthickness
3328 set wid $lthickness
3329 if {[info exists thickerline] && $id eq $thickerline} {
3330 set wid [expr {2 * $lthickness}]
3332 return $wid
3335 proc rowranges {id} {
3336 global commitrow curview children uparrowlen downarrowlen
3337 global rowidlist
3339 set kids $children($curview,$id)
3340 if {$kids eq {}} {
3341 return {}
3343 set ret {}
3344 lappend kids $id
3345 foreach child $kids {
3346 if {![info exists commitrow($curview,$child)]} break
3347 set row $commitrow($curview,$child)
3348 if {![info exists prev]} {
3349 lappend ret [expr {$row + 1}]
3350 } else {
3351 if {$row <= $prevrow} {
3352 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3354 # see if the line extends the whole way from prevrow to row
3355 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3356 [lsearch -exact [lindex $rowidlist \
3357 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3358 # it doesn't, see where it ends
3359 set r [expr {$prevrow + $downarrowlen}]
3360 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3361 while {[incr r -1] > $prevrow &&
3362 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3363 } else {
3364 while {[incr r] <= $row &&
3365 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3366 incr r -1
3368 lappend ret $r
3369 # see where it starts up again
3370 set r [expr {$row - $uparrowlen}]
3371 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3372 while {[incr r] < $row &&
3373 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3374 } else {
3375 while {[incr r -1] >= $prevrow &&
3376 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3377 incr r
3379 lappend ret $r
3382 if {$child eq $id} {
3383 lappend ret $row
3385 set prev $id
3386 set prevrow $row
3388 return $ret
3391 proc drawlineseg {id row endrow arrowlow} {
3392 global rowidlist displayorder iddrawn linesegs
3393 global canv colormap linespc curview maxlinelen parentlist
3395 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3396 set le [expr {$row + 1}]
3397 set arrowhigh 1
3398 while {1} {
3399 set c [lsearch -exact [lindex $rowidlist $le] $id]
3400 if {$c < 0} {
3401 incr le -1
3402 break
3404 lappend cols $c
3405 set x [lindex $displayorder $le]
3406 if {$x eq $id} {
3407 set arrowhigh 0
3408 break
3410 if {[info exists iddrawn($x)] || $le == $endrow} {
3411 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3412 if {$c >= 0} {
3413 lappend cols $c
3414 set arrowhigh 0
3416 break
3418 incr le
3420 if {$le <= $row} {
3421 return $row
3424 set lines {}
3425 set i 0
3426 set joinhigh 0
3427 if {[info exists linesegs($id)]} {
3428 set lines $linesegs($id)
3429 foreach li $lines {
3430 set r0 [lindex $li 0]
3431 if {$r0 > $row} {
3432 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3433 set joinhigh 1
3435 break
3437 incr i
3440 set joinlow 0
3441 if {$i > 0} {
3442 set li [lindex $lines [expr {$i-1}]]
3443 set r1 [lindex $li 1]
3444 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3445 set joinlow 1
3449 set x [lindex $cols [expr {$le - $row}]]
3450 set xp [lindex $cols [expr {$le - 1 - $row}]]
3451 set dir [expr {$xp - $x}]
3452 if {$joinhigh} {
3453 set ith [lindex $lines $i 2]
3454 set coords [$canv coords $ith]
3455 set ah [$canv itemcget $ith -arrow]
3456 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3457 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3458 if {$x2 ne {} && $x - $x2 == $dir} {
3459 set coords [lrange $coords 0 end-2]
3461 } else {
3462 set coords [list [xc $le $x] [yc $le]]
3464 if {$joinlow} {
3465 set itl [lindex $lines [expr {$i-1}] 2]
3466 set al [$canv itemcget $itl -arrow]
3467 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3468 } elseif {$arrowlow} {
3469 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3470 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3471 set arrowlow 0
3474 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3475 for {set y $le} {[incr y -1] > $row} {} {
3476 set x $xp
3477 set xp [lindex $cols [expr {$y - 1 - $row}]]
3478 set ndir [expr {$xp - $x}]
3479 if {$dir != $ndir || $xp < 0} {
3480 lappend coords [xc $y $x] [yc $y]
3482 set dir $ndir
3484 if {!$joinlow} {
3485 if {$xp < 0} {
3486 # join parent line to first child
3487 set ch [lindex $displayorder $row]
3488 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3489 if {$xc < 0} {
3490 puts "oops: drawlineseg: child $ch not on row $row"
3491 } elseif {$xc != $x} {
3492 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3493 set d [expr {int(0.5 * $linespc)}]
3494 set x1 [xc $row $x]
3495 if {$xc < $x} {
3496 set x2 [expr {$x1 - $d}]
3497 } else {
3498 set x2 [expr {$x1 + $d}]
3500 set y2 [yc $row]
3501 set y1 [expr {$y2 + $d}]
3502 lappend coords $x1 $y1 $x2 $y2
3503 } elseif {$xc < $x - 1} {
3504 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3505 } elseif {$xc > $x + 1} {
3506 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3508 set x $xc
3510 lappend coords [xc $row $x] [yc $row]
3511 } else {
3512 set xn [xc $row $xp]
3513 set yn [yc $row]
3514 lappend coords $xn $yn
3516 if {!$joinhigh} {
3517 assigncolor $id
3518 set t [$canv create line $coords -width [linewidth $id] \
3519 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3520 $canv lower $t
3521 bindline $t $id
3522 set lines [linsert $lines $i [list $row $le $t]]
3523 } else {
3524 $canv coords $ith $coords
3525 if {$arrow ne $ah} {
3526 $canv itemconf $ith -arrow $arrow
3528 lset lines $i 0 $row
3530 } else {
3531 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3532 set ndir [expr {$xo - $xp}]
3533 set clow [$canv coords $itl]
3534 if {$dir == $ndir} {
3535 set clow [lrange $clow 2 end]
3537 set coords [concat $coords $clow]
3538 if {!$joinhigh} {
3539 lset lines [expr {$i-1}] 1 $le
3540 } else {
3541 # coalesce two pieces
3542 $canv delete $ith
3543 set b [lindex $lines [expr {$i-1}] 0]
3544 set e [lindex $lines $i 1]
3545 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3547 $canv coords $itl $coords
3548 if {$arrow ne $al} {
3549 $canv itemconf $itl -arrow $arrow
3553 set linesegs($id) $lines
3554 return $le
3557 proc drawparentlinks {id row} {
3558 global rowidlist canv colormap curview parentlist
3559 global idpos linespc
3561 set rowids [lindex $rowidlist $row]
3562 set col [lsearch -exact $rowids $id]
3563 if {$col < 0} return
3564 set olds [lindex $parentlist $row]
3565 set row2 [expr {$row + 1}]
3566 set x [xc $row $col]
3567 set y [yc $row]
3568 set y2 [yc $row2]
3569 set d [expr {int(0.5 * $linespc)}]
3570 set ymid [expr {$y + $d}]
3571 set ids [lindex $rowidlist $row2]
3572 # rmx = right-most X coord used
3573 set rmx 0
3574 foreach p $olds {
3575 set i [lsearch -exact $ids $p]
3576 if {$i < 0} {
3577 puts "oops, parent $p of $id not in list"
3578 continue
3580 set x2 [xc $row2 $i]
3581 if {$x2 > $rmx} {
3582 set rmx $x2
3584 set j [lsearch -exact $rowids $p]
3585 if {$j < 0} {
3586 # drawlineseg will do this one for us
3587 continue
3589 assigncolor $p
3590 # should handle duplicated parents here...
3591 set coords [list $x $y]
3592 if {$i != $col} {
3593 # if attaching to a vertical segment, draw a smaller
3594 # slant for visual distinctness
3595 if {$i == $j} {
3596 if {$i < $col} {
3597 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3598 } else {
3599 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3601 } elseif {$i < $col && $i < $j} {
3602 # segment slants towards us already
3603 lappend coords [xc $row $j] $y
3604 } else {
3605 if {$i < $col - 1} {
3606 lappend coords [expr {$x2 + $linespc}] $y
3607 } elseif {$i > $col + 1} {
3608 lappend coords [expr {$x2 - $linespc}] $y
3610 lappend coords $x2 $y2
3612 } else {
3613 lappend coords $x2 $y2
3615 set t [$canv create line $coords -width [linewidth $p] \
3616 -fill $colormap($p) -tags lines.$p]
3617 $canv lower $t
3618 bindline $t $p
3620 if {$rmx > [lindex $idpos($id) 1]} {
3621 lset idpos($id) 1 $rmx
3622 redrawtags $id
3626 proc drawlines {id} {
3627 global canv
3629 $canv itemconf lines.$id -width [linewidth $id]
3632 proc drawcmittext {id row col} {
3633 global linespc canv canv2 canv3 canvy0 fgcolor curview
3634 global commitlisted commitinfo rowidlist parentlist
3635 global rowtextx idpos idtags idheads idotherrefs
3636 global linehtag linentag linedtag selectedline
3637 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3639 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3640 set listed [lindex $commitlisted $row]
3641 if {$id eq $nullid} {
3642 set ofill red
3643 } elseif {$id eq $nullid2} {
3644 set ofill green
3645 } else {
3646 set ofill [expr {$listed != 0? "blue": "white"}]
3648 set x [xc $row $col]
3649 set y [yc $row]
3650 set orad [expr {$linespc / 3}]
3651 if {$listed <= 1} {
3652 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3653 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3654 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3655 } elseif {$listed == 2} {
3656 # triangle pointing left for left-side commits
3657 set t [$canv create polygon \
3658 [expr {$x - $orad}] $y \
3659 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3660 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3661 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3662 } else {
3663 # triangle pointing right for right-side commits
3664 set t [$canv create polygon \
3665 [expr {$x + $orad - 1}] $y \
3666 [expr {$x - $orad}] [expr {$y - $orad}] \
3667 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3668 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3670 $canv raise $t
3671 $canv bind $t <1> {selcanvline {} %x %y}
3672 set rmx [llength [lindex $rowidlist $row]]
3673 set olds [lindex $parentlist $row]
3674 if {$olds ne {}} {
3675 set nextids [lindex $rowidlist [expr {$row + 1}]]
3676 foreach p $olds {
3677 set i [lsearch -exact $nextids $p]
3678 if {$i > $rmx} {
3679 set rmx $i
3683 set xt [xc $row $rmx]
3684 set rowtextx($row) $xt
3685 set idpos($id) [list $x $xt $y]
3686 if {[info exists idtags($id)] || [info exists idheads($id)]
3687 || [info exists idotherrefs($id)]} {
3688 set xt [drawtags $id $x $xt $y]
3690 set headline [lindex $commitinfo($id) 0]
3691 set name [lindex $commitinfo($id) 1]
3692 set date [lindex $commitinfo($id) 2]
3693 set date [formatdate $date]
3694 set font mainfont
3695 set nfont mainfont
3696 set isbold [ishighlighted $row]
3697 if {$isbold > 0} {
3698 lappend boldrows $row
3699 set font mainfontbold
3700 if {$isbold > 1} {
3701 lappend boldnamerows $row
3702 set nfont mainfontbold
3705 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3706 -text $headline -font $font -tags text]
3707 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3708 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3709 -text $name -font $nfont -tags text]
3710 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3711 -text $date -font mainfont -tags text]
3712 if {[info exists selectedline] && $selectedline == $row} {
3713 make_secsel $row
3715 set xr [expr {$xt + [font measure $font $headline]}]
3716 if {$xr > $canvxmax} {
3717 set canvxmax $xr
3718 setcanvscroll
3722 proc drawcmitrow {row} {
3723 global displayorder rowidlist nrows_drawn
3724 global iddrawn markingmatches
3725 global commitinfo parentlist numcommits
3726 global filehighlight fhighlights findpattern nhighlights
3727 global hlview vhighlights
3728 global highlight_related rhighlights
3730 if {$row >= $numcommits} return
3732 set id [lindex $displayorder $row]
3733 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3734 askvhighlight $row $id
3736 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3737 askfilehighlight $row $id
3739 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3740 askfindhighlight $row $id
3742 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3743 askrelhighlight $row $id
3745 if {![info exists iddrawn($id)]} {
3746 set col [lsearch -exact [lindex $rowidlist $row] $id]
3747 if {$col < 0} {
3748 puts "oops, row $row id $id not in list"
3749 return
3751 if {![info exists commitinfo($id)]} {
3752 getcommit $id
3754 assigncolor $id
3755 drawcmittext $id $row $col
3756 set iddrawn($id) 1
3757 incr nrows_drawn
3759 if {$markingmatches} {
3760 markrowmatches $row $id
3764 proc drawcommits {row {endrow {}}} {
3765 global numcommits iddrawn displayorder curview need_redisplay
3766 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3768 if {$row < 0} {
3769 set row 0
3771 if {$endrow eq {}} {
3772 set endrow $row
3774 if {$endrow >= $numcommits} {
3775 set endrow [expr {$numcommits - 1}]
3778 set rl1 [expr {$row - $downarrowlen - 3}]
3779 if {$rl1 < 0} {
3780 set rl1 0
3782 set ro1 [expr {$row - 3}]
3783 if {$ro1 < 0} {
3784 set ro1 0
3786 set r2 [expr {$endrow + $uparrowlen + 3}]
3787 if {$r2 > $numcommits} {
3788 set r2 $numcommits
3790 for {set r $rl1} {$r < $r2} {incr r} {
3791 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3792 if {$rl1 < $r} {
3793 layoutrows $rl1 $r
3795 set rl1 [expr {$r + 1}]
3798 if {$rl1 < $r} {
3799 layoutrows $rl1 $r
3801 optimize_rows $ro1 0 $r2
3802 if {$need_redisplay || $nrows_drawn > 2000} {
3803 clear_display
3804 drawvisible
3807 # make the lines join to already-drawn rows either side
3808 set r [expr {$row - 1}]
3809 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3810 set r $row
3812 set er [expr {$endrow + 1}]
3813 if {$er >= $numcommits ||
3814 ![info exists iddrawn([lindex $displayorder $er])]} {
3815 set er $endrow
3817 for {} {$r <= $er} {incr r} {
3818 set id [lindex $displayorder $r]
3819 set wasdrawn [info exists iddrawn($id)]
3820 drawcmitrow $r
3821 if {$r == $er} break
3822 set nextid [lindex $displayorder [expr {$r + 1}]]
3823 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3824 drawparentlinks $id $r
3826 set rowids [lindex $rowidlist $r]
3827 foreach lid $rowids {
3828 if {$lid eq {}} continue
3829 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3830 if {$lid eq $id} {
3831 # see if this is the first child of any of its parents
3832 foreach p [lindex $parentlist $r] {
3833 if {[lsearch -exact $rowids $p] < 0} {
3834 # make this line extend up to the child
3835 set lineend($p) [drawlineseg $p $r $er 0]
3838 } else {
3839 set lineend($lid) [drawlineseg $lid $r $er 1]
3845 proc drawfrac {f0 f1} {
3846 global canv linespc
3848 set ymax [lindex [$canv cget -scrollregion] 3]
3849 if {$ymax eq {} || $ymax == 0} return
3850 set y0 [expr {int($f0 * $ymax)}]
3851 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3852 set y1 [expr {int($f1 * $ymax)}]
3853 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3854 drawcommits $row $endrow
3857 proc drawvisible {} {
3858 global canv
3859 eval drawfrac [$canv yview]
3862 proc clear_display {} {
3863 global iddrawn linesegs need_redisplay nrows_drawn
3864 global vhighlights fhighlights nhighlights rhighlights
3866 allcanvs delete all
3867 catch {unset iddrawn}
3868 catch {unset linesegs}
3869 catch {unset vhighlights}
3870 catch {unset fhighlights}
3871 catch {unset nhighlights}
3872 catch {unset rhighlights}
3873 set need_redisplay 0
3874 set nrows_drawn 0
3877 proc findcrossings {id} {
3878 global rowidlist parentlist numcommits displayorder
3880 set cross {}
3881 set ccross {}
3882 foreach {s e} [rowranges $id] {
3883 if {$e >= $numcommits} {
3884 set e [expr {$numcommits - 1}]
3886 if {$e <= $s} continue
3887 for {set row $e} {[incr row -1] >= $s} {} {
3888 set x [lsearch -exact [lindex $rowidlist $row] $id]
3889 if {$x < 0} break
3890 set olds [lindex $parentlist $row]
3891 set kid [lindex $displayorder $row]
3892 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3893 if {$kidx < 0} continue
3894 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3895 foreach p $olds {
3896 set px [lsearch -exact $nextrow $p]
3897 if {$px < 0} continue
3898 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3899 if {[lsearch -exact $ccross $p] >= 0} continue
3900 if {$x == $px + ($kidx < $px? -1: 1)} {
3901 lappend ccross $p
3902 } elseif {[lsearch -exact $cross $p] < 0} {
3903 lappend cross $p
3909 return [concat $ccross {{}} $cross]
3912 proc assigncolor {id} {
3913 global colormap colors nextcolor
3914 global commitrow parentlist children children curview
3916 if {[info exists colormap($id)]} return
3917 set ncolors [llength $colors]
3918 if {[info exists children($curview,$id)]} {
3919 set kids $children($curview,$id)
3920 } else {
3921 set kids {}
3923 if {[llength $kids] == 1} {
3924 set child [lindex $kids 0]
3925 if {[info exists colormap($child)]
3926 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3927 set colormap($id) $colormap($child)
3928 return
3931 set badcolors {}
3932 set origbad {}
3933 foreach x [findcrossings $id] {
3934 if {$x eq {}} {
3935 # delimiter between corner crossings and other crossings
3936 if {[llength $badcolors] >= $ncolors - 1} break
3937 set origbad $badcolors
3939 if {[info exists colormap($x)]
3940 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3941 lappend badcolors $colormap($x)
3944 if {[llength $badcolors] >= $ncolors} {
3945 set badcolors $origbad
3947 set origbad $badcolors
3948 if {[llength $badcolors] < $ncolors - 1} {
3949 foreach child $kids {
3950 if {[info exists colormap($child)]
3951 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3952 lappend badcolors $colormap($child)
3954 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3955 if {[info exists colormap($p)]
3956 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3957 lappend badcolors $colormap($p)
3961 if {[llength $badcolors] >= $ncolors} {
3962 set badcolors $origbad
3965 for {set i 0} {$i <= $ncolors} {incr i} {
3966 set c [lindex $colors $nextcolor]
3967 if {[incr nextcolor] >= $ncolors} {
3968 set nextcolor 0
3970 if {[lsearch -exact $badcolors $c]} break
3972 set colormap($id) $c
3975 proc bindline {t id} {
3976 global canv
3978 $canv bind $t <Enter> "lineenter %x %y $id"
3979 $canv bind $t <Motion> "linemotion %x %y $id"
3980 $canv bind $t <Leave> "lineleave $id"
3981 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3984 proc drawtags {id x xt y1} {
3985 global idtags idheads idotherrefs mainhead
3986 global linespc lthickness
3987 global canv commitrow rowtextx curview fgcolor bgcolor
3989 set marks {}
3990 set ntags 0
3991 set nheads 0
3992 if {[info exists idtags($id)]} {
3993 set marks $idtags($id)
3994 set ntags [llength $marks]
3996 if {[info exists idheads($id)]} {
3997 set marks [concat $marks $idheads($id)]
3998 set nheads [llength $idheads($id)]
4000 if {[info exists idotherrefs($id)]} {
4001 set marks [concat $marks $idotherrefs($id)]
4003 if {$marks eq {}} {
4004 return $xt
4007 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4008 set yt [expr {$y1 - 0.5 * $linespc}]
4009 set yb [expr {$yt + $linespc - 1}]
4010 set xvals {}
4011 set wvals {}
4012 set i -1
4013 foreach tag $marks {
4014 incr i
4015 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4016 set wid [font measure mainfontbold $tag]
4017 } else {
4018 set wid [font measure mainfont $tag]
4020 lappend xvals $xt
4021 lappend wvals $wid
4022 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4024 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4025 -width $lthickness -fill black -tags tag.$id]
4026 $canv lower $t
4027 foreach tag $marks x $xvals wid $wvals {
4028 set xl [expr {$x + $delta}]
4029 set xr [expr {$x + $delta + $wid + $lthickness}]
4030 set font mainfont
4031 if {[incr ntags -1] >= 0} {
4032 # draw a tag
4033 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4034 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4035 -width 1 -outline black -fill yellow -tags tag.$id]
4036 $canv bind $t <1> [list showtag $tag 1]
4037 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4038 } else {
4039 # draw a head or other ref
4040 if {[incr nheads -1] >= 0} {
4041 set col green
4042 if {$tag eq $mainhead} {
4043 set font mainfontbold
4045 } else {
4046 set col "#ddddff"
4048 set xl [expr {$xl - $delta/2}]
4049 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4050 -width 1 -outline black -fill $col -tags tag.$id
4051 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4052 set rwid [font measure mainfont $remoteprefix]
4053 set xi [expr {$x + 1}]
4054 set yti [expr {$yt + 1}]
4055 set xri [expr {$x + $rwid}]
4056 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4057 -width 0 -fill "#ffddaa" -tags tag.$id
4060 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4061 -font $font -tags [list tag.$id text]]
4062 if {$ntags >= 0} {
4063 $canv bind $t <1> [list showtag $tag 1]
4064 } elseif {$nheads >= 0} {
4065 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4068 return $xt
4071 proc xcoord {i level ln} {
4072 global canvx0 xspc1 xspc2
4074 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4075 if {$i > 0 && $i == $level} {
4076 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4077 } elseif {$i > $level} {
4078 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4080 return $x
4083 proc show_status {msg} {
4084 global canv fgcolor
4086 clear_display
4087 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4088 -tags text -fill $fgcolor
4091 # Insert a new commit as the child of the commit on row $row.
4092 # The new commit will be displayed on row $row and the commits
4093 # on that row and below will move down one row.
4094 proc insertrow {row newcmit} {
4095 global displayorder parentlist commitlisted children
4096 global commitrow curview rowidlist rowisopt rowfinal numcommits
4097 global numcommits
4098 global selectedline commitidx ordertok
4100 if {$row >= $numcommits} {
4101 puts "oops, inserting new row $row but only have $numcommits rows"
4102 return
4104 set p [lindex $displayorder $row]
4105 set displayorder [linsert $displayorder $row $newcmit]
4106 set parentlist [linsert $parentlist $row $p]
4107 set kids $children($curview,$p)
4108 lappend kids $newcmit
4109 set children($curview,$p) $kids
4110 set children($curview,$newcmit) {}
4111 set commitlisted [linsert $commitlisted $row 1]
4112 set l [llength $displayorder]
4113 for {set r $row} {$r < $l} {incr r} {
4114 set id [lindex $displayorder $r]
4115 set commitrow($curview,$id) $r
4117 incr commitidx($curview)
4118 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4120 if {$row < [llength $rowidlist]} {
4121 set idlist [lindex $rowidlist $row]
4122 if {$idlist ne {}} {
4123 if {[llength $kids] == 1} {
4124 set col [lsearch -exact $idlist $p]
4125 lset idlist $col $newcmit
4126 } else {
4127 set col [llength $idlist]
4128 lappend idlist $newcmit
4131 set rowidlist [linsert $rowidlist $row $idlist]
4132 set rowisopt [linsert $rowisopt $row 0]
4133 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4136 incr numcommits
4138 if {[info exists selectedline] && $selectedline >= $row} {
4139 incr selectedline
4141 redisplay
4144 # Remove a commit that was inserted with insertrow on row $row.
4145 proc removerow {row} {
4146 global displayorder parentlist commitlisted children
4147 global commitrow curview rowidlist rowisopt rowfinal numcommits
4148 global numcommits
4149 global linesegends selectedline commitidx
4151 if {$row >= $numcommits} {
4152 puts "oops, removing row $row but only have $numcommits rows"
4153 return
4155 set rp1 [expr {$row + 1}]
4156 set id [lindex $displayorder $row]
4157 set p [lindex $parentlist $row]
4158 set displayorder [lreplace $displayorder $row $row]
4159 set parentlist [lreplace $parentlist $row $row]
4160 set commitlisted [lreplace $commitlisted $row $row]
4161 set kids $children($curview,$p)
4162 set i [lsearch -exact $kids $id]
4163 if {$i >= 0} {
4164 set kids [lreplace $kids $i $i]
4165 set children($curview,$p) $kids
4167 set l [llength $displayorder]
4168 for {set r $row} {$r < $l} {incr r} {
4169 set id [lindex $displayorder $r]
4170 set commitrow($curview,$id) $r
4172 incr commitidx($curview) -1
4174 if {$row < [llength $rowidlist]} {
4175 set rowidlist [lreplace $rowidlist $row $row]
4176 set rowisopt [lreplace $rowisopt $row $row]
4177 set rowfinal [lreplace $rowfinal $row $row]
4180 incr numcommits -1
4182 if {[info exists selectedline] && $selectedline > $row} {
4183 incr selectedline -1
4185 redisplay
4188 # Don't change the text pane cursor if it is currently the hand cursor,
4189 # showing that we are over a sha1 ID link.
4190 proc settextcursor {c} {
4191 global ctext curtextcursor
4193 if {[$ctext cget -cursor] == $curtextcursor} {
4194 $ctext config -cursor $c
4196 set curtextcursor $c
4199 proc nowbusy {what {name {}}} {
4200 global isbusy busyname statusw
4202 if {[array names isbusy] eq {}} {
4203 . config -cursor watch
4204 settextcursor watch
4206 set isbusy($what) 1
4207 set busyname($what) $name
4208 if {$name ne {}} {
4209 $statusw conf -text $name
4213 proc notbusy {what} {
4214 global isbusy maincursor textcursor busyname statusw
4216 catch {
4217 unset isbusy($what)
4218 if {$busyname($what) ne {} &&
4219 [$statusw cget -text] eq $busyname($what)} {
4220 $statusw conf -text {}
4223 if {[array names isbusy] eq {}} {
4224 . config -cursor $maincursor
4225 settextcursor $textcursor
4229 proc findmatches {f} {
4230 global findtype findstring
4231 if {$findtype == "Regexp"} {
4232 set matches [regexp -indices -all -inline $findstring $f]
4233 } else {
4234 set fs $findstring
4235 if {$findtype == "IgnCase"} {
4236 set f [string tolower $f]
4237 set fs [string tolower $fs]
4239 set matches {}
4240 set i 0
4241 set l [string length $fs]
4242 while {[set j [string first $fs $f $i]] >= 0} {
4243 lappend matches [list $j [expr {$j+$l-1}]]
4244 set i [expr {$j + $l}]
4247 return $matches
4250 proc dofind {{rev 0}} {
4251 global findstring findstartline findcurline selectedline numcommits
4252 global gdttype filehighlight fh_serial find_dirn
4254 unmarkmatches
4255 focus .
4256 if {$findstring eq {} || $numcommits == 0} return
4257 if {![info exists selectedline]} {
4258 set findstartline [lindex [visiblerows] $rev]
4259 } else {
4260 set findstartline $selectedline
4262 set findcurline $findstartline
4263 nowbusy finding "Searching"
4264 if {$gdttype ne "containing:" && ![info exists filehighlight]} {
4265 after cancel do_file_hl $fh_serial
4266 do_file_hl $fh_serial
4268 if {!$rev} {
4269 set find_dirn 1
4270 run findmore
4271 } else {
4272 set find_dirn -1
4273 run findmorerev
4277 proc stopfinding {} {
4278 global find_dirn findcurline fprogcoord
4280 if {[info exists find_dirn]} {
4281 unset find_dirn
4282 unset findcurline
4283 notbusy finding
4284 set fprogcoord 0
4285 adjustprogress
4289 proc findnext {restart} {
4290 global findcurline find_dirn
4292 if {[info exists find_dirn]} return
4293 if {![info exists findcurline]} {
4294 if {$restart} {
4295 dofind
4296 } else {
4297 bell
4299 } else {
4300 set find_dirn 1
4301 run findmore
4302 nowbusy finding "Searching"
4306 proc findprev {} {
4307 global findcurline find_dirn
4309 if {[info exists find_dirn]} return
4310 if {![info exists findcurline]} {
4311 dofind 1
4312 } else {
4313 set find_dirn -1
4314 run findmorerev
4315 nowbusy finding "Searching"
4319 proc findmore {} {
4320 global commitdata commitinfo numcommits findpattern findloc
4321 global findstartline findcurline displayorder
4322 global find_dirn gdttype fhighlights fprogcoord
4324 if {![info exists find_dirn]} {
4325 return 0
4327 set fldtypes {Headline Author Date Committer CDate Comments}
4328 set l [expr {$findcurline + 1}]
4329 if {$l >= $numcommits} {
4330 set l 0
4332 if {$l <= $findstartline} {
4333 set lim [expr {$findstartline + 1}]
4334 } else {
4335 set lim $numcommits
4337 if {$lim - $l > 500} {
4338 set lim [expr {$l + 500}]
4340 set found 0
4341 set domore 1
4342 if {$gdttype eq "containing:"} {
4343 for {} {$l < $lim} {incr l} {
4344 set id [lindex $displayorder $l]
4345 # shouldn't happen unless git log doesn't give all the commits...
4346 if {![info exists commitdata($id)]} continue
4347 if {![doesmatch $commitdata($id)]} continue
4348 if {![info exists commitinfo($id)]} {
4349 getcommit $id
4351 set info $commitinfo($id)
4352 foreach f $info ty $fldtypes {
4353 if {($findloc eq "All fields" || $findloc eq $ty) &&
4354 [doesmatch $f]} {
4355 set found 1
4356 break
4359 if {$found} break
4361 } else {
4362 for {} {$l < $lim} {incr l} {
4363 set id [lindex $displayorder $l]
4364 if {![info exists fhighlights($l)]} {
4365 askfilehighlight $l $id
4366 if {$domore} {
4367 set domore 0
4368 set findcurline [expr {$l - 1}]
4370 } elseif {$fhighlights($l)} {
4371 set found $domore
4372 break
4376 if {$found || ($domore && $l == $findstartline + 1)} {
4377 unset findcurline
4378 unset find_dirn
4379 notbusy finding
4380 set fprogcoord 0
4381 adjustprogress
4382 if {$found} {
4383 findselectline $l
4384 } else {
4385 bell
4387 return 0
4389 if {!$domore} {
4390 flushhighlights
4391 } else {
4392 set findcurline [expr {$l - 1}]
4394 set n [expr {$findcurline - ($findstartline + 1)}]
4395 if {$n < 0} {
4396 incr n $numcommits
4398 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4399 adjustprogress
4400 return $domore
4403 proc findmorerev {} {
4404 global commitdata commitinfo numcommits findpattern findloc
4405 global findstartline findcurline displayorder
4406 global find_dirn gdttype fhighlights fprogcoord
4408 if {![info exists find_dirn]} {
4409 return 0
4411 set fldtypes {Headline Author Date Committer CDate Comments}
4412 set l $findcurline
4413 if {$l == 0} {
4414 set l $numcommits
4416 incr l -1
4417 if {$l >= $findstartline} {
4418 set lim [expr {$findstartline - 1}]
4419 } else {
4420 set lim -1
4422 if {$l - $lim > 500} {
4423 set lim [expr {$l - 500}]
4425 set found 0
4426 set domore 1
4427 if {$gdttype eq "containing:"} {
4428 for {} {$l > $lim} {incr l -1} {
4429 set id [lindex $displayorder $l]
4430 if {![info exists commitdata($id)]} continue
4431 if {![doesmatch $commitdata($id)]} continue
4432 if {![info exists commitinfo($id)]} {
4433 getcommit $id
4435 set info $commitinfo($id)
4436 foreach f $info ty $fldtypes {
4437 if {($findloc eq "All fields" || $findloc eq $ty) &&
4438 [doesmatch $f]} {
4439 set found 1
4440 break
4443 if {$found} break
4445 } else {
4446 for {} {$l > $lim} {incr l -1} {
4447 set id [lindex $displayorder $l]
4448 if {![info exists fhighlights($l)]} {
4449 askfilehighlight $l $id
4450 if {$domore} {
4451 set domore 0
4452 set findcurline [expr {$l + 1}]
4454 } elseif {$fhighlights($l)} {
4455 set found $domore
4456 break
4460 if {$found || ($domore && $l == $findstartline - 1)} {
4461 unset findcurline
4462 unset find_dirn
4463 notbusy finding
4464 set fprogcoord 0
4465 adjustprogress
4466 if {$found} {
4467 findselectline $l
4468 } else {
4469 bell
4471 return 0
4473 if {!$domore} {
4474 flushhighlights
4475 } else {
4476 set findcurline [expr {$l + 1}]
4478 set n [expr {($findstartline - 1) - $findcurline}]
4479 if {$n < 0} {
4480 incr n $numcommits
4482 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4483 adjustprogress
4484 return $domore
4487 proc findselectline {l} {
4488 global findloc commentend ctext findcurline markingmatches gdttype
4490 set markingmatches 1
4491 set findcurline $l
4492 selectline $l 1
4493 if {$findloc == "All fields" || $findloc == "Comments"} {
4494 # highlight the matches in the comments
4495 set f [$ctext get 1.0 $commentend]
4496 set matches [findmatches $f]
4497 foreach match $matches {
4498 set start [lindex $match 0]
4499 set end [expr {[lindex $match 1] + 1}]
4500 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4503 drawvisible
4506 # mark the bits of a headline or author that match a find string
4507 proc markmatches {canv l str tag matches font row} {
4508 global selectedline
4510 set bbox [$canv bbox $tag]
4511 set x0 [lindex $bbox 0]
4512 set y0 [lindex $bbox 1]
4513 set y1 [lindex $bbox 3]
4514 foreach match $matches {
4515 set start [lindex $match 0]
4516 set end [lindex $match 1]
4517 if {$start > $end} continue
4518 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4519 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4520 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4521 [expr {$x0+$xlen+2}] $y1 \
4522 -outline {} -tags [list match$l matches] -fill yellow]
4523 $canv lower $t
4524 if {[info exists selectedline] && $row == $selectedline} {
4525 $canv raise $t secsel
4530 proc unmarkmatches {} {
4531 global markingmatches
4533 allcanvs delete matches
4534 set markingmatches 0
4535 stopfinding
4538 proc selcanvline {w x y} {
4539 global canv canvy0 ctext linespc
4540 global rowtextx
4541 set ymax [lindex [$canv cget -scrollregion] 3]
4542 if {$ymax == {}} return
4543 set yfrac [lindex [$canv yview] 0]
4544 set y [expr {$y + $yfrac * $ymax}]
4545 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4546 if {$l < 0} {
4547 set l 0
4549 if {$w eq $canv} {
4550 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4552 unmarkmatches
4553 selectline $l 1
4556 proc commit_descriptor {p} {
4557 global commitinfo
4558 if {![info exists commitinfo($p)]} {
4559 getcommit $p
4561 set l "..."
4562 if {[llength $commitinfo($p)] > 1} {
4563 set l [lindex $commitinfo($p) 0]
4565 return "$p ($l)\n"
4568 # append some text to the ctext widget, and make any SHA1 ID
4569 # that we know about be a clickable link.
4570 proc appendwithlinks {text tags} {
4571 global ctext commitrow linknum curview pendinglinks
4573 set start [$ctext index "end - 1c"]
4574 $ctext insert end $text $tags
4575 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4576 foreach l $links {
4577 set s [lindex $l 0]
4578 set e [lindex $l 1]
4579 set linkid [string range $text $s $e]
4580 incr e
4581 $ctext tag delete link$linknum
4582 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4583 setlink $linkid link$linknum
4584 incr linknum
4588 proc setlink {id lk} {
4589 global curview commitrow ctext pendinglinks commitinterest
4591 if {[info exists commitrow($curview,$id)]} {
4592 $ctext tag conf $lk -foreground blue -underline 1
4593 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4594 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4595 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4596 } else {
4597 lappend pendinglinks($id) $lk
4598 lappend commitinterest($id) {makelink %I}
4602 proc makelink {id} {
4603 global pendinglinks
4605 if {![info exists pendinglinks($id)]} return
4606 foreach lk $pendinglinks($id) {
4607 setlink $id $lk
4609 unset pendinglinks($id)
4612 proc linkcursor {w inc} {
4613 global linkentercount curtextcursor
4615 if {[incr linkentercount $inc] > 0} {
4616 $w configure -cursor hand2
4617 } else {
4618 $w configure -cursor $curtextcursor
4619 if {$linkentercount < 0} {
4620 set linkentercount 0
4625 proc viewnextline {dir} {
4626 global canv linespc
4628 $canv delete hover
4629 set ymax [lindex [$canv cget -scrollregion] 3]
4630 set wnow [$canv yview]
4631 set wtop [expr {[lindex $wnow 0] * $ymax}]
4632 set newtop [expr {$wtop + $dir * $linespc}]
4633 if {$newtop < 0} {
4634 set newtop 0
4635 } elseif {$newtop > $ymax} {
4636 set newtop $ymax
4638 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4641 # add a list of tag or branch names at position pos
4642 # returns the number of names inserted
4643 proc appendrefs {pos ids var} {
4644 global ctext commitrow linknum curview $var maxrefs
4646 if {[catch {$ctext index $pos}]} {
4647 return 0
4649 $ctext conf -state normal
4650 $ctext delete $pos "$pos lineend"
4651 set tags {}
4652 foreach id $ids {
4653 foreach tag [set $var\($id\)] {
4654 lappend tags [list $tag $id]
4657 if {[llength $tags] > $maxrefs} {
4658 $ctext insert $pos "many ([llength $tags])"
4659 } else {
4660 set tags [lsort -index 0 -decreasing $tags]
4661 set sep {}
4662 foreach ti $tags {
4663 set id [lindex $ti 1]
4664 set lk link$linknum
4665 incr linknum
4666 $ctext tag delete $lk
4667 $ctext insert $pos $sep
4668 $ctext insert $pos [lindex $ti 0] $lk
4669 setlink $id $lk
4670 set sep ", "
4673 $ctext conf -state disabled
4674 return [llength $tags]
4677 # called when we have finished computing the nearby tags
4678 proc dispneartags {delay} {
4679 global selectedline currentid showneartags tagphase
4681 if {![info exists selectedline] || !$showneartags} return
4682 after cancel dispnexttag
4683 if {$delay} {
4684 after 200 dispnexttag
4685 set tagphase -1
4686 } else {
4687 after idle dispnexttag
4688 set tagphase 0
4692 proc dispnexttag {} {
4693 global selectedline currentid showneartags tagphase ctext
4695 if {![info exists selectedline] || !$showneartags} return
4696 switch -- $tagphase {
4698 set dtags [desctags $currentid]
4699 if {$dtags ne {}} {
4700 appendrefs precedes $dtags idtags
4704 set atags [anctags $currentid]
4705 if {$atags ne {}} {
4706 appendrefs follows $atags idtags
4710 set dheads [descheads $currentid]
4711 if {$dheads ne {}} {
4712 if {[appendrefs branch $dheads idheads] > 1
4713 && [$ctext get "branch -3c"] eq "h"} {
4714 # turn "Branch" into "Branches"
4715 $ctext conf -state normal
4716 $ctext insert "branch -2c" "es"
4717 $ctext conf -state disabled
4722 if {[incr tagphase] <= 2} {
4723 after idle dispnexttag
4727 proc make_secsel {l} {
4728 global linehtag linentag linedtag canv canv2 canv3
4730 if {![info exists linehtag($l)]} return
4731 $canv delete secsel
4732 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4733 -tags secsel -fill [$canv cget -selectbackground]]
4734 $canv lower $t
4735 $canv2 delete secsel
4736 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4737 -tags secsel -fill [$canv2 cget -selectbackground]]
4738 $canv2 lower $t
4739 $canv3 delete secsel
4740 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4741 -tags secsel -fill [$canv3 cget -selectbackground]]
4742 $canv3 lower $t
4745 proc selectline {l isnew} {
4746 global canv ctext commitinfo selectedline
4747 global displayorder
4748 global canvy0 linespc parentlist children curview
4749 global currentid sha1entry
4750 global commentend idtags linknum
4751 global mergemax numcommits pending_select
4752 global cmitmode showneartags allcommits
4754 catch {unset pending_select}
4755 $canv delete hover
4756 normalline
4757 unsel_reflist
4758 stopfinding
4759 if {$l < 0 || $l >= $numcommits} return
4760 set y [expr {$canvy0 + $l * $linespc}]
4761 set ymax [lindex [$canv cget -scrollregion] 3]
4762 set ytop [expr {$y - $linespc - 1}]
4763 set ybot [expr {$y + $linespc + 1}]
4764 set wnow [$canv yview]
4765 set wtop [expr {[lindex $wnow 0] * $ymax}]
4766 set wbot [expr {[lindex $wnow 1] * $ymax}]
4767 set wh [expr {$wbot - $wtop}]
4768 set newtop $wtop
4769 if {$ytop < $wtop} {
4770 if {$ybot < $wtop} {
4771 set newtop [expr {$y - $wh / 2.0}]
4772 } else {
4773 set newtop $ytop
4774 if {$newtop > $wtop - $linespc} {
4775 set newtop [expr {$wtop - $linespc}]
4778 } elseif {$ybot > $wbot} {
4779 if {$ytop > $wbot} {
4780 set newtop [expr {$y - $wh / 2.0}]
4781 } else {
4782 set newtop [expr {$ybot - $wh}]
4783 if {$newtop < $wtop + $linespc} {
4784 set newtop [expr {$wtop + $linespc}]
4788 if {$newtop != $wtop} {
4789 if {$newtop < 0} {
4790 set newtop 0
4792 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4793 drawvisible
4796 make_secsel $l
4798 if {$isnew} {
4799 addtohistory [list selectline $l 0]
4802 set selectedline $l
4804 set id [lindex $displayorder $l]
4805 set currentid $id
4806 $sha1entry delete 0 end
4807 $sha1entry insert 0 $id
4808 $sha1entry selection from 0
4809 $sha1entry selection to end
4810 rhighlight_sel $id
4812 $ctext conf -state normal
4813 clear_ctext
4814 set linknum 0
4815 set info $commitinfo($id)
4816 set date [formatdate [lindex $info 2]]
4817 $ctext insert end "Author: [lindex $info 1] $date\n"
4818 set date [formatdate [lindex $info 4]]
4819 $ctext insert end "Committer: [lindex $info 3] $date\n"
4820 if {[info exists idtags($id)]} {
4821 $ctext insert end "Tags:"
4822 foreach tag $idtags($id) {
4823 $ctext insert end " $tag"
4825 $ctext insert end "\n"
4828 set headers {}
4829 set olds [lindex $parentlist $l]
4830 if {[llength $olds] > 1} {
4831 set np 0
4832 foreach p $olds {
4833 if {$np >= $mergemax} {
4834 set tag mmax
4835 } else {
4836 set tag m$np
4838 $ctext insert end "Parent: " $tag
4839 appendwithlinks [commit_descriptor $p] {}
4840 incr np
4842 } else {
4843 foreach p $olds {
4844 append headers "Parent: [commit_descriptor $p]"
4848 foreach c $children($curview,$id) {
4849 append headers "Child: [commit_descriptor $c]"
4852 # make anything that looks like a SHA1 ID be a clickable link
4853 appendwithlinks $headers {}
4854 if {$showneartags} {
4855 if {![info exists allcommits]} {
4856 getallcommits
4858 $ctext insert end "Branch: "
4859 $ctext mark set branch "end -1c"
4860 $ctext mark gravity branch left
4861 $ctext insert end "\nFollows: "
4862 $ctext mark set follows "end -1c"
4863 $ctext mark gravity follows left
4864 $ctext insert end "\nPrecedes: "
4865 $ctext mark set precedes "end -1c"
4866 $ctext mark gravity precedes left
4867 $ctext insert end "\n"
4868 dispneartags 1
4870 $ctext insert end "\n"
4871 set comment [lindex $info 5]
4872 if {[string first "\r" $comment] >= 0} {
4873 set comment [string map {"\r" "\n "} $comment]
4875 appendwithlinks $comment {comment}
4877 $ctext tag remove found 1.0 end
4878 $ctext conf -state disabled
4879 set commentend [$ctext index "end - 1c"]
4881 init_flist "Comments"
4882 if {$cmitmode eq "tree"} {
4883 gettree $id
4884 } elseif {[llength $olds] <= 1} {
4885 startdiff $id
4886 } else {
4887 mergediff $id $l
4891 proc selfirstline {} {
4892 unmarkmatches
4893 selectline 0 1
4896 proc sellastline {} {
4897 global numcommits
4898 unmarkmatches
4899 set l [expr {$numcommits - 1}]
4900 selectline $l 1
4903 proc selnextline {dir} {
4904 global selectedline
4905 focus .
4906 if {![info exists selectedline]} return
4907 set l [expr {$selectedline + $dir}]
4908 unmarkmatches
4909 selectline $l 1
4912 proc selnextpage {dir} {
4913 global canv linespc selectedline numcommits
4915 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4916 if {$lpp < 1} {
4917 set lpp 1
4919 allcanvs yview scroll [expr {$dir * $lpp}] units
4920 drawvisible
4921 if {![info exists selectedline]} return
4922 set l [expr {$selectedline + $dir * $lpp}]
4923 if {$l < 0} {
4924 set l 0
4925 } elseif {$l >= $numcommits} {
4926 set l [expr $numcommits - 1]
4928 unmarkmatches
4929 selectline $l 1
4932 proc unselectline {} {
4933 global selectedline currentid
4935 catch {unset selectedline}
4936 catch {unset currentid}
4937 allcanvs delete secsel
4938 rhighlight_none
4941 proc reselectline {} {
4942 global selectedline
4944 if {[info exists selectedline]} {
4945 selectline $selectedline 0
4949 proc addtohistory {cmd} {
4950 global history historyindex curview
4952 set elt [list $curview $cmd]
4953 if {$historyindex > 0
4954 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4955 return
4958 if {$historyindex < [llength $history]} {
4959 set history [lreplace $history $historyindex end $elt]
4960 } else {
4961 lappend history $elt
4963 incr historyindex
4964 if {$historyindex > 1} {
4965 .tf.bar.leftbut conf -state normal
4966 } else {
4967 .tf.bar.leftbut conf -state disabled
4969 .tf.bar.rightbut conf -state disabled
4972 proc godo {elt} {
4973 global curview
4975 set view [lindex $elt 0]
4976 set cmd [lindex $elt 1]
4977 if {$curview != $view} {
4978 showview $view
4980 eval $cmd
4983 proc goback {} {
4984 global history historyindex
4985 focus .
4987 if {$historyindex > 1} {
4988 incr historyindex -1
4989 godo [lindex $history [expr {$historyindex - 1}]]
4990 .tf.bar.rightbut conf -state normal
4992 if {$historyindex <= 1} {
4993 .tf.bar.leftbut conf -state disabled
4997 proc goforw {} {
4998 global history historyindex
4999 focus .
5001 if {$historyindex < [llength $history]} {
5002 set cmd [lindex $history $historyindex]
5003 incr historyindex
5004 godo $cmd
5005 .tf.bar.leftbut conf -state normal
5007 if {$historyindex >= [llength $history]} {
5008 .tf.bar.rightbut conf -state disabled
5012 proc gettree {id} {
5013 global treefilelist treeidlist diffids diffmergeid treepending
5014 global nullid nullid2
5016 set diffids $id
5017 catch {unset diffmergeid}
5018 if {![info exists treefilelist($id)]} {
5019 if {![info exists treepending]} {
5020 if {$id eq $nullid} {
5021 set cmd [list | git ls-files]
5022 } elseif {$id eq $nullid2} {
5023 set cmd [list | git ls-files --stage -t]
5024 } else {
5025 set cmd [list | git ls-tree -r $id]
5027 if {[catch {set gtf [open $cmd r]}]} {
5028 return
5030 set treepending $id
5031 set treefilelist($id) {}
5032 set treeidlist($id) {}
5033 fconfigure $gtf -blocking 0
5034 filerun $gtf [list gettreeline $gtf $id]
5036 } else {
5037 setfilelist $id
5041 proc gettreeline {gtf id} {
5042 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5044 set nl 0
5045 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5046 if {$diffids eq $nullid} {
5047 set fname $line
5048 } else {
5049 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5050 set i [string first "\t" $line]
5051 if {$i < 0} continue
5052 set sha1 [lindex $line 2]
5053 set fname [string range $line [expr {$i+1}] end]
5054 if {[string index $fname 0] eq "\""} {
5055 set fname [lindex $fname 0]
5057 lappend treeidlist($id) $sha1
5059 lappend treefilelist($id) $fname
5061 if {![eof $gtf]} {
5062 return [expr {$nl >= 1000? 2: 1}]
5064 close $gtf
5065 unset treepending
5066 if {$cmitmode ne "tree"} {
5067 if {![info exists diffmergeid]} {
5068 gettreediffs $diffids
5070 } elseif {$id ne $diffids} {
5071 gettree $diffids
5072 } else {
5073 setfilelist $id
5075 return 0
5078 proc showfile {f} {
5079 global treefilelist treeidlist diffids nullid nullid2
5080 global ctext commentend
5082 set i [lsearch -exact $treefilelist($diffids) $f]
5083 if {$i < 0} {
5084 puts "oops, $f not in list for id $diffids"
5085 return
5087 if {$diffids eq $nullid} {
5088 if {[catch {set bf [open $f r]} err]} {
5089 puts "oops, can't read $f: $err"
5090 return
5092 } else {
5093 set blob [lindex $treeidlist($diffids) $i]
5094 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5095 puts "oops, error reading blob $blob: $err"
5096 return
5099 fconfigure $bf -blocking 0
5100 filerun $bf [list getblobline $bf $diffids]
5101 $ctext config -state normal
5102 clear_ctext $commentend
5103 $ctext insert end "\n"
5104 $ctext insert end "$f\n" filesep
5105 $ctext config -state disabled
5106 $ctext yview $commentend
5107 settabs 0
5110 proc getblobline {bf id} {
5111 global diffids cmitmode ctext
5113 if {$id ne $diffids || $cmitmode ne "tree"} {
5114 catch {close $bf}
5115 return 0
5117 $ctext config -state normal
5118 set nl 0
5119 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5120 $ctext insert end "$line\n"
5122 if {[eof $bf]} {
5123 # delete last newline
5124 $ctext delete "end - 2c" "end - 1c"
5125 close $bf
5126 return 0
5128 $ctext config -state disabled
5129 return [expr {$nl >= 1000? 2: 1}]
5132 proc mergediff {id l} {
5133 global diffmergeid mdifffd
5134 global diffids
5135 global parentlist
5136 global limitdiffs viewfiles curview
5138 set diffmergeid $id
5139 set diffids $id
5140 # this doesn't seem to actually affect anything...
5141 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5142 if {$limitdiffs && $viewfiles($curview) ne {}} {
5143 set cmd [concat $cmd -- $viewfiles($curview)]
5145 if {[catch {set mdf [open $cmd r]} err]} {
5146 error_popup "Error getting merge diffs: $err"
5147 return
5149 fconfigure $mdf -blocking 0
5150 set mdifffd($id) $mdf
5151 set np [llength [lindex $parentlist $l]]
5152 settabs $np
5153 filerun $mdf [list getmergediffline $mdf $id $np]
5156 proc getmergediffline {mdf id np} {
5157 global diffmergeid ctext cflist mergemax
5158 global difffilestart mdifffd
5160 $ctext conf -state normal
5161 set nr 0
5162 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5163 if {![info exists diffmergeid] || $id != $diffmergeid
5164 || $mdf != $mdifffd($id)} {
5165 close $mdf
5166 return 0
5168 if {[regexp {^diff --cc (.*)} $line match fname]} {
5169 # start of a new file
5170 $ctext insert end "\n"
5171 set here [$ctext index "end - 1c"]
5172 lappend difffilestart $here
5173 add_flist [list $fname]
5174 set l [expr {(78 - [string length $fname]) / 2}]
5175 set pad [string range "----------------------------------------" 1 $l]
5176 $ctext insert end "$pad $fname $pad\n" filesep
5177 } elseif {[regexp {^@@} $line]} {
5178 $ctext insert end "$line\n" hunksep
5179 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5180 # do nothing
5181 } else {
5182 # parse the prefix - one ' ', '-' or '+' for each parent
5183 set spaces {}
5184 set minuses {}
5185 set pluses {}
5186 set isbad 0
5187 for {set j 0} {$j < $np} {incr j} {
5188 set c [string range $line $j $j]
5189 if {$c == " "} {
5190 lappend spaces $j
5191 } elseif {$c == "-"} {
5192 lappend minuses $j
5193 } elseif {$c == "+"} {
5194 lappend pluses $j
5195 } else {
5196 set isbad 1
5197 break
5200 set tags {}
5201 set num {}
5202 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5203 # line doesn't appear in result, parents in $minuses have the line
5204 set num [lindex $minuses 0]
5205 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5206 # line appears in result, parents in $pluses don't have the line
5207 lappend tags mresult
5208 set num [lindex $spaces 0]
5210 if {$num ne {}} {
5211 if {$num >= $mergemax} {
5212 set num "max"
5214 lappend tags m$num
5216 $ctext insert end "$line\n" $tags
5219 $ctext conf -state disabled
5220 if {[eof $mdf]} {
5221 close $mdf
5222 return 0
5224 return [expr {$nr >= 1000? 2: 1}]
5227 proc startdiff {ids} {
5228 global treediffs diffids treepending diffmergeid nullid nullid2
5230 settabs 1
5231 set diffids $ids
5232 catch {unset diffmergeid}
5233 if {![info exists treediffs($ids)] ||
5234 [lsearch -exact $ids $nullid] >= 0 ||
5235 [lsearch -exact $ids $nullid2] >= 0} {
5236 if {![info exists treepending]} {
5237 gettreediffs $ids
5239 } else {
5240 addtocflist $ids
5244 proc path_filter {filter name} {
5245 foreach p $filter {
5246 set l [string length $p]
5247 if {[string compare -length $l $p $name] == 0 &&
5248 ([string length $name] == $l || [string index $name $l] eq "/")} {
5249 return 1
5252 return 0
5255 proc addtocflist {ids} {
5256 global treediffs cflist viewfiles curview limitdiffs
5258 if {$limitdiffs && $viewfiles($curview) ne {}} {
5259 set flist {}
5260 foreach f $treediffs($ids) {
5261 if {[path_filter $viewfiles($curview) $f]} {
5262 lappend flist $f
5265 } else {
5266 set flist $treediffs($ids)
5268 add_flist $flist
5269 getblobdiffs $ids
5272 proc diffcmd {ids flags} {
5273 global nullid nullid2
5275 set i [lsearch -exact $ids $nullid]
5276 set j [lsearch -exact $ids $nullid2]
5277 if {$i >= 0} {
5278 if {[llength $ids] > 1 && $j < 0} {
5279 # comparing working directory with some specific revision
5280 set cmd [concat | git diff-index $flags]
5281 if {$i == 0} {
5282 lappend cmd -R [lindex $ids 1]
5283 } else {
5284 lappend cmd [lindex $ids 0]
5286 } else {
5287 # comparing working directory with index
5288 set cmd [concat | git diff-files $flags]
5289 if {$j == 1} {
5290 lappend cmd -R
5293 } elseif {$j >= 0} {
5294 set cmd [concat | git diff-index --cached $flags]
5295 if {[llength $ids] > 1} {
5296 # comparing index with specific revision
5297 if {$i == 0} {
5298 lappend cmd -R [lindex $ids 1]
5299 } else {
5300 lappend cmd [lindex $ids 0]
5302 } else {
5303 # comparing index with HEAD
5304 lappend cmd HEAD
5306 } else {
5307 set cmd [concat | git diff-tree -r $flags $ids]
5309 return $cmd
5312 proc gettreediffs {ids} {
5313 global treediff treepending
5315 set treepending $ids
5316 set treediff {}
5317 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5318 fconfigure $gdtf -blocking 0
5319 filerun $gdtf [list gettreediffline $gdtf $ids]
5322 proc gettreediffline {gdtf ids} {
5323 global treediff treediffs treepending diffids diffmergeid
5324 global cmitmode
5326 set nr 0
5327 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5328 set i [string first "\t" $line]
5329 if {$i >= 0} {
5330 set file [string range $line [expr {$i+1}] end]
5331 if {[string index $file 0] eq "\""} {
5332 set file [lindex $file 0]
5334 lappend treediff $file
5337 if {![eof $gdtf]} {
5338 return [expr {$nr >= 1000? 2: 1}]
5340 close $gdtf
5341 set treediffs($ids) $treediff
5342 unset treepending
5343 if {$cmitmode eq "tree"} {
5344 gettree $diffids
5345 } elseif {$ids != $diffids} {
5346 if {![info exists diffmergeid]} {
5347 gettreediffs $diffids
5349 } else {
5350 addtocflist $ids
5352 return 0
5355 # empty string or positive integer
5356 proc diffcontextvalidate {v} {
5357 return [regexp {^(|[1-9][0-9]*)$} $v]
5360 proc diffcontextchange {n1 n2 op} {
5361 global diffcontextstring diffcontext
5363 if {[string is integer -strict $diffcontextstring]} {
5364 if {$diffcontextstring > 0} {
5365 set diffcontext $diffcontextstring
5366 reselectline
5371 proc getblobdiffs {ids} {
5372 global blobdifffd diffids env
5373 global diffinhdr treediffs
5374 global diffcontext
5375 global limitdiffs viewfiles curview
5377 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5378 if {$limitdiffs && $viewfiles($curview) ne {}} {
5379 set cmd [concat $cmd -- $viewfiles($curview)]
5381 if {[catch {set bdf [open $cmd r]} err]} {
5382 puts "error getting diffs: $err"
5383 return
5385 set diffinhdr 0
5386 fconfigure $bdf -blocking 0
5387 set blobdifffd($ids) $bdf
5388 filerun $bdf [list getblobdiffline $bdf $diffids]
5391 proc setinlist {var i val} {
5392 global $var
5394 while {[llength [set $var]] < $i} {
5395 lappend $var {}
5397 if {[llength [set $var]] == $i} {
5398 lappend $var $val
5399 } else {
5400 lset $var $i $val
5404 proc makediffhdr {fname ids} {
5405 global ctext curdiffstart treediffs
5407 set i [lsearch -exact $treediffs($ids) $fname]
5408 if {$i >= 0} {
5409 setinlist difffilestart $i $curdiffstart
5411 set l [expr {(78 - [string length $fname]) / 2}]
5412 set pad [string range "----------------------------------------" 1 $l]
5413 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5416 proc getblobdiffline {bdf ids} {
5417 global diffids blobdifffd ctext curdiffstart
5418 global diffnexthead diffnextnote difffilestart
5419 global diffinhdr treediffs
5421 set nr 0
5422 $ctext conf -state normal
5423 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5424 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5425 close $bdf
5426 return 0
5428 if {![string compare -length 11 "diff --git " $line]} {
5429 # trim off "diff --git "
5430 set line [string range $line 11 end]
5431 set diffinhdr 1
5432 # start of a new file
5433 $ctext insert end "\n"
5434 set curdiffstart [$ctext index "end - 1c"]
5435 $ctext insert end "\n" filesep
5436 # If the name hasn't changed the length will be odd,
5437 # the middle char will be a space, and the two bits either
5438 # side will be a/name and b/name, or "a/name" and "b/name".
5439 # If the name has changed we'll get "rename from" and
5440 # "rename to" or "copy from" and "copy to" lines following this,
5441 # and we'll use them to get the filenames.
5442 # This complexity is necessary because spaces in the filename(s)
5443 # don't get escaped.
5444 set l [string length $line]
5445 set i [expr {$l / 2}]
5446 if {!(($l & 1) && [string index $line $i] eq " " &&
5447 [string range $line 2 [expr {$i - 1}]] eq \
5448 [string range $line [expr {$i + 3}] end])} {
5449 continue
5451 # unescape if quoted and chop off the a/ from the front
5452 if {[string index $line 0] eq "\""} {
5453 set fname [string range [lindex $line 0] 2 end]
5454 } else {
5455 set fname [string range $line 2 [expr {$i - 1}]]
5457 makediffhdr $fname $ids
5459 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5460 $line match f1l f1c f2l f2c rest]} {
5461 $ctext insert end "$line\n" hunksep
5462 set diffinhdr 0
5464 } elseif {$diffinhdr} {
5465 if {![string compare -length 12 "rename from " $line]} {
5466 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5467 if {[string index $fname 0] eq "\""} {
5468 set fname [lindex $fname 0]
5470 set i [lsearch -exact $treediffs($ids) $fname]
5471 if {$i >= 0} {
5472 setinlist difffilestart $i $curdiffstart
5474 } elseif {![string compare -length 10 $line "rename to "] ||
5475 ![string compare -length 8 $line "copy to "]} {
5476 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5477 if {[string index $fname 0] eq "\""} {
5478 set fname [lindex $fname 0]
5480 makediffhdr $fname $ids
5481 } elseif {[string compare -length 3 $line "---"] == 0} {
5482 # do nothing
5483 continue
5484 } elseif {[string compare -length 3 $line "+++"] == 0} {
5485 set diffinhdr 0
5486 continue
5488 $ctext insert end "$line\n" filesep
5490 } else {
5491 set x [string range $line 0 0]
5492 if {$x == "-" || $x == "+"} {
5493 set tag [expr {$x == "+"}]
5494 $ctext insert end "$line\n" d$tag
5495 } elseif {$x == " "} {
5496 $ctext insert end "$line\n"
5497 } else {
5498 # "\ No newline at end of file",
5499 # or something else we don't recognize
5500 $ctext insert end "$line\n" hunksep
5504 $ctext conf -state disabled
5505 if {[eof $bdf]} {
5506 close $bdf
5507 return 0
5509 return [expr {$nr >= 1000? 2: 1}]
5512 proc changediffdisp {} {
5513 global ctext diffelide
5515 $ctext tag conf d0 -elide [lindex $diffelide 0]
5516 $ctext tag conf d1 -elide [lindex $diffelide 1]
5519 proc prevfile {} {
5520 global difffilestart ctext
5521 set prev [lindex $difffilestart 0]
5522 set here [$ctext index @0,0]
5523 foreach loc $difffilestart {
5524 if {[$ctext compare $loc >= $here]} {
5525 $ctext yview $prev
5526 return
5528 set prev $loc
5530 $ctext yview $prev
5533 proc nextfile {} {
5534 global difffilestart ctext
5535 set here [$ctext index @0,0]
5536 foreach loc $difffilestart {
5537 if {[$ctext compare $loc > $here]} {
5538 $ctext yview $loc
5539 return
5544 proc clear_ctext {{first 1.0}} {
5545 global ctext smarktop smarkbot
5546 global pendinglinks
5548 set l [lindex [split $first .] 0]
5549 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5550 set smarktop $l
5552 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5553 set smarkbot $l
5555 $ctext delete $first end
5556 if {$first eq "1.0"} {
5557 catch {unset pendinglinks}
5561 proc settabs {{firstab {}}} {
5562 global firsttabstop tabstop ctext have_tk85
5564 if {$firstab ne {} && $have_tk85} {
5565 set firsttabstop $firstab
5567 set w [font measure textfont "0"]
5568 if {$firsttabstop != 0} {
5569 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5570 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5571 } elseif {$have_tk85 || $tabstop != 8} {
5572 $ctext conf -tabs [expr {$tabstop * $w}]
5573 } else {
5574 $ctext conf -tabs {}
5578 proc incrsearch {name ix op} {
5579 global ctext searchstring searchdirn
5581 $ctext tag remove found 1.0 end
5582 if {[catch {$ctext index anchor}]} {
5583 # no anchor set, use start of selection, or of visible area
5584 set sel [$ctext tag ranges sel]
5585 if {$sel ne {}} {
5586 $ctext mark set anchor [lindex $sel 0]
5587 } elseif {$searchdirn eq "-forwards"} {
5588 $ctext mark set anchor @0,0
5589 } else {
5590 $ctext mark set anchor @0,[winfo height $ctext]
5593 if {$searchstring ne {}} {
5594 set here [$ctext search $searchdirn -- $searchstring anchor]
5595 if {$here ne {}} {
5596 $ctext see $here
5598 searchmarkvisible 1
5602 proc dosearch {} {
5603 global sstring ctext searchstring searchdirn
5605 focus $sstring
5606 $sstring icursor end
5607 set searchdirn -forwards
5608 if {$searchstring ne {}} {
5609 set sel [$ctext tag ranges sel]
5610 if {$sel ne {}} {
5611 set start "[lindex $sel 0] + 1c"
5612 } elseif {[catch {set start [$ctext index anchor]}]} {
5613 set start "@0,0"
5615 set match [$ctext search -count mlen -- $searchstring $start]
5616 $ctext tag remove sel 1.0 end
5617 if {$match eq {}} {
5618 bell
5619 return
5621 $ctext see $match
5622 set mend "$match + $mlen c"
5623 $ctext tag add sel $match $mend
5624 $ctext mark unset anchor
5628 proc dosearchback {} {
5629 global sstring ctext searchstring searchdirn
5631 focus $sstring
5632 $sstring icursor end
5633 set searchdirn -backwards
5634 if {$searchstring ne {}} {
5635 set sel [$ctext tag ranges sel]
5636 if {$sel ne {}} {
5637 set start [lindex $sel 0]
5638 } elseif {[catch {set start [$ctext index anchor]}]} {
5639 set start @0,[winfo height $ctext]
5641 set match [$ctext search -backwards -count ml -- $searchstring $start]
5642 $ctext tag remove sel 1.0 end
5643 if {$match eq {}} {
5644 bell
5645 return
5647 $ctext see $match
5648 set mend "$match + $ml c"
5649 $ctext tag add sel $match $mend
5650 $ctext mark unset anchor
5654 proc searchmark {first last} {
5655 global ctext searchstring
5657 set mend $first.0
5658 while {1} {
5659 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5660 if {$match eq {}} break
5661 set mend "$match + $mlen c"
5662 $ctext tag add found $match $mend
5666 proc searchmarkvisible {doall} {
5667 global ctext smarktop smarkbot
5669 set topline [lindex [split [$ctext index @0,0] .] 0]
5670 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5671 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5672 # no overlap with previous
5673 searchmark $topline $botline
5674 set smarktop $topline
5675 set smarkbot $botline
5676 } else {
5677 if {$topline < $smarktop} {
5678 searchmark $topline [expr {$smarktop-1}]
5679 set smarktop $topline
5681 if {$botline > $smarkbot} {
5682 searchmark [expr {$smarkbot+1}] $botline
5683 set smarkbot $botline
5688 proc scrolltext {f0 f1} {
5689 global searchstring
5691 .bleft.sb set $f0 $f1
5692 if {$searchstring ne {}} {
5693 searchmarkvisible 0
5697 proc setcoords {} {
5698 global linespc charspc canvx0 canvy0
5699 global xspc1 xspc2 lthickness
5701 set linespc [font metrics mainfont -linespace]
5702 set charspc [font measure mainfont "m"]
5703 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5704 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5705 set lthickness [expr {int($linespc / 9) + 1}]
5706 set xspc1(0) $linespc
5707 set xspc2 $linespc
5710 proc redisplay {} {
5711 global canv
5712 global selectedline
5714 set ymax [lindex [$canv cget -scrollregion] 3]
5715 if {$ymax eq {} || $ymax == 0} return
5716 set span [$canv yview]
5717 clear_display
5718 setcanvscroll
5719 allcanvs yview moveto [lindex $span 0]
5720 drawvisible
5721 if {[info exists selectedline]} {
5722 selectline $selectedline 0
5723 allcanvs yview moveto [lindex $span 0]
5727 proc parsefont {f n} {
5728 global fontattr
5730 set fontattr($f,family) [lindex $n 0]
5731 set s [lindex $n 1]
5732 if {$s eq {} || $s == 0} {
5733 set s 10
5734 } elseif {$s < 0} {
5735 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5737 set fontattr($f,size) $s
5738 set fontattr($f,weight) normal
5739 set fontattr($f,slant) roman
5740 foreach style [lrange $n 2 end] {
5741 switch -- $style {
5742 "normal" -
5743 "bold" {set fontattr($f,weight) $style}
5744 "roman" -
5745 "italic" {set fontattr($f,slant) $style}
5750 proc fontflags {f {isbold 0}} {
5751 global fontattr
5753 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5754 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5755 -slant $fontattr($f,slant)]
5758 proc fontname {f} {
5759 global fontattr
5761 set n [list $fontattr($f,family) $fontattr($f,size)]
5762 if {$fontattr($f,weight) eq "bold"} {
5763 lappend n "bold"
5765 if {$fontattr($f,slant) eq "italic"} {
5766 lappend n "italic"
5768 return $n
5771 proc incrfont {inc} {
5772 global mainfont textfont ctext canv phase cflist showrefstop
5773 global stopped entries fontattr
5775 unmarkmatches
5776 set s $fontattr(mainfont,size)
5777 incr s $inc
5778 if {$s < 1} {
5779 set s 1
5781 set fontattr(mainfont,size) $s
5782 font config mainfont -size $s
5783 font config mainfontbold -size $s
5784 set mainfont [fontname mainfont]
5785 set s $fontattr(textfont,size)
5786 incr s $inc
5787 if {$s < 1} {
5788 set s 1
5790 set fontattr(textfont,size) $s
5791 font config textfont -size $s
5792 font config textfontbold -size $s
5793 set textfont [fontname textfont]
5794 setcoords
5795 settabs
5796 redisplay
5799 proc clearsha1 {} {
5800 global sha1entry sha1string
5801 if {[string length $sha1string] == 40} {
5802 $sha1entry delete 0 end
5806 proc sha1change {n1 n2 op} {
5807 global sha1string currentid sha1but
5808 if {$sha1string == {}
5809 || ([info exists currentid] && $sha1string == $currentid)} {
5810 set state disabled
5811 } else {
5812 set state normal
5814 if {[$sha1but cget -state] == $state} return
5815 if {$state == "normal"} {
5816 $sha1but conf -state normal -relief raised -text "Goto: "
5817 } else {
5818 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5822 proc gotocommit {} {
5823 global sha1string currentid commitrow tagids headids
5824 global displayorder numcommits curview
5826 if {$sha1string == {}
5827 || ([info exists currentid] && $sha1string == $currentid)} return
5828 if {[info exists tagids($sha1string)]} {
5829 set id $tagids($sha1string)
5830 } elseif {[info exists headids($sha1string)]} {
5831 set id $headids($sha1string)
5832 } else {
5833 set id [string tolower $sha1string]
5834 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5835 set matches {}
5836 foreach i $displayorder {
5837 if {[string match $id* $i]} {
5838 lappend matches $i
5841 if {$matches ne {}} {
5842 if {[llength $matches] > 1} {
5843 error_popup "Short SHA1 id $id is ambiguous"
5844 return
5846 set id [lindex $matches 0]
5850 if {[info exists commitrow($curview,$id)]} {
5851 selectline $commitrow($curview,$id) 1
5852 return
5854 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5855 set type "SHA1 id"
5856 } else {
5857 set type "Tag/Head"
5859 error_popup "$type $sha1string is not known"
5862 proc lineenter {x y id} {
5863 global hoverx hovery hoverid hovertimer
5864 global commitinfo canv
5866 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5867 set hoverx $x
5868 set hovery $y
5869 set hoverid $id
5870 if {[info exists hovertimer]} {
5871 after cancel $hovertimer
5873 set hovertimer [after 500 linehover]
5874 $canv delete hover
5877 proc linemotion {x y id} {
5878 global hoverx hovery hoverid hovertimer
5880 if {[info exists hoverid] && $id == $hoverid} {
5881 set hoverx $x
5882 set hovery $y
5883 if {[info exists hovertimer]} {
5884 after cancel $hovertimer
5886 set hovertimer [after 500 linehover]
5890 proc lineleave {id} {
5891 global hoverid hovertimer canv
5893 if {[info exists hoverid] && $id == $hoverid} {
5894 $canv delete hover
5895 if {[info exists hovertimer]} {
5896 after cancel $hovertimer
5897 unset hovertimer
5899 unset hoverid
5903 proc linehover {} {
5904 global hoverx hovery hoverid hovertimer
5905 global canv linespc lthickness
5906 global commitinfo
5908 set text [lindex $commitinfo($hoverid) 0]
5909 set ymax [lindex [$canv cget -scrollregion] 3]
5910 if {$ymax == {}} return
5911 set yfrac [lindex [$canv yview] 0]
5912 set x [expr {$hoverx + 2 * $linespc}]
5913 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5914 set x0 [expr {$x - 2 * $lthickness}]
5915 set y0 [expr {$y - 2 * $lthickness}]
5916 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5917 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5918 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5919 -fill \#ffff80 -outline black -width 1 -tags hover]
5920 $canv raise $t
5921 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5922 -font mainfont]
5923 $canv raise $t
5926 proc clickisonarrow {id y} {
5927 global lthickness
5929 set ranges [rowranges $id]
5930 set thresh [expr {2 * $lthickness + 6}]
5931 set n [expr {[llength $ranges] - 1}]
5932 for {set i 1} {$i < $n} {incr i} {
5933 set row [lindex $ranges $i]
5934 if {abs([yc $row] - $y) < $thresh} {
5935 return $i
5938 return {}
5941 proc arrowjump {id n y} {
5942 global canv
5944 # 1 <-> 2, 3 <-> 4, etc...
5945 set n [expr {(($n - 1) ^ 1) + 1}]
5946 set row [lindex [rowranges $id] $n]
5947 set yt [yc $row]
5948 set ymax [lindex [$canv cget -scrollregion] 3]
5949 if {$ymax eq {} || $ymax <= 0} return
5950 set view [$canv yview]
5951 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5952 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5953 if {$yfrac < 0} {
5954 set yfrac 0
5956 allcanvs yview moveto $yfrac
5959 proc lineclick {x y id isnew} {
5960 global ctext commitinfo children canv thickerline curview commitrow
5962 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5963 unmarkmatches
5964 unselectline
5965 normalline
5966 $canv delete hover
5967 # draw this line thicker than normal
5968 set thickerline $id
5969 drawlines $id
5970 if {$isnew} {
5971 set ymax [lindex [$canv cget -scrollregion] 3]
5972 if {$ymax eq {}} return
5973 set yfrac [lindex [$canv yview] 0]
5974 set y [expr {$y + $yfrac * $ymax}]
5976 set dirn [clickisonarrow $id $y]
5977 if {$dirn ne {}} {
5978 arrowjump $id $dirn $y
5979 return
5982 if {$isnew} {
5983 addtohistory [list lineclick $x $y $id 0]
5985 # fill the details pane with info about this line
5986 $ctext conf -state normal
5987 clear_ctext
5988 settabs 0
5989 $ctext insert end "Parent:\t"
5990 $ctext insert end $id link0
5991 setlink $id link0
5992 set info $commitinfo($id)
5993 $ctext insert end "\n\t[lindex $info 0]\n"
5994 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5995 set date [formatdate [lindex $info 2]]
5996 $ctext insert end "\tDate:\t$date\n"
5997 set kids $children($curview,$id)
5998 if {$kids ne {}} {
5999 $ctext insert end "\nChildren:"
6000 set i 0
6001 foreach child $kids {
6002 incr i
6003 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6004 set info $commitinfo($child)
6005 $ctext insert end "\n\t"
6006 $ctext insert end $child link$i
6007 setlink $child link$i
6008 $ctext insert end "\n\t[lindex $info 0]"
6009 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
6010 set date [formatdate [lindex $info 2]]
6011 $ctext insert end "\n\tDate:\t$date\n"
6014 $ctext conf -state disabled
6015 init_flist {}
6018 proc normalline {} {
6019 global thickerline
6020 if {[info exists thickerline]} {
6021 set id $thickerline
6022 unset thickerline
6023 drawlines $id
6027 proc selbyid {id} {
6028 global commitrow curview
6029 if {[info exists commitrow($curview,$id)]} {
6030 selectline $commitrow($curview,$id) 1
6034 proc mstime {} {
6035 global startmstime
6036 if {![info exists startmstime]} {
6037 set startmstime [clock clicks -milliseconds]
6039 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6042 proc rowmenu {x y id} {
6043 global rowctxmenu commitrow selectedline rowmenuid curview
6044 global nullid nullid2 fakerowmenu mainhead
6046 stopfinding
6047 set rowmenuid $id
6048 if {![info exists selectedline]
6049 || $commitrow($curview,$id) eq $selectedline} {
6050 set state disabled
6051 } else {
6052 set state normal
6054 if {$id ne $nullid && $id ne $nullid2} {
6055 set menu $rowctxmenu
6056 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
6057 } else {
6058 set menu $fakerowmenu
6060 $menu entryconfigure "Diff this*" -state $state
6061 $menu entryconfigure "Diff selected*" -state $state
6062 $menu entryconfigure "Make patch" -state $state
6063 tk_popup $menu $x $y
6066 proc diffvssel {dirn} {
6067 global rowmenuid selectedline displayorder
6069 if {![info exists selectedline]} return
6070 if {$dirn} {
6071 set oldid [lindex $displayorder $selectedline]
6072 set newid $rowmenuid
6073 } else {
6074 set oldid $rowmenuid
6075 set newid [lindex $displayorder $selectedline]
6077 addtohistory [list doseldiff $oldid $newid]
6078 doseldiff $oldid $newid
6081 proc doseldiff {oldid newid} {
6082 global ctext
6083 global commitinfo
6085 $ctext conf -state normal
6086 clear_ctext
6087 init_flist "Top"
6088 $ctext insert end "From "
6089 $ctext insert end $oldid link0
6090 setlink $oldid link0
6091 $ctext insert end "\n "
6092 $ctext insert end [lindex $commitinfo($oldid) 0]
6093 $ctext insert end "\n\nTo "
6094 $ctext insert end $newid link1
6095 setlink $newid link1
6096 $ctext insert end "\n "
6097 $ctext insert end [lindex $commitinfo($newid) 0]
6098 $ctext insert end "\n"
6099 $ctext conf -state disabled
6100 $ctext tag remove found 1.0 end
6101 startdiff [list $oldid $newid]
6104 proc mkpatch {} {
6105 global rowmenuid currentid commitinfo patchtop patchnum
6107 if {![info exists currentid]} return
6108 set oldid $currentid
6109 set oldhead [lindex $commitinfo($oldid) 0]
6110 set newid $rowmenuid
6111 set newhead [lindex $commitinfo($newid) 0]
6112 set top .patch
6113 set patchtop $top
6114 catch {destroy $top}
6115 toplevel $top
6116 label $top.title -text "Generate patch"
6117 grid $top.title - -pady 10
6118 label $top.from -text "From:"
6119 entry $top.fromsha1 -width 40 -relief flat
6120 $top.fromsha1 insert 0 $oldid
6121 $top.fromsha1 conf -state readonly
6122 grid $top.from $top.fromsha1 -sticky w
6123 entry $top.fromhead -width 60 -relief flat
6124 $top.fromhead insert 0 $oldhead
6125 $top.fromhead conf -state readonly
6126 grid x $top.fromhead -sticky w
6127 label $top.to -text "To:"
6128 entry $top.tosha1 -width 40 -relief flat
6129 $top.tosha1 insert 0 $newid
6130 $top.tosha1 conf -state readonly
6131 grid $top.to $top.tosha1 -sticky w
6132 entry $top.tohead -width 60 -relief flat
6133 $top.tohead insert 0 $newhead
6134 $top.tohead conf -state readonly
6135 grid x $top.tohead -sticky w
6136 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
6137 grid $top.rev x -pady 10
6138 label $top.flab -text "Output file:"
6139 entry $top.fname -width 60
6140 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6141 incr patchnum
6142 grid $top.flab $top.fname -sticky w
6143 frame $top.buts
6144 button $top.buts.gen -text "Generate" -command mkpatchgo
6145 button $top.buts.can -text "Cancel" -command mkpatchcan
6146 grid $top.buts.gen $top.buts.can
6147 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6148 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6149 grid $top.buts - -pady 10 -sticky ew
6150 focus $top.fname
6153 proc mkpatchrev {} {
6154 global patchtop
6156 set oldid [$patchtop.fromsha1 get]
6157 set oldhead [$patchtop.fromhead get]
6158 set newid [$patchtop.tosha1 get]
6159 set newhead [$patchtop.tohead get]
6160 foreach e [list fromsha1 fromhead tosha1 tohead] \
6161 v [list $newid $newhead $oldid $oldhead] {
6162 $patchtop.$e conf -state normal
6163 $patchtop.$e delete 0 end
6164 $patchtop.$e insert 0 $v
6165 $patchtop.$e conf -state readonly
6169 proc mkpatchgo {} {
6170 global patchtop nullid nullid2
6172 set oldid [$patchtop.fromsha1 get]
6173 set newid [$patchtop.tosha1 get]
6174 set fname [$patchtop.fname get]
6175 set cmd [diffcmd [list $oldid $newid] -p]
6176 # trim off the initial "|"
6177 set cmd [lrange $cmd 1 end]
6178 lappend cmd >$fname &
6179 if {[catch {eval exec $cmd} err]} {
6180 error_popup "Error creating patch: $err"
6182 catch {destroy $patchtop}
6183 unset patchtop
6186 proc mkpatchcan {} {
6187 global patchtop
6189 catch {destroy $patchtop}
6190 unset patchtop
6193 proc mktag {} {
6194 global rowmenuid mktagtop commitinfo
6196 set top .maketag
6197 set mktagtop $top
6198 catch {destroy $top}
6199 toplevel $top
6200 label $top.title -text "Create tag"
6201 grid $top.title - -pady 10
6202 label $top.id -text "ID:"
6203 entry $top.sha1 -width 40 -relief flat
6204 $top.sha1 insert 0 $rowmenuid
6205 $top.sha1 conf -state readonly
6206 grid $top.id $top.sha1 -sticky w
6207 entry $top.head -width 60 -relief flat
6208 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6209 $top.head conf -state readonly
6210 grid x $top.head -sticky w
6211 label $top.tlab -text "Tag name:"
6212 entry $top.tag -width 60
6213 grid $top.tlab $top.tag -sticky w
6214 frame $top.buts
6215 button $top.buts.gen -text "Create" -command mktaggo
6216 button $top.buts.can -text "Cancel" -command mktagcan
6217 grid $top.buts.gen $top.buts.can
6218 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6219 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6220 grid $top.buts - -pady 10 -sticky ew
6221 focus $top.tag
6224 proc domktag {} {
6225 global mktagtop env tagids idtags
6227 set id [$mktagtop.sha1 get]
6228 set tag [$mktagtop.tag get]
6229 if {$tag == {}} {
6230 error_popup "No tag name specified"
6231 return
6233 if {[info exists tagids($tag)]} {
6234 error_popup "Tag \"$tag\" already exists"
6235 return
6237 if {[catch {
6238 set dir [gitdir]
6239 set fname [file join $dir "refs/tags" $tag]
6240 set f [open $fname w]
6241 puts $f $id
6242 close $f
6243 } err]} {
6244 error_popup "Error creating tag: $err"
6245 return
6248 set tagids($tag) $id
6249 lappend idtags($id) $tag
6250 redrawtags $id
6251 addedtag $id
6252 dispneartags 0
6253 run refill_reflist
6256 proc redrawtags {id} {
6257 global canv linehtag commitrow idpos selectedline curview
6258 global canvxmax iddrawn
6260 if {![info exists commitrow($curview,$id)]} return
6261 if {![info exists iddrawn($id)]} return
6262 drawcommits $commitrow($curview,$id)
6263 $canv delete tag.$id
6264 set xt [eval drawtags $id $idpos($id)]
6265 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6266 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6267 set xr [expr {$xt + [font measure mainfont $text]}]
6268 if {$xr > $canvxmax} {
6269 set canvxmax $xr
6270 setcanvscroll
6272 if {[info exists selectedline]
6273 && $selectedline == $commitrow($curview,$id)} {
6274 selectline $selectedline 0
6278 proc mktagcan {} {
6279 global mktagtop
6281 catch {destroy $mktagtop}
6282 unset mktagtop
6285 proc mktaggo {} {
6286 domktag
6287 mktagcan
6290 proc writecommit {} {
6291 global rowmenuid wrcomtop commitinfo wrcomcmd
6293 set top .writecommit
6294 set wrcomtop $top
6295 catch {destroy $top}
6296 toplevel $top
6297 label $top.title -text "Write commit to file"
6298 grid $top.title - -pady 10
6299 label $top.id -text "ID:"
6300 entry $top.sha1 -width 40 -relief flat
6301 $top.sha1 insert 0 $rowmenuid
6302 $top.sha1 conf -state readonly
6303 grid $top.id $top.sha1 -sticky w
6304 entry $top.head -width 60 -relief flat
6305 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6306 $top.head conf -state readonly
6307 grid x $top.head -sticky w
6308 label $top.clab -text "Command:"
6309 entry $top.cmd -width 60 -textvariable wrcomcmd
6310 grid $top.clab $top.cmd -sticky w -pady 10
6311 label $top.flab -text "Output file:"
6312 entry $top.fname -width 60
6313 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6314 grid $top.flab $top.fname -sticky w
6315 frame $top.buts
6316 button $top.buts.gen -text "Write" -command wrcomgo
6317 button $top.buts.can -text "Cancel" -command wrcomcan
6318 grid $top.buts.gen $top.buts.can
6319 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6320 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6321 grid $top.buts - -pady 10 -sticky ew
6322 focus $top.fname
6325 proc wrcomgo {} {
6326 global wrcomtop
6328 set id [$wrcomtop.sha1 get]
6329 set cmd "echo $id | [$wrcomtop.cmd get]"
6330 set fname [$wrcomtop.fname get]
6331 if {[catch {exec sh -c $cmd >$fname &} err]} {
6332 error_popup "Error writing commit: $err"
6334 catch {destroy $wrcomtop}
6335 unset wrcomtop
6338 proc wrcomcan {} {
6339 global wrcomtop
6341 catch {destroy $wrcomtop}
6342 unset wrcomtop
6345 proc mkbranch {} {
6346 global rowmenuid mkbrtop
6348 set top .makebranch
6349 catch {destroy $top}
6350 toplevel $top
6351 label $top.title -text "Create new branch"
6352 grid $top.title - -pady 10
6353 label $top.id -text "ID:"
6354 entry $top.sha1 -width 40 -relief flat
6355 $top.sha1 insert 0 $rowmenuid
6356 $top.sha1 conf -state readonly
6357 grid $top.id $top.sha1 -sticky w
6358 label $top.nlab -text "Name:"
6359 entry $top.name -width 40
6360 grid $top.nlab $top.name -sticky w
6361 frame $top.buts
6362 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6363 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6364 grid $top.buts.go $top.buts.can
6365 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6366 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6367 grid $top.buts - -pady 10 -sticky ew
6368 focus $top.name
6371 proc mkbrgo {top} {
6372 global headids idheads
6374 set name [$top.name get]
6375 set id [$top.sha1 get]
6376 if {$name eq {}} {
6377 error_popup "Please specify a name for the new branch"
6378 return
6380 catch {destroy $top}
6381 nowbusy newbranch
6382 update
6383 if {[catch {
6384 exec git branch $name $id
6385 } err]} {
6386 notbusy newbranch
6387 error_popup $err
6388 } else {
6389 set headids($name) $id
6390 lappend idheads($id) $name
6391 addedhead $id $name
6392 notbusy newbranch
6393 redrawtags $id
6394 dispneartags 0
6395 run refill_reflist
6399 proc cherrypick {} {
6400 global rowmenuid curview commitrow
6401 global mainhead
6403 set oldhead [exec git rev-parse HEAD]
6404 set dheads [descheads $rowmenuid]
6405 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6406 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6407 included in branch $mainhead -- really re-apply it?"]
6408 if {!$ok} return
6410 nowbusy cherrypick "Cherry-picking"
6411 update
6412 # Unfortunately git-cherry-pick writes stuff to stderr even when
6413 # no error occurs, and exec takes that as an indication of error...
6414 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6415 notbusy cherrypick
6416 error_popup $err
6417 return
6419 set newhead [exec git rev-parse HEAD]
6420 if {$newhead eq $oldhead} {
6421 notbusy cherrypick
6422 error_popup "No changes committed"
6423 return
6425 addnewchild $newhead $oldhead
6426 if {[info exists commitrow($curview,$oldhead)]} {
6427 insertrow $commitrow($curview,$oldhead) $newhead
6428 if {$mainhead ne {}} {
6429 movehead $newhead $mainhead
6430 movedhead $newhead $mainhead
6432 redrawtags $oldhead
6433 redrawtags $newhead
6435 notbusy cherrypick
6438 proc resethead {} {
6439 global mainheadid mainhead rowmenuid confirm_ok resettype
6441 set confirm_ok 0
6442 set w ".confirmreset"
6443 toplevel $w
6444 wm transient $w .
6445 wm title $w "Confirm reset"
6446 message $w.m -text \
6447 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6448 -justify center -aspect 1000
6449 pack $w.m -side top -fill x -padx 20 -pady 20
6450 frame $w.f -relief sunken -border 2
6451 message $w.f.rt -text "Reset type:" -aspect 1000
6452 grid $w.f.rt -sticky w
6453 set resettype mixed
6454 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6455 -text "Soft: Leave working tree and index untouched"
6456 grid $w.f.soft -sticky w
6457 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6458 -text "Mixed: Leave working tree untouched, reset index"
6459 grid $w.f.mixed -sticky w
6460 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6461 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6462 grid $w.f.hard -sticky w
6463 pack $w.f -side top -fill x
6464 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6465 pack $w.ok -side left -fill x -padx 20 -pady 20
6466 button $w.cancel -text Cancel -command "destroy $w"
6467 pack $w.cancel -side right -fill x -padx 20 -pady 20
6468 bind $w <Visibility> "grab $w; focus $w"
6469 tkwait window $w
6470 if {!$confirm_ok} return
6471 if {[catch {set fd [open \
6472 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6473 error_popup $err
6474 } else {
6475 dohidelocalchanges
6476 filerun $fd [list readresetstat $fd]
6477 nowbusy reset "Resetting"
6481 proc readresetstat {fd} {
6482 global mainhead mainheadid showlocalchanges rprogcoord
6484 if {[gets $fd line] >= 0} {
6485 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6486 set rprogcoord [expr {1.0 * $m / $n}]
6487 adjustprogress
6489 return 1
6491 set rprogcoord 0
6492 adjustprogress
6493 notbusy reset
6494 if {[catch {close $fd} err]} {
6495 error_popup $err
6497 set oldhead $mainheadid
6498 set newhead [exec git rev-parse HEAD]
6499 if {$newhead ne $oldhead} {
6500 movehead $newhead $mainhead
6501 movedhead $newhead $mainhead
6502 set mainheadid $newhead
6503 redrawtags $oldhead
6504 redrawtags $newhead
6506 if {$showlocalchanges} {
6507 doshowlocalchanges
6509 return 0
6512 # context menu for a head
6513 proc headmenu {x y id head} {
6514 global headmenuid headmenuhead headctxmenu mainhead
6516 stopfinding
6517 set headmenuid $id
6518 set headmenuhead $head
6519 set state normal
6520 if {$head eq $mainhead} {
6521 set state disabled
6523 $headctxmenu entryconfigure 0 -state $state
6524 $headctxmenu entryconfigure 1 -state $state
6525 tk_popup $headctxmenu $x $y
6528 proc cobranch {} {
6529 global headmenuid headmenuhead mainhead headids
6530 global showlocalchanges mainheadid
6532 # check the tree is clean first??
6533 set oldmainhead $mainhead
6534 nowbusy checkout "Checking out"
6535 update
6536 dohidelocalchanges
6537 if {[catch {
6538 exec git checkout -q $headmenuhead
6539 } err]} {
6540 notbusy checkout
6541 error_popup $err
6542 } else {
6543 notbusy checkout
6544 set mainhead $headmenuhead
6545 set mainheadid $headmenuid
6546 if {[info exists headids($oldmainhead)]} {
6547 redrawtags $headids($oldmainhead)
6549 redrawtags $headmenuid
6551 if {$showlocalchanges} {
6552 dodiffindex
6556 proc rmbranch {} {
6557 global headmenuid headmenuhead mainhead
6558 global idheads
6560 set head $headmenuhead
6561 set id $headmenuid
6562 # this check shouldn't be needed any more...
6563 if {$head eq $mainhead} {
6564 error_popup "Cannot delete the currently checked-out branch"
6565 return
6567 set dheads [descheads $id]
6568 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6569 # the stuff on this branch isn't on any other branch
6570 if {![confirm_popup "The commits on branch $head aren't on any other\
6571 branch.\nReally delete branch $head?"]} return
6573 nowbusy rmbranch
6574 update
6575 if {[catch {exec git branch -D $head} err]} {
6576 notbusy rmbranch
6577 error_popup $err
6578 return
6580 removehead $id $head
6581 removedhead $id $head
6582 redrawtags $id
6583 notbusy rmbranch
6584 dispneartags 0
6585 run refill_reflist
6588 # Display a list of tags and heads
6589 proc showrefs {} {
6590 global showrefstop bgcolor fgcolor selectbgcolor
6591 global bglist fglist reflistfilter reflist maincursor
6593 set top .showrefs
6594 set showrefstop $top
6595 if {[winfo exists $top]} {
6596 raise $top
6597 refill_reflist
6598 return
6600 toplevel $top
6601 wm title $top "Tags and heads: [file tail [pwd]]"
6602 text $top.list -background $bgcolor -foreground $fgcolor \
6603 -selectbackground $selectbgcolor -font mainfont \
6604 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6605 -width 30 -height 20 -cursor $maincursor \
6606 -spacing1 1 -spacing3 1 -state disabled
6607 $top.list tag configure highlight -background $selectbgcolor
6608 lappend bglist $top.list
6609 lappend fglist $top.list
6610 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6611 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6612 grid $top.list $top.ysb -sticky nsew
6613 grid $top.xsb x -sticky ew
6614 frame $top.f
6615 label $top.f.l -text "Filter: " -font uifont
6616 entry $top.f.e -width 20 -textvariable reflistfilter -font uifont
6617 set reflistfilter "*"
6618 trace add variable reflistfilter write reflistfilter_change
6619 pack $top.f.e -side right -fill x -expand 1
6620 pack $top.f.l -side left
6621 grid $top.f - -sticky ew -pady 2
6622 button $top.close -command [list destroy $top] -text "Close" \
6623 -font uifont
6624 grid $top.close -
6625 grid columnconfigure $top 0 -weight 1
6626 grid rowconfigure $top 0 -weight 1
6627 bind $top.list <1> {break}
6628 bind $top.list <B1-Motion> {break}
6629 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6630 set reflist {}
6631 refill_reflist
6634 proc sel_reflist {w x y} {
6635 global showrefstop reflist headids tagids otherrefids
6637 if {![winfo exists $showrefstop]} return
6638 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6639 set ref [lindex $reflist [expr {$l-1}]]
6640 set n [lindex $ref 0]
6641 switch -- [lindex $ref 1] {
6642 "H" {selbyid $headids($n)}
6643 "T" {selbyid $tagids($n)}
6644 "o" {selbyid $otherrefids($n)}
6646 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6649 proc unsel_reflist {} {
6650 global showrefstop
6652 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6653 $showrefstop.list tag remove highlight 0.0 end
6656 proc reflistfilter_change {n1 n2 op} {
6657 global reflistfilter
6659 after cancel refill_reflist
6660 after 200 refill_reflist
6663 proc refill_reflist {} {
6664 global reflist reflistfilter showrefstop headids tagids otherrefids
6665 global commitrow curview commitinterest
6667 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6668 set refs {}
6669 foreach n [array names headids] {
6670 if {[string match $reflistfilter $n]} {
6671 if {[info exists commitrow($curview,$headids($n))]} {
6672 lappend refs [list $n H]
6673 } else {
6674 set commitinterest($headids($n)) {run refill_reflist}
6678 foreach n [array names tagids] {
6679 if {[string match $reflistfilter $n]} {
6680 if {[info exists commitrow($curview,$tagids($n))]} {
6681 lappend refs [list $n T]
6682 } else {
6683 set commitinterest($tagids($n)) {run refill_reflist}
6687 foreach n [array names otherrefids] {
6688 if {[string match $reflistfilter $n]} {
6689 if {[info exists commitrow($curview,$otherrefids($n))]} {
6690 lappend refs [list $n o]
6691 } else {
6692 set commitinterest($otherrefids($n)) {run refill_reflist}
6696 set refs [lsort -index 0 $refs]
6697 if {$refs eq $reflist} return
6699 # Update the contents of $showrefstop.list according to the
6700 # differences between $reflist (old) and $refs (new)
6701 $showrefstop.list conf -state normal
6702 $showrefstop.list insert end "\n"
6703 set i 0
6704 set j 0
6705 while {$i < [llength $reflist] || $j < [llength $refs]} {
6706 if {$i < [llength $reflist]} {
6707 if {$j < [llength $refs]} {
6708 set cmp [string compare [lindex $reflist $i 0] \
6709 [lindex $refs $j 0]]
6710 if {$cmp == 0} {
6711 set cmp [string compare [lindex $reflist $i 1] \
6712 [lindex $refs $j 1]]
6714 } else {
6715 set cmp -1
6717 } else {
6718 set cmp 1
6720 switch -- $cmp {
6721 -1 {
6722 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6723 incr i
6726 incr i
6727 incr j
6730 set l [expr {$j + 1}]
6731 $showrefstop.list image create $l.0 -align baseline \
6732 -image reficon-[lindex $refs $j 1] -padx 2
6733 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6734 incr j
6738 set reflist $refs
6739 # delete last newline
6740 $showrefstop.list delete end-2c end-1c
6741 $showrefstop.list conf -state disabled
6744 # Stuff for finding nearby tags
6745 proc getallcommits {} {
6746 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6747 global idheads idtags idotherrefs allparents tagobjid
6749 if {![info exists allcommits]} {
6750 set nextarc 0
6751 set allcommits 0
6752 set seeds {}
6753 set allcwait 0
6754 set cachedarcs 0
6755 set allccache [file join [gitdir] "gitk.cache"]
6756 if {![catch {
6757 set f [open $allccache r]
6758 set allcwait 1
6759 getcache $f
6760 }]} return
6763 if {$allcwait} {
6764 return
6766 set cmd [list | git rev-list --parents]
6767 set allcupdate [expr {$seeds ne {}}]
6768 if {!$allcupdate} {
6769 set ids "--all"
6770 } else {
6771 set refs [concat [array names idheads] [array names idtags] \
6772 [array names idotherrefs]]
6773 set ids {}
6774 set tagobjs {}
6775 foreach name [array names tagobjid] {
6776 lappend tagobjs $tagobjid($name)
6778 foreach id [lsort -unique $refs] {
6779 if {![info exists allparents($id)] &&
6780 [lsearch -exact $tagobjs $id] < 0} {
6781 lappend ids $id
6784 if {$ids ne {}} {
6785 foreach id $seeds {
6786 lappend ids "^$id"
6790 if {$ids ne {}} {
6791 set fd [open [concat $cmd $ids] r]
6792 fconfigure $fd -blocking 0
6793 incr allcommits
6794 nowbusy allcommits
6795 filerun $fd [list getallclines $fd]
6796 } else {
6797 dispneartags 0
6801 # Since most commits have 1 parent and 1 child, we group strings of
6802 # such commits into "arcs" joining branch/merge points (BMPs), which
6803 # are commits that either don't have 1 parent or don't have 1 child.
6805 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6806 # arcout(id) - outgoing arcs for BMP
6807 # arcids(a) - list of IDs on arc including end but not start
6808 # arcstart(a) - BMP ID at start of arc
6809 # arcend(a) - BMP ID at end of arc
6810 # growing(a) - arc a is still growing
6811 # arctags(a) - IDs out of arcids (excluding end) that have tags
6812 # archeads(a) - IDs out of arcids (excluding end) that have heads
6813 # The start of an arc is at the descendent end, so "incoming" means
6814 # coming from descendents, and "outgoing" means going towards ancestors.
6816 proc getallclines {fd} {
6817 global allparents allchildren idtags idheads nextarc
6818 global arcnos arcids arctags arcout arcend arcstart archeads growing
6819 global seeds allcommits cachedarcs allcupdate
6821 set nid 0
6822 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6823 set id [lindex $line 0]
6824 if {[info exists allparents($id)]} {
6825 # seen it already
6826 continue
6828 set cachedarcs 0
6829 set olds [lrange $line 1 end]
6830 set allparents($id) $olds
6831 if {![info exists allchildren($id)]} {
6832 set allchildren($id) {}
6833 set arcnos($id) {}
6834 lappend seeds $id
6835 } else {
6836 set a $arcnos($id)
6837 if {[llength $olds] == 1 && [llength $a] == 1} {
6838 lappend arcids($a) $id
6839 if {[info exists idtags($id)]} {
6840 lappend arctags($a) $id
6842 if {[info exists idheads($id)]} {
6843 lappend archeads($a) $id
6845 if {[info exists allparents($olds)]} {
6846 # seen parent already
6847 if {![info exists arcout($olds)]} {
6848 splitarc $olds
6850 lappend arcids($a) $olds
6851 set arcend($a) $olds
6852 unset growing($a)
6854 lappend allchildren($olds) $id
6855 lappend arcnos($olds) $a
6856 continue
6859 foreach a $arcnos($id) {
6860 lappend arcids($a) $id
6861 set arcend($a) $id
6862 unset growing($a)
6865 set ao {}
6866 foreach p $olds {
6867 lappend allchildren($p) $id
6868 set a [incr nextarc]
6869 set arcstart($a) $id
6870 set archeads($a) {}
6871 set arctags($a) {}
6872 set archeads($a) {}
6873 set arcids($a) {}
6874 lappend ao $a
6875 set growing($a) 1
6876 if {[info exists allparents($p)]} {
6877 # seen it already, may need to make a new branch
6878 if {![info exists arcout($p)]} {
6879 splitarc $p
6881 lappend arcids($a) $p
6882 set arcend($a) $p
6883 unset growing($a)
6885 lappend arcnos($p) $a
6887 set arcout($id) $ao
6889 if {$nid > 0} {
6890 global cached_dheads cached_dtags cached_atags
6891 catch {unset cached_dheads}
6892 catch {unset cached_dtags}
6893 catch {unset cached_atags}
6895 if {![eof $fd]} {
6896 return [expr {$nid >= 1000? 2: 1}]
6898 set cacheok 1
6899 if {[catch {
6900 fconfigure $fd -blocking 1
6901 close $fd
6902 } err]} {
6903 # got an error reading the list of commits
6904 # if we were updating, try rereading the whole thing again
6905 if {$allcupdate} {
6906 incr allcommits -1
6907 dropcache $err
6908 return
6910 error_popup "Error reading commit topology information;\
6911 branch and preceding/following tag information\
6912 will be incomplete.\n($err)"
6913 set cacheok 0
6915 if {[incr allcommits -1] == 0} {
6916 notbusy allcommits
6917 if {$cacheok} {
6918 run savecache
6921 dispneartags 0
6922 return 0
6925 proc recalcarc {a} {
6926 global arctags archeads arcids idtags idheads
6928 set at {}
6929 set ah {}
6930 foreach id [lrange $arcids($a) 0 end-1] {
6931 if {[info exists idtags($id)]} {
6932 lappend at $id
6934 if {[info exists idheads($id)]} {
6935 lappend ah $id
6938 set arctags($a) $at
6939 set archeads($a) $ah
6942 proc splitarc {p} {
6943 global arcnos arcids nextarc arctags archeads idtags idheads
6944 global arcstart arcend arcout allparents growing
6946 set a $arcnos($p)
6947 if {[llength $a] != 1} {
6948 puts "oops splitarc called but [llength $a] arcs already"
6949 return
6951 set a [lindex $a 0]
6952 set i [lsearch -exact $arcids($a) $p]
6953 if {$i < 0} {
6954 puts "oops splitarc $p not in arc $a"
6955 return
6957 set na [incr nextarc]
6958 if {[info exists arcend($a)]} {
6959 set arcend($na) $arcend($a)
6960 } else {
6961 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6962 set j [lsearch -exact $arcnos($l) $a]
6963 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6965 set tail [lrange $arcids($a) [expr {$i+1}] end]
6966 set arcids($a) [lrange $arcids($a) 0 $i]
6967 set arcend($a) $p
6968 set arcstart($na) $p
6969 set arcout($p) $na
6970 set arcids($na) $tail
6971 if {[info exists growing($a)]} {
6972 set growing($na) 1
6973 unset growing($a)
6976 foreach id $tail {
6977 if {[llength $arcnos($id)] == 1} {
6978 set arcnos($id) $na
6979 } else {
6980 set j [lsearch -exact $arcnos($id) $a]
6981 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6985 # reconstruct tags and heads lists
6986 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6987 recalcarc $a
6988 recalcarc $na
6989 } else {
6990 set arctags($na) {}
6991 set archeads($na) {}
6995 # Update things for a new commit added that is a child of one
6996 # existing commit. Used when cherry-picking.
6997 proc addnewchild {id p} {
6998 global allparents allchildren idtags nextarc
6999 global arcnos arcids arctags arcout arcend arcstart archeads growing
7000 global seeds allcommits
7002 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7003 set allparents($id) [list $p]
7004 set allchildren($id) {}
7005 set arcnos($id) {}
7006 lappend seeds $id
7007 lappend allchildren($p) $id
7008 set a [incr nextarc]
7009 set arcstart($a) $id
7010 set archeads($a) {}
7011 set arctags($a) {}
7012 set arcids($a) [list $p]
7013 set arcend($a) $p
7014 if {![info exists arcout($p)]} {
7015 splitarc $p
7017 lappend arcnos($p) $a
7018 set arcout($id) [list $a]
7021 # This implements a cache for the topology information.
7022 # The cache saves, for each arc, the start and end of the arc,
7023 # the ids on the arc, and the outgoing arcs from the end.
7024 proc readcache {f} {
7025 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7026 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7027 global allcwait
7029 set a $nextarc
7030 set lim $cachedarcs
7031 if {$lim - $a > 500} {
7032 set lim [expr {$a + 500}]
7034 if {[catch {
7035 if {$a == $lim} {
7036 # finish reading the cache and setting up arctags, etc.
7037 set line [gets $f]
7038 if {$line ne "1"} {error "bad final version"}
7039 close $f
7040 foreach id [array names idtags] {
7041 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7042 [llength $allparents($id)] == 1} {
7043 set a [lindex $arcnos($id) 0]
7044 if {$arctags($a) eq {}} {
7045 recalcarc $a
7049 foreach id [array names idheads] {
7050 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7051 [llength $allparents($id)] == 1} {
7052 set a [lindex $arcnos($id) 0]
7053 if {$archeads($a) eq {}} {
7054 recalcarc $a
7058 foreach id [lsort -unique $possible_seeds] {
7059 if {$arcnos($id) eq {}} {
7060 lappend seeds $id
7063 set allcwait 0
7064 } else {
7065 while {[incr a] <= $lim} {
7066 set line [gets $f]
7067 if {[llength $line] != 3} {error "bad line"}
7068 set s [lindex $line 0]
7069 set arcstart($a) $s
7070 lappend arcout($s) $a
7071 if {![info exists arcnos($s)]} {
7072 lappend possible_seeds $s
7073 set arcnos($s) {}
7075 set e [lindex $line 1]
7076 if {$e eq {}} {
7077 set growing($a) 1
7078 } else {
7079 set arcend($a) $e
7080 if {![info exists arcout($e)]} {
7081 set arcout($e) {}
7084 set arcids($a) [lindex $line 2]
7085 foreach id $arcids($a) {
7086 lappend allparents($s) $id
7087 set s $id
7088 lappend arcnos($id) $a
7090 if {![info exists allparents($s)]} {
7091 set allparents($s) {}
7093 set arctags($a) {}
7094 set archeads($a) {}
7096 set nextarc [expr {$a - 1}]
7098 } err]} {
7099 dropcache $err
7100 return 0
7102 if {!$allcwait} {
7103 getallcommits
7105 return $allcwait
7108 proc getcache {f} {
7109 global nextarc cachedarcs possible_seeds
7111 if {[catch {
7112 set line [gets $f]
7113 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7114 # make sure it's an integer
7115 set cachedarcs [expr {int([lindex $line 1])}]
7116 if {$cachedarcs < 0} {error "bad number of arcs"}
7117 set nextarc 0
7118 set possible_seeds {}
7119 run readcache $f
7120 } err]} {
7121 dropcache $err
7123 return 0
7126 proc dropcache {err} {
7127 global allcwait nextarc cachedarcs seeds
7129 #puts "dropping cache ($err)"
7130 foreach v {arcnos arcout arcids arcstart arcend growing \
7131 arctags archeads allparents allchildren} {
7132 global $v
7133 catch {unset $v}
7135 set allcwait 0
7136 set nextarc 0
7137 set cachedarcs 0
7138 set seeds {}
7139 getallcommits
7142 proc writecache {f} {
7143 global cachearc cachedarcs allccache
7144 global arcstart arcend arcnos arcids arcout
7146 set a $cachearc
7147 set lim $cachedarcs
7148 if {$lim - $a > 1000} {
7149 set lim [expr {$a + 1000}]
7151 if {[catch {
7152 while {[incr a] <= $lim} {
7153 if {[info exists arcend($a)]} {
7154 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7155 } else {
7156 puts $f [list $arcstart($a) {} $arcids($a)]
7159 } err]} {
7160 catch {close $f}
7161 catch {file delete $allccache}
7162 #puts "writing cache failed ($err)"
7163 return 0
7165 set cachearc [expr {$a - 1}]
7166 if {$a > $cachedarcs} {
7167 puts $f "1"
7168 close $f
7169 return 0
7171 return 1
7174 proc savecache {} {
7175 global nextarc cachedarcs cachearc allccache
7177 if {$nextarc == $cachedarcs} return
7178 set cachearc 0
7179 set cachedarcs $nextarc
7180 catch {
7181 set f [open $allccache w]
7182 puts $f [list 1 $cachedarcs]
7183 run writecache $f
7187 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7188 # or 0 if neither is true.
7189 proc anc_or_desc {a b} {
7190 global arcout arcstart arcend arcnos cached_isanc
7192 if {$arcnos($a) eq $arcnos($b)} {
7193 # Both are on the same arc(s); either both are the same BMP,
7194 # or if one is not a BMP, the other is also not a BMP or is
7195 # the BMP at end of the arc (and it only has 1 incoming arc).
7196 # Or both can be BMPs with no incoming arcs.
7197 if {$a eq $b || $arcnos($a) eq {}} {
7198 return 0
7200 # assert {[llength $arcnos($a)] == 1}
7201 set arc [lindex $arcnos($a) 0]
7202 set i [lsearch -exact $arcids($arc) $a]
7203 set j [lsearch -exact $arcids($arc) $b]
7204 if {$i < 0 || $i > $j} {
7205 return 1
7206 } else {
7207 return -1
7211 if {![info exists arcout($a)]} {
7212 set arc [lindex $arcnos($a) 0]
7213 if {[info exists arcend($arc)]} {
7214 set aend $arcend($arc)
7215 } else {
7216 set aend {}
7218 set a $arcstart($arc)
7219 } else {
7220 set aend $a
7222 if {![info exists arcout($b)]} {
7223 set arc [lindex $arcnos($b) 0]
7224 if {[info exists arcend($arc)]} {
7225 set bend $arcend($arc)
7226 } else {
7227 set bend {}
7229 set b $arcstart($arc)
7230 } else {
7231 set bend $b
7233 if {$a eq $bend} {
7234 return 1
7236 if {$b eq $aend} {
7237 return -1
7239 if {[info exists cached_isanc($a,$bend)]} {
7240 if {$cached_isanc($a,$bend)} {
7241 return 1
7244 if {[info exists cached_isanc($b,$aend)]} {
7245 if {$cached_isanc($b,$aend)} {
7246 return -1
7248 if {[info exists cached_isanc($a,$bend)]} {
7249 return 0
7253 set todo [list $a $b]
7254 set anc($a) a
7255 set anc($b) b
7256 for {set i 0} {$i < [llength $todo]} {incr i} {
7257 set x [lindex $todo $i]
7258 if {$anc($x) eq {}} {
7259 continue
7261 foreach arc $arcnos($x) {
7262 set xd $arcstart($arc)
7263 if {$xd eq $bend} {
7264 set cached_isanc($a,$bend) 1
7265 set cached_isanc($b,$aend) 0
7266 return 1
7267 } elseif {$xd eq $aend} {
7268 set cached_isanc($b,$aend) 1
7269 set cached_isanc($a,$bend) 0
7270 return -1
7272 if {![info exists anc($xd)]} {
7273 set anc($xd) $anc($x)
7274 lappend todo $xd
7275 } elseif {$anc($xd) ne $anc($x)} {
7276 set anc($xd) {}
7280 set cached_isanc($a,$bend) 0
7281 set cached_isanc($b,$aend) 0
7282 return 0
7285 # This identifies whether $desc has an ancestor that is
7286 # a growing tip of the graph and which is not an ancestor of $anc
7287 # and returns 0 if so and 1 if not.
7288 # If we subsequently discover a tag on such a growing tip, and that
7289 # turns out to be a descendent of $anc (which it could, since we
7290 # don't necessarily see children before parents), then $desc
7291 # isn't a good choice to display as a descendent tag of
7292 # $anc (since it is the descendent of another tag which is
7293 # a descendent of $anc). Similarly, $anc isn't a good choice to
7294 # display as a ancestor tag of $desc.
7296 proc is_certain {desc anc} {
7297 global arcnos arcout arcstart arcend growing problems
7299 set certain {}
7300 if {[llength $arcnos($anc)] == 1} {
7301 # tags on the same arc are certain
7302 if {$arcnos($desc) eq $arcnos($anc)} {
7303 return 1
7305 if {![info exists arcout($anc)]} {
7306 # if $anc is partway along an arc, use the start of the arc instead
7307 set a [lindex $arcnos($anc) 0]
7308 set anc $arcstart($a)
7311 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7312 set x $desc
7313 } else {
7314 set a [lindex $arcnos($desc) 0]
7315 set x $arcend($a)
7317 if {$x == $anc} {
7318 return 1
7320 set anclist [list $x]
7321 set dl($x) 1
7322 set nnh 1
7323 set ngrowanc 0
7324 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7325 set x [lindex $anclist $i]
7326 if {$dl($x)} {
7327 incr nnh -1
7329 set done($x) 1
7330 foreach a $arcout($x) {
7331 if {[info exists growing($a)]} {
7332 if {![info exists growanc($x)] && $dl($x)} {
7333 set growanc($x) 1
7334 incr ngrowanc
7336 } else {
7337 set y $arcend($a)
7338 if {[info exists dl($y)]} {
7339 if {$dl($y)} {
7340 if {!$dl($x)} {
7341 set dl($y) 0
7342 if {![info exists done($y)]} {
7343 incr nnh -1
7345 if {[info exists growanc($x)]} {
7346 incr ngrowanc -1
7348 set xl [list $y]
7349 for {set k 0} {$k < [llength $xl]} {incr k} {
7350 set z [lindex $xl $k]
7351 foreach c $arcout($z) {
7352 if {[info exists arcend($c)]} {
7353 set v $arcend($c)
7354 if {[info exists dl($v)] && $dl($v)} {
7355 set dl($v) 0
7356 if {![info exists done($v)]} {
7357 incr nnh -1
7359 if {[info exists growanc($v)]} {
7360 incr ngrowanc -1
7362 lappend xl $v
7369 } elseif {$y eq $anc || !$dl($x)} {
7370 set dl($y) 0
7371 lappend anclist $y
7372 } else {
7373 set dl($y) 1
7374 lappend anclist $y
7375 incr nnh
7380 foreach x [array names growanc] {
7381 if {$dl($x)} {
7382 return 0
7384 return 0
7386 return 1
7389 proc validate_arctags {a} {
7390 global arctags idtags
7392 set i -1
7393 set na $arctags($a)
7394 foreach id $arctags($a) {
7395 incr i
7396 if {![info exists idtags($id)]} {
7397 set na [lreplace $na $i $i]
7398 incr i -1
7401 set arctags($a) $na
7404 proc validate_archeads {a} {
7405 global archeads idheads
7407 set i -1
7408 set na $archeads($a)
7409 foreach id $archeads($a) {
7410 incr i
7411 if {![info exists idheads($id)]} {
7412 set na [lreplace $na $i $i]
7413 incr i -1
7416 set archeads($a) $na
7419 # Return the list of IDs that have tags that are descendents of id,
7420 # ignoring IDs that are descendents of IDs already reported.
7421 proc desctags {id} {
7422 global arcnos arcstart arcids arctags idtags allparents
7423 global growing cached_dtags
7425 if {![info exists allparents($id)]} {
7426 return {}
7428 set t1 [clock clicks -milliseconds]
7429 set argid $id
7430 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7431 # part-way along an arc; check that arc first
7432 set a [lindex $arcnos($id) 0]
7433 if {$arctags($a) ne {}} {
7434 validate_arctags $a
7435 set i [lsearch -exact $arcids($a) $id]
7436 set tid {}
7437 foreach t $arctags($a) {
7438 set j [lsearch -exact $arcids($a) $t]
7439 if {$j >= $i} break
7440 set tid $t
7442 if {$tid ne {}} {
7443 return $tid
7446 set id $arcstart($a)
7447 if {[info exists idtags($id)]} {
7448 return $id
7451 if {[info exists cached_dtags($id)]} {
7452 return $cached_dtags($id)
7455 set origid $id
7456 set todo [list $id]
7457 set queued($id) 1
7458 set nc 1
7459 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7460 set id [lindex $todo $i]
7461 set done($id) 1
7462 set ta [info exists hastaggedancestor($id)]
7463 if {!$ta} {
7464 incr nc -1
7466 # ignore tags on starting node
7467 if {!$ta && $i > 0} {
7468 if {[info exists idtags($id)]} {
7469 set tagloc($id) $id
7470 set ta 1
7471 } elseif {[info exists cached_dtags($id)]} {
7472 set tagloc($id) $cached_dtags($id)
7473 set ta 1
7476 foreach a $arcnos($id) {
7477 set d $arcstart($a)
7478 if {!$ta && $arctags($a) ne {}} {
7479 validate_arctags $a
7480 if {$arctags($a) ne {}} {
7481 lappend tagloc($id) [lindex $arctags($a) end]
7484 if {$ta || $arctags($a) ne {}} {
7485 set tomark [list $d]
7486 for {set j 0} {$j < [llength $tomark]} {incr j} {
7487 set dd [lindex $tomark $j]
7488 if {![info exists hastaggedancestor($dd)]} {
7489 if {[info exists done($dd)]} {
7490 foreach b $arcnos($dd) {
7491 lappend tomark $arcstart($b)
7493 if {[info exists tagloc($dd)]} {
7494 unset tagloc($dd)
7496 } elseif {[info exists queued($dd)]} {
7497 incr nc -1
7499 set hastaggedancestor($dd) 1
7503 if {![info exists queued($d)]} {
7504 lappend todo $d
7505 set queued($d) 1
7506 if {![info exists hastaggedancestor($d)]} {
7507 incr nc
7512 set tags {}
7513 foreach id [array names tagloc] {
7514 if {![info exists hastaggedancestor($id)]} {
7515 foreach t $tagloc($id) {
7516 if {[lsearch -exact $tags $t] < 0} {
7517 lappend tags $t
7522 set t2 [clock clicks -milliseconds]
7523 set loopix $i
7525 # remove tags that are descendents of other tags
7526 for {set i 0} {$i < [llength $tags]} {incr i} {
7527 set a [lindex $tags $i]
7528 for {set j 0} {$j < $i} {incr j} {
7529 set b [lindex $tags $j]
7530 set r [anc_or_desc $a $b]
7531 if {$r == 1} {
7532 set tags [lreplace $tags $j $j]
7533 incr j -1
7534 incr i -1
7535 } elseif {$r == -1} {
7536 set tags [lreplace $tags $i $i]
7537 incr i -1
7538 break
7543 if {[array names growing] ne {}} {
7544 # graph isn't finished, need to check if any tag could get
7545 # eclipsed by another tag coming later. Simply ignore any
7546 # tags that could later get eclipsed.
7547 set ctags {}
7548 foreach t $tags {
7549 if {[is_certain $t $origid]} {
7550 lappend ctags $t
7553 if {$tags eq $ctags} {
7554 set cached_dtags($origid) $tags
7555 } else {
7556 set tags $ctags
7558 } else {
7559 set cached_dtags($origid) $tags
7561 set t3 [clock clicks -milliseconds]
7562 if {0 && $t3 - $t1 >= 100} {
7563 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7564 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7566 return $tags
7569 proc anctags {id} {
7570 global arcnos arcids arcout arcend arctags idtags allparents
7571 global growing cached_atags
7573 if {![info exists allparents($id)]} {
7574 return {}
7576 set t1 [clock clicks -milliseconds]
7577 set argid $id
7578 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7579 # part-way along an arc; check that arc first
7580 set a [lindex $arcnos($id) 0]
7581 if {$arctags($a) ne {}} {
7582 validate_arctags $a
7583 set i [lsearch -exact $arcids($a) $id]
7584 foreach t $arctags($a) {
7585 set j [lsearch -exact $arcids($a) $t]
7586 if {$j > $i} {
7587 return $t
7591 if {![info exists arcend($a)]} {
7592 return {}
7594 set id $arcend($a)
7595 if {[info exists idtags($id)]} {
7596 return $id
7599 if {[info exists cached_atags($id)]} {
7600 return $cached_atags($id)
7603 set origid $id
7604 set todo [list $id]
7605 set queued($id) 1
7606 set taglist {}
7607 set nc 1
7608 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7609 set id [lindex $todo $i]
7610 set done($id) 1
7611 set td [info exists hastaggeddescendent($id)]
7612 if {!$td} {
7613 incr nc -1
7615 # ignore tags on starting node
7616 if {!$td && $i > 0} {
7617 if {[info exists idtags($id)]} {
7618 set tagloc($id) $id
7619 set td 1
7620 } elseif {[info exists cached_atags($id)]} {
7621 set tagloc($id) $cached_atags($id)
7622 set td 1
7625 foreach a $arcout($id) {
7626 if {!$td && $arctags($a) ne {}} {
7627 validate_arctags $a
7628 if {$arctags($a) ne {}} {
7629 lappend tagloc($id) [lindex $arctags($a) 0]
7632 if {![info exists arcend($a)]} continue
7633 set d $arcend($a)
7634 if {$td || $arctags($a) ne {}} {
7635 set tomark [list $d]
7636 for {set j 0} {$j < [llength $tomark]} {incr j} {
7637 set dd [lindex $tomark $j]
7638 if {![info exists hastaggeddescendent($dd)]} {
7639 if {[info exists done($dd)]} {
7640 foreach b $arcout($dd) {
7641 if {[info exists arcend($b)]} {
7642 lappend tomark $arcend($b)
7645 if {[info exists tagloc($dd)]} {
7646 unset tagloc($dd)
7648 } elseif {[info exists queued($dd)]} {
7649 incr nc -1
7651 set hastaggeddescendent($dd) 1
7655 if {![info exists queued($d)]} {
7656 lappend todo $d
7657 set queued($d) 1
7658 if {![info exists hastaggeddescendent($d)]} {
7659 incr nc
7664 set t2 [clock clicks -milliseconds]
7665 set loopix $i
7666 set tags {}
7667 foreach id [array names tagloc] {
7668 if {![info exists hastaggeddescendent($id)]} {
7669 foreach t $tagloc($id) {
7670 if {[lsearch -exact $tags $t] < 0} {
7671 lappend tags $t
7677 # remove tags that are ancestors of other tags
7678 for {set i 0} {$i < [llength $tags]} {incr i} {
7679 set a [lindex $tags $i]
7680 for {set j 0} {$j < $i} {incr j} {
7681 set b [lindex $tags $j]
7682 set r [anc_or_desc $a $b]
7683 if {$r == -1} {
7684 set tags [lreplace $tags $j $j]
7685 incr j -1
7686 incr i -1
7687 } elseif {$r == 1} {
7688 set tags [lreplace $tags $i $i]
7689 incr i -1
7690 break
7695 if {[array names growing] ne {}} {
7696 # graph isn't finished, need to check if any tag could get
7697 # eclipsed by another tag coming later. Simply ignore any
7698 # tags that could later get eclipsed.
7699 set ctags {}
7700 foreach t $tags {
7701 if {[is_certain $origid $t]} {
7702 lappend ctags $t
7705 if {$tags eq $ctags} {
7706 set cached_atags($origid) $tags
7707 } else {
7708 set tags $ctags
7710 } else {
7711 set cached_atags($origid) $tags
7713 set t3 [clock clicks -milliseconds]
7714 if {0 && $t3 - $t1 >= 100} {
7715 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7716 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7718 return $tags
7721 # Return the list of IDs that have heads that are descendents of id,
7722 # including id itself if it has a head.
7723 proc descheads {id} {
7724 global arcnos arcstart arcids archeads idheads cached_dheads
7725 global allparents
7727 if {![info exists allparents($id)]} {
7728 return {}
7730 set aret {}
7731 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7732 # part-way along an arc; check it first
7733 set a [lindex $arcnos($id) 0]
7734 if {$archeads($a) ne {}} {
7735 validate_archeads $a
7736 set i [lsearch -exact $arcids($a) $id]
7737 foreach t $archeads($a) {
7738 set j [lsearch -exact $arcids($a) $t]
7739 if {$j > $i} break
7740 lappend aret $t
7743 set id $arcstart($a)
7745 set origid $id
7746 set todo [list $id]
7747 set seen($id) 1
7748 set ret {}
7749 for {set i 0} {$i < [llength $todo]} {incr i} {
7750 set id [lindex $todo $i]
7751 if {[info exists cached_dheads($id)]} {
7752 set ret [concat $ret $cached_dheads($id)]
7753 } else {
7754 if {[info exists idheads($id)]} {
7755 lappend ret $id
7757 foreach a $arcnos($id) {
7758 if {$archeads($a) ne {}} {
7759 validate_archeads $a
7760 if {$archeads($a) ne {}} {
7761 set ret [concat $ret $archeads($a)]
7764 set d $arcstart($a)
7765 if {![info exists seen($d)]} {
7766 lappend todo $d
7767 set seen($d) 1
7772 set ret [lsort -unique $ret]
7773 set cached_dheads($origid) $ret
7774 return [concat $ret $aret]
7777 proc addedtag {id} {
7778 global arcnos arcout cached_dtags cached_atags
7780 if {![info exists arcnos($id)]} return
7781 if {![info exists arcout($id)]} {
7782 recalcarc [lindex $arcnos($id) 0]
7784 catch {unset cached_dtags}
7785 catch {unset cached_atags}
7788 proc addedhead {hid head} {
7789 global arcnos arcout cached_dheads
7791 if {![info exists arcnos($hid)]} return
7792 if {![info exists arcout($hid)]} {
7793 recalcarc [lindex $arcnos($hid) 0]
7795 catch {unset cached_dheads}
7798 proc removedhead {hid head} {
7799 global cached_dheads
7801 catch {unset cached_dheads}
7804 proc movedhead {hid head} {
7805 global arcnos arcout cached_dheads
7807 if {![info exists arcnos($hid)]} return
7808 if {![info exists arcout($hid)]} {
7809 recalcarc [lindex $arcnos($hid) 0]
7811 catch {unset cached_dheads}
7814 proc changedrefs {} {
7815 global cached_dheads cached_dtags cached_atags
7816 global arctags archeads arcnos arcout idheads idtags
7818 foreach id [concat [array names idheads] [array names idtags]] {
7819 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7820 set a [lindex $arcnos($id) 0]
7821 if {![info exists donearc($a)]} {
7822 recalcarc $a
7823 set donearc($a) 1
7827 catch {unset cached_dtags}
7828 catch {unset cached_atags}
7829 catch {unset cached_dheads}
7832 proc rereadrefs {} {
7833 global idtags idheads idotherrefs mainhead
7835 set refids [concat [array names idtags] \
7836 [array names idheads] [array names idotherrefs]]
7837 foreach id $refids {
7838 if {![info exists ref($id)]} {
7839 set ref($id) [listrefs $id]
7842 set oldmainhead $mainhead
7843 readrefs
7844 changedrefs
7845 set refids [lsort -unique [concat $refids [array names idtags] \
7846 [array names idheads] [array names idotherrefs]]]
7847 foreach id $refids {
7848 set v [listrefs $id]
7849 if {![info exists ref($id)] || $ref($id) != $v ||
7850 ($id eq $oldmainhead && $id ne $mainhead) ||
7851 ($id eq $mainhead && $id ne $oldmainhead)} {
7852 redrawtags $id
7855 run refill_reflist
7858 proc listrefs {id} {
7859 global idtags idheads idotherrefs
7861 set x {}
7862 if {[info exists idtags($id)]} {
7863 set x $idtags($id)
7865 set y {}
7866 if {[info exists idheads($id)]} {
7867 set y $idheads($id)
7869 set z {}
7870 if {[info exists idotherrefs($id)]} {
7871 set z $idotherrefs($id)
7873 return [list $x $y $z]
7876 proc showtag {tag isnew} {
7877 global ctext tagcontents tagids linknum tagobjid
7879 if {$isnew} {
7880 addtohistory [list showtag $tag 0]
7882 $ctext conf -state normal
7883 clear_ctext
7884 settabs 0
7885 set linknum 0
7886 if {![info exists tagcontents($tag)]} {
7887 catch {
7888 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7891 if {[info exists tagcontents($tag)]} {
7892 set text $tagcontents($tag)
7893 } else {
7894 set text "Tag: $tag\nId: $tagids($tag)"
7896 appendwithlinks $text {}
7897 $ctext conf -state disabled
7898 init_flist {}
7901 proc doquit {} {
7902 global stopped
7903 set stopped 100
7904 savestuff .
7905 destroy .
7908 proc mkfontdisp {font top which} {
7909 global fontattr fontpref $font
7911 set fontpref($font) [set $font]
7912 button $top.${font}but -text $which -font optionfont \
7913 -command [list choosefont $font $which]
7914 label $top.$font -relief flat -font $font \
7915 -text $fontattr($font,family) -justify left
7916 grid x $top.${font}but $top.$font -sticky w
7919 proc choosefont {font which} {
7920 global fontparam fontlist fonttop fontattr
7922 set fontparam(which) $which
7923 set fontparam(font) $font
7924 set fontparam(family) [font actual $font -family]
7925 set fontparam(size) $fontattr($font,size)
7926 set fontparam(weight) $fontattr($font,weight)
7927 set fontparam(slant) $fontattr($font,slant)
7928 set top .gitkfont
7929 set fonttop $top
7930 if {![winfo exists $top]} {
7931 font create sample
7932 eval font config sample [font actual $font]
7933 toplevel $top
7934 wm title $top "Gitk font chooser"
7935 label $top.l -textvariable fontparam(which) -font uifont
7936 pack $top.l -side top
7937 set fontlist [lsort [font families]]
7938 frame $top.f
7939 listbox $top.f.fam -listvariable fontlist \
7940 -yscrollcommand [list $top.f.sb set]
7941 bind $top.f.fam <<ListboxSelect>> selfontfam
7942 scrollbar $top.f.sb -command [list $top.f.fam yview]
7943 pack $top.f.sb -side right -fill y
7944 pack $top.f.fam -side left -fill both -expand 1
7945 pack $top.f -side top -fill both -expand 1
7946 frame $top.g
7947 spinbox $top.g.size -from 4 -to 40 -width 4 \
7948 -textvariable fontparam(size) \
7949 -validatecommand {string is integer -strict %s}
7950 checkbutton $top.g.bold -padx 5 \
7951 -font {{Times New Roman} 12 bold} -text "B" -indicatoron 0 \
7952 -variable fontparam(weight) -onvalue bold -offvalue normal
7953 checkbutton $top.g.ital -padx 5 \
7954 -font {{Times New Roman} 12 italic} -text "I" -indicatoron 0 \
7955 -variable fontparam(slant) -onvalue italic -offvalue roman
7956 pack $top.g.size $top.g.bold $top.g.ital -side left
7957 pack $top.g -side top
7958 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7959 -background white
7960 $top.c create text 100 25 -anchor center -text $which -font sample \
7961 -fill black -tags text
7962 bind $top.c <Configure> [list centertext $top.c]
7963 pack $top.c -side top -fill x
7964 frame $top.buts
7965 button $top.buts.ok -text "OK" -command fontok -default active \
7966 -font uifont
7967 button $top.buts.can -text "Cancel" -command fontcan -default normal \
7968 -font uifont
7969 grid $top.buts.ok $top.buts.can
7970 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7971 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7972 pack $top.buts -side bottom -fill x
7973 trace add variable fontparam write chg_fontparam
7974 } else {
7975 raise $top
7976 $top.c itemconf text -text $which
7978 set i [lsearch -exact $fontlist $fontparam(family)]
7979 if {$i >= 0} {
7980 $top.f.fam selection set $i
7981 $top.f.fam see $i
7985 proc centertext {w} {
7986 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7989 proc fontok {} {
7990 global fontparam fontpref prefstop
7992 set f $fontparam(font)
7993 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7994 if {$fontparam(weight) eq "bold"} {
7995 lappend fontpref($f) "bold"
7997 if {$fontparam(slant) eq "italic"} {
7998 lappend fontpref($f) "italic"
8000 set w $prefstop.$f
8001 $w conf -text $fontparam(family) -font $fontpref($f)
8003 fontcan
8006 proc fontcan {} {
8007 global fonttop fontparam
8009 if {[info exists fonttop]} {
8010 catch {destroy $fonttop}
8011 catch {font delete sample}
8012 unset fonttop
8013 unset fontparam
8017 proc selfontfam {} {
8018 global fonttop fontparam
8020 set i [$fonttop.f.fam curselection]
8021 if {$i ne {}} {
8022 set fontparam(family) [$fonttop.f.fam get $i]
8026 proc chg_fontparam {v sub op} {
8027 global fontparam
8029 font config sample -$sub $fontparam($sub)
8032 proc doprefs {} {
8033 global maxwidth maxgraphpct
8034 global oldprefs prefstop showneartags showlocalchanges
8035 global bgcolor fgcolor ctext diffcolors selectbgcolor
8036 global uifont tabstop limitdiffs
8038 set top .gitkprefs
8039 set prefstop $top
8040 if {[winfo exists $top]} {
8041 raise $top
8042 return
8044 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8045 limitdiffs tabstop} {
8046 set oldprefs($v) [set $v]
8048 toplevel $top
8049 wm title $top "Gitk preferences"
8050 label $top.ldisp -text "Commit list display options"
8051 $top.ldisp configure -font uifont
8052 grid $top.ldisp - -sticky w -pady 10
8053 label $top.spacer -text " "
8054 label $top.maxwidthl -text "Maximum graph width (lines)" \
8055 -font optionfont
8056 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8057 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8058 label $top.maxpctl -text "Maximum graph width (% of pane)" \
8059 -font optionfont
8060 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8061 grid x $top.maxpctl $top.maxpct -sticky w
8062 frame $top.showlocal
8063 label $top.showlocal.l -text "Show local changes" -font optionfont
8064 checkbutton $top.showlocal.b -variable showlocalchanges
8065 pack $top.showlocal.b $top.showlocal.l -side left
8066 grid x $top.showlocal -sticky w
8068 label $top.ddisp -text "Diff display options"
8069 $top.ddisp configure -font uifont
8070 grid $top.ddisp - -sticky w -pady 10
8071 label $top.tabstopl -text "Tab spacing" -font optionfont
8072 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8073 grid x $top.tabstopl $top.tabstop -sticky w
8074 frame $top.ntag
8075 label $top.ntag.l -text "Display nearby tags" -font optionfont
8076 checkbutton $top.ntag.b -variable showneartags
8077 pack $top.ntag.b $top.ntag.l -side left
8078 grid x $top.ntag -sticky w
8079 frame $top.ldiff
8080 label $top.ldiff.l -text "Limit diffs to listed paths" -font optionfont
8081 checkbutton $top.ldiff.b -variable limitdiffs
8082 pack $top.ldiff.b $top.ldiff.l -side left
8083 grid x $top.ldiff -sticky w
8085 label $top.cdisp -text "Colors: press to choose"
8086 $top.cdisp configure -font uifont
8087 grid $top.cdisp - -sticky w -pady 10
8088 label $top.bg -padx 40 -relief sunk -background $bgcolor
8089 button $top.bgbut -text "Background" -font optionfont \
8090 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8091 grid x $top.bgbut $top.bg -sticky w
8092 label $top.fg -padx 40 -relief sunk -background $fgcolor
8093 button $top.fgbut -text "Foreground" -font optionfont \
8094 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8095 grid x $top.fgbut $top.fg -sticky w
8096 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8097 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
8098 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8099 [list $ctext tag conf d0 -foreground]]
8100 grid x $top.diffoldbut $top.diffold -sticky w
8101 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8102 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
8103 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8104 [list $ctext tag conf d1 -foreground]]
8105 grid x $top.diffnewbut $top.diffnew -sticky w
8106 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8107 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
8108 -command [list choosecolor diffcolors 2 $top.hunksep \
8109 "diff hunk header" \
8110 [list $ctext tag conf hunksep -foreground]]
8111 grid x $top.hunksepbut $top.hunksep -sticky w
8112 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8113 button $top.selbgbut -text "Select bg" -font optionfont \
8114 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8115 grid x $top.selbgbut $top.selbgsep -sticky w
8117 label $top.cfont -text "Fonts: press to choose"
8118 $top.cfont configure -font uifont
8119 grid $top.cfont - -sticky w -pady 10
8120 mkfontdisp mainfont $top "Main font"
8121 mkfontdisp textfont $top "Diff display font"
8122 mkfontdisp uifont $top "User interface font"
8124 frame $top.buts
8125 button $top.buts.ok -text "OK" -command prefsok -default active
8126 $top.buts.ok configure -font uifont
8127 button $top.buts.can -text "Cancel" -command prefscan -default normal
8128 $top.buts.can configure -font uifont
8129 grid $top.buts.ok $top.buts.can
8130 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8131 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8132 grid $top.buts - - -pady 10 -sticky ew
8133 bind $top <Visibility> "focus $top.buts.ok"
8136 proc choosecolor {v vi w x cmd} {
8137 global $v
8139 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8140 -title "Gitk: choose color for $x"]
8141 if {$c eq {}} return
8142 $w conf -background $c
8143 lset $v $vi $c
8144 eval $cmd $c
8147 proc setselbg {c} {
8148 global bglist cflist
8149 foreach w $bglist {
8150 $w configure -selectbackground $c
8152 $cflist tag configure highlight \
8153 -background [$cflist cget -selectbackground]
8154 allcanvs itemconf secsel -fill $c
8157 proc setbg {c} {
8158 global bglist
8160 foreach w $bglist {
8161 $w conf -background $c
8165 proc setfg {c} {
8166 global fglist canv
8168 foreach w $fglist {
8169 $w conf -foreground $c
8171 allcanvs itemconf text -fill $c
8172 $canv itemconf circle -outline $c
8175 proc prefscan {} {
8176 global oldprefs prefstop
8178 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8179 limitdiffs tabstop} {
8180 global $v
8181 set $v $oldprefs($v)
8183 catch {destroy $prefstop}
8184 unset prefstop
8185 fontcan
8188 proc prefsok {} {
8189 global maxwidth maxgraphpct
8190 global oldprefs prefstop showneartags showlocalchanges
8191 global fontpref mainfont textfont uifont
8192 global limitdiffs
8194 catch {destroy $prefstop}
8195 unset prefstop
8196 fontcan
8197 set fontchanged 0
8198 if {$mainfont ne $fontpref(mainfont)} {
8199 set mainfont $fontpref(mainfont)
8200 parsefont mainfont $mainfont
8201 eval font configure mainfont [fontflags mainfont]
8202 eval font configure mainfontbold [fontflags mainfont 1]
8203 setcoords
8204 set fontchanged 1
8206 if {$textfont ne $fontpref(textfont)} {
8207 set textfont $fontpref(textfont)
8208 parsefont textfont $textfont
8209 eval font configure textfont [fontflags textfont]
8210 eval font configure textfontbold [fontflags textfont 1]
8212 if {$uifont ne $fontpref(uifont)} {
8213 set uifont $fontpref(uifont)
8214 parsefont uifont $uifont
8215 eval font configure uifont [fontflags uifont]
8217 settabs
8218 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8219 if {$showlocalchanges} {
8220 doshowlocalchanges
8221 } else {
8222 dohidelocalchanges
8225 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8226 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8227 redisplay
8228 } elseif {$showneartags != $oldprefs(showneartags) ||
8229 $limitdiffs != $oldprefs(limitdiffs)} {
8230 reselectline
8234 proc formatdate {d} {
8235 global datetimeformat
8236 if {$d ne {}} {
8237 set d [clock format $d -format $datetimeformat]
8239 return $d
8242 # This list of encoding names and aliases is distilled from
8243 # http://www.iana.org/assignments/character-sets.
8244 # Not all of them are supported by Tcl.
8245 set encoding_aliases {
8246 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8247 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8248 { ISO-10646-UTF-1 csISO10646UTF1 }
8249 { ISO_646.basic:1983 ref csISO646basic1983 }
8250 { INVARIANT csINVARIANT }
8251 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8252 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8253 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8254 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8255 { NATS-DANO iso-ir-9-1 csNATSDANO }
8256 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8257 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8258 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8259 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8260 { ISO-2022-KR csISO2022KR }
8261 { EUC-KR csEUCKR }
8262 { ISO-2022-JP csISO2022JP }
8263 { ISO-2022-JP-2 csISO2022JP2 }
8264 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8265 csISO13JISC6220jp }
8266 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8267 { IT iso-ir-15 ISO646-IT csISO15Italian }
8268 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8269 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8270 { greek7-old iso-ir-18 csISO18Greek7Old }
8271 { latin-greek iso-ir-19 csISO19LatinGreek }
8272 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8273 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8274 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8275 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8276 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8277 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8278 { INIS iso-ir-49 csISO49INIS }
8279 { INIS-8 iso-ir-50 csISO50INIS8 }
8280 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8281 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8282 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8283 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8284 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8285 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8286 csISO60Norwegian1 }
8287 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8288 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8289 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8290 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8291 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8292 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8293 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8294 { greek7 iso-ir-88 csISO88Greek7 }
8295 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8296 { iso-ir-90 csISO90 }
8297 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8298 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8299 csISO92JISC62991984b }
8300 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8301 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8302 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8303 csISO95JIS62291984handadd }
8304 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8305 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8306 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8307 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8308 CP819 csISOLatin1 }
8309 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8310 { T.61-7bit iso-ir-102 csISO102T617bit }
8311 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8312 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8313 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8314 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8315 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8316 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8317 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8318 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8319 arabic csISOLatinArabic }
8320 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8321 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8322 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8323 greek greek8 csISOLatinGreek }
8324 { T.101-G2 iso-ir-128 csISO128T101G2 }
8325 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8326 csISOLatinHebrew }
8327 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8328 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8329 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8330 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8331 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8332 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8333 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8334 csISOLatinCyrillic }
8335 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8336 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8337 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8338 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8339 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8340 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8341 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8342 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8343 { ISO_10367-box iso-ir-155 csISO10367Box }
8344 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8345 { latin-lap lap iso-ir-158 csISO158Lap }
8346 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8347 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8348 { us-dk csUSDK }
8349 { dk-us csDKUS }
8350 { JIS_X0201 X0201 csHalfWidthKatakana }
8351 { KSC5636 ISO646-KR csKSC5636 }
8352 { ISO-10646-UCS-2 csUnicode }
8353 { ISO-10646-UCS-4 csUCS4 }
8354 { DEC-MCS dec csDECMCS }
8355 { hp-roman8 roman8 r8 csHPRoman8 }
8356 { macintosh mac csMacintosh }
8357 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8358 csIBM037 }
8359 { IBM038 EBCDIC-INT cp038 csIBM038 }
8360 { IBM273 CP273 csIBM273 }
8361 { IBM274 EBCDIC-BE CP274 csIBM274 }
8362 { IBM275 EBCDIC-BR cp275 csIBM275 }
8363 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8364 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8365 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8366 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8367 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8368 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8369 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8370 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8371 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8372 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8373 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8374 { IBM437 cp437 437 csPC8CodePage437 }
8375 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8376 { IBM775 cp775 csPC775Baltic }
8377 { IBM850 cp850 850 csPC850Multilingual }
8378 { IBM851 cp851 851 csIBM851 }
8379 { IBM852 cp852 852 csPCp852 }
8380 { IBM855 cp855 855 csIBM855 }
8381 { IBM857 cp857 857 csIBM857 }
8382 { IBM860 cp860 860 csIBM860 }
8383 { IBM861 cp861 861 cp-is csIBM861 }
8384 { IBM862 cp862 862 csPC862LatinHebrew }
8385 { IBM863 cp863 863 csIBM863 }
8386 { IBM864 cp864 csIBM864 }
8387 { IBM865 cp865 865 csIBM865 }
8388 { IBM866 cp866 866 csIBM866 }
8389 { IBM868 CP868 cp-ar csIBM868 }
8390 { IBM869 cp869 869 cp-gr csIBM869 }
8391 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8392 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8393 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8394 { IBM891 cp891 csIBM891 }
8395 { IBM903 cp903 csIBM903 }
8396 { IBM904 cp904 904 csIBBM904 }
8397 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8398 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8399 { IBM1026 CP1026 csIBM1026 }
8400 { EBCDIC-AT-DE csIBMEBCDICATDE }
8401 { EBCDIC-AT-DE-A csEBCDICATDEA }
8402 { EBCDIC-CA-FR csEBCDICCAFR }
8403 { EBCDIC-DK-NO csEBCDICDKNO }
8404 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8405 { EBCDIC-FI-SE csEBCDICFISE }
8406 { EBCDIC-FI-SE-A csEBCDICFISEA }
8407 { EBCDIC-FR csEBCDICFR }
8408 { EBCDIC-IT csEBCDICIT }
8409 { EBCDIC-PT csEBCDICPT }
8410 { EBCDIC-ES csEBCDICES }
8411 { EBCDIC-ES-A csEBCDICESA }
8412 { EBCDIC-ES-S csEBCDICESS }
8413 { EBCDIC-UK csEBCDICUK }
8414 { EBCDIC-US csEBCDICUS }
8415 { UNKNOWN-8BIT csUnknown8BiT }
8416 { MNEMONIC csMnemonic }
8417 { MNEM csMnem }
8418 { VISCII csVISCII }
8419 { VIQR csVIQR }
8420 { KOI8-R csKOI8R }
8421 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8422 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8423 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8424 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8425 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8426 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8427 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8428 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8429 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8430 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8431 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8432 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8433 { IBM1047 IBM-1047 }
8434 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8435 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8436 { UNICODE-1-1 csUnicode11 }
8437 { CESU-8 csCESU-8 }
8438 { BOCU-1 csBOCU-1 }
8439 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8440 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8441 l8 }
8442 { ISO-8859-15 ISO_8859-15 Latin-9 }
8443 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8444 { GBK CP936 MS936 windows-936 }
8445 { JIS_Encoding csJISEncoding }
8446 { Shift_JIS MS_Kanji csShiftJIS }
8447 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8448 EUC-JP }
8449 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8450 { ISO-10646-UCS-Basic csUnicodeASCII }
8451 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8452 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8453 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8454 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8455 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8456 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8457 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8458 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8459 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8460 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8461 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8462 { Ventura-US csVenturaUS }
8463 { Ventura-International csVenturaInternational }
8464 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8465 { PC8-Turkish csPC8Turkish }
8466 { IBM-Symbols csIBMSymbols }
8467 { IBM-Thai csIBMThai }
8468 { HP-Legal csHPLegal }
8469 { HP-Pi-font csHPPiFont }
8470 { HP-Math8 csHPMath8 }
8471 { Adobe-Symbol-Encoding csHPPSMath }
8472 { HP-DeskTop csHPDesktop }
8473 { Ventura-Math csVenturaMath }
8474 { Microsoft-Publishing csMicrosoftPublishing }
8475 { Windows-31J csWindows31J }
8476 { GB2312 csGB2312 }
8477 { Big5 csBig5 }
8480 proc tcl_encoding {enc} {
8481 global encoding_aliases
8482 set names [encoding names]
8483 set lcnames [string tolower $names]
8484 set enc [string tolower $enc]
8485 set i [lsearch -exact $lcnames $enc]
8486 if {$i < 0} {
8487 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8488 if {[regsub {^iso[-_]} $enc iso encx]} {
8489 set i [lsearch -exact $lcnames $encx]
8492 if {$i < 0} {
8493 foreach l $encoding_aliases {
8494 set ll [string tolower $l]
8495 if {[lsearch -exact $ll $enc] < 0} continue
8496 # look through the aliases for one that tcl knows about
8497 foreach e $ll {
8498 set i [lsearch -exact $lcnames $e]
8499 if {$i < 0} {
8500 if {[regsub {^iso[-_]} $e iso ex]} {
8501 set i [lsearch -exact $lcnames $ex]
8504 if {$i >= 0} break
8506 break
8509 if {$i >= 0} {
8510 return [lindex $names $i]
8512 return {}
8515 # First check that Tcl/Tk is recent enough
8516 if {[catch {package require Tk 8.4} err]} {
8517 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8518 Gitk requires at least Tcl/Tk 8.4."
8519 exit 1
8522 # defaults...
8523 set datemode 0
8524 set wrcomcmd "git diff-tree --stdin -p --pretty"
8526 set gitencoding {}
8527 catch {
8528 set gitencoding [exec git config --get i18n.commitencoding]
8530 if {$gitencoding == ""} {
8531 set gitencoding "utf-8"
8533 set tclencoding [tcl_encoding $gitencoding]
8534 if {$tclencoding == {}} {
8535 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8538 set mainfont {Helvetica 9}
8539 set textfont {Courier 9}
8540 set uifont {Helvetica 9 bold}
8541 set tabstop 8
8542 set findmergefiles 0
8543 set maxgraphpct 50
8544 set maxwidth 16
8545 set revlistorder 0
8546 set fastdate 0
8547 set uparrowlen 5
8548 set downarrowlen 5
8549 set mingaplen 100
8550 set cmitmode "patch"
8551 set wrapcomment "none"
8552 set showneartags 1
8553 set maxrefs 20
8554 set maxlinelen 200
8555 set showlocalchanges 1
8556 set limitdiffs 1
8557 set datetimeformat "%Y-%m-%d %H:%M:%S"
8559 set colors {green red blue magenta darkgrey brown orange}
8560 set bgcolor white
8561 set fgcolor black
8562 set diffcolors {red "#00a000" blue}
8563 set diffcontext 3
8564 set selectbgcolor gray85
8566 catch {source ~/.gitk}
8568 font create optionfont -family sans-serif -size -12
8570 parsefont mainfont $mainfont
8571 eval font create mainfont [fontflags mainfont]
8572 eval font create mainfontbold [fontflags mainfont 1]
8574 parsefont textfont $textfont
8575 eval font create textfont [fontflags textfont]
8576 eval font create textfontbold [fontflags textfont 1]
8578 parsefont uifont $uifont
8579 eval font create uifont [fontflags uifont]
8581 # check that we can find a .git directory somewhere...
8582 if {[catch {set gitdir [gitdir]}]} {
8583 show_error {} . "Cannot find a git repository here."
8584 exit 1
8586 if {![file isdirectory $gitdir]} {
8587 show_error {} . "Cannot find the git directory \"$gitdir\"."
8588 exit 1
8591 set mergeonly 0
8592 set revtreeargs {}
8593 set cmdline_files {}
8594 set i 0
8595 foreach arg $argv {
8596 switch -- $arg {
8597 "" { }
8598 "-d" { set datemode 1 }
8599 "--merge" {
8600 set mergeonly 1
8601 lappend revtreeargs $arg
8603 "--" {
8604 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8605 break
8607 default {
8608 lappend revtreeargs $arg
8611 incr i
8614 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8615 # no -- on command line, but some arguments (other than -d)
8616 if {[catch {
8617 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8618 set cmdline_files [split $f "\n"]
8619 set n [llength $cmdline_files]
8620 set revtreeargs [lrange $revtreeargs 0 end-$n]
8621 # Unfortunately git rev-parse doesn't produce an error when
8622 # something is both a revision and a filename. To be consistent
8623 # with git log and git rev-list, check revtreeargs for filenames.
8624 foreach arg $revtreeargs {
8625 if {[file exists $arg]} {
8626 show_error {} . "Ambiguous argument '$arg': both revision\
8627 and filename"
8628 exit 1
8631 } err]} {
8632 # unfortunately we get both stdout and stderr in $err,
8633 # so look for "fatal:".
8634 set i [string first "fatal:" $err]
8635 if {$i > 0} {
8636 set err [string range $err [expr {$i + 6}] end]
8638 show_error {} . "Bad arguments to gitk:\n$err"
8639 exit 1
8643 if {$mergeonly} {
8644 # find the list of unmerged files
8645 set mlist {}
8646 set nr_unmerged 0
8647 if {[catch {
8648 set fd [open "| git ls-files -u" r]
8649 } err]} {
8650 show_error {} . "Couldn't get list of unmerged files: $err"
8651 exit 1
8653 while {[gets $fd line] >= 0} {
8654 set i [string first "\t" $line]
8655 if {$i < 0} continue
8656 set fname [string range $line [expr {$i+1}] end]
8657 if {[lsearch -exact $mlist $fname] >= 0} continue
8658 incr nr_unmerged
8659 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8660 lappend mlist $fname
8663 catch {close $fd}
8664 if {$mlist eq {}} {
8665 if {$nr_unmerged == 0} {
8666 show_error {} . "No files selected: --merge specified but\
8667 no files are unmerged."
8668 } else {
8669 show_error {} . "No files selected: --merge specified but\
8670 no unmerged files are within file limit."
8672 exit 1
8674 set cmdline_files $mlist
8677 set nullid "0000000000000000000000000000000000000000"
8678 set nullid2 "0000000000000000000000000000000000000001"
8680 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8682 set runq {}
8683 set history {}
8684 set historyindex 0
8685 set fh_serial 0
8686 set nhl_names {}
8687 set highlight_paths {}
8688 set findpattern {}
8689 set searchdirn -forwards
8690 set boldrows {}
8691 set boldnamerows {}
8692 set diffelide {0 0}
8693 set markingmatches 0
8694 set linkentercount 0
8695 set need_redisplay 0
8696 set nrows_drawn 0
8697 set firsttabstop 0
8699 set nextviewnum 1
8700 set curview 0
8701 set selectedview 0
8702 set selectedhlview None
8703 set highlight_related None
8704 set highlight_files {}
8705 set viewfiles(0) {}
8706 set viewperm(0) 0
8707 set viewargs(0) {}
8709 set cmdlineok 0
8710 set stopped 0
8711 set stuffsaved 0
8712 set patchnum 0
8713 set localirow -1
8714 set localfrow -1
8715 set lserial 0
8716 setcoords
8717 makewindow
8718 # wait for the window to become visible
8719 tkwait visibility .
8720 wm title . "[file tail $argv0]: [file tail [pwd]]"
8721 readrefs
8723 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8724 # create a view for the files/dirs specified on the command line
8725 set curview 1
8726 set selectedview 1
8727 set nextviewnum 2
8728 set viewname(1) "Command line"
8729 set viewfiles(1) $cmdline_files
8730 set viewargs(1) $revtreeargs
8731 set viewperm(1) 0
8732 addviewmenu 1
8733 .bar.view entryconf Edit* -state normal
8734 .bar.view entryconf Delete* -state normal
8737 if {[info exists permviews]} {
8738 foreach v $permviews {
8739 set n $nextviewnum
8740 incr nextviewnum
8741 set viewname($n) [lindex $v 0]
8742 set viewfiles($n) [lindex $v 1]
8743 set viewargs($n) [lindex $v 2]
8744 set viewperm($n) 1
8745 addviewmenu $n
8748 getcommits