gitk: Only restore window size from ~/.gitk, not position
[git.git] / gitk
blobf8f006fa11f62f239fd7be2d7262b29b6dbb69d0
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 "[mc "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 [mc "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 [mc "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}
248 ">" {set listed 4}
250 set ids [string range $ids 1 end]
252 set ok 1
253 foreach id $ids {
254 if {[string length $id] != 40} {
255 set ok 0
256 break
260 if {!$ok} {
261 set shortcmit $cmit
262 if {[string length $shortcmit] > 80} {
263 set shortcmit "[string range $shortcmit 0 80]..."
265 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
266 exit 1
268 set id [lindex $ids 0]
269 if {![info exists ordertok($view,$id)]} {
270 set otok "o[strrep $vnextroot($view)]"
271 incr vnextroot($view)
272 set ordertok($view,$id) $otok
273 } else {
274 set otok $ordertok($view,$id)
275 unset idpending($view,$id)
277 if {$listed} {
278 set olds [lrange $ids 1 end]
279 if {[llength $olds] == 1} {
280 set p [lindex $olds 0]
281 lappend children($view,$p) $id
282 if {![info exists ordertok($view,$p)]} {
283 set ordertok($view,$p) $ordertok($view,$id)
284 set idpending($view,$p) 1
286 } else {
287 set i 0
288 foreach p $olds {
289 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
290 lappend children($view,$p) $id
292 if {![info exists ordertok($view,$p)]} {
293 set ordertok($view,$p) "$otok[strrep $i]]"
294 set idpending($view,$p) 1
296 incr i
299 } else {
300 set olds {}
302 if {![info exists children($view,$id)]} {
303 set children($view,$id) {}
305 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
306 set commitrow($view,$id) $commitidx($view)
307 incr commitidx($view)
308 if {$view == $curview} {
309 lappend parentlist $olds
310 lappend displayorder $id
311 lappend commitlisted $listed
312 } else {
313 lappend vparentlist($view) $olds
314 lappend vdisporder($view) $id
315 lappend vcmitlisted($view) $listed
317 if {[info exists commitinterest($id)]} {
318 foreach script $commitinterest($id) {
319 eval [string map [list "%I" $id] $script]
321 unset commitinterest($id)
323 set gotsome 1
325 if {$gotsome} {
326 run chewcommits $view
327 if {$view == $curview} {
328 # update progress bar
329 global progressdirn progresscoords proglastnc
330 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
331 set proglastnc $commitidx($view)
332 set l [lindex $progresscoords 0]
333 set r [lindex $progresscoords 1]
334 if {$progressdirn} {
335 set r [expr {$r + $inc}]
336 if {$r >= 1.0} {
337 set r 1.0
338 set progressdirn 0
340 if {$r > 0.2} {
341 set l [expr {$r - 0.2}]
343 } else {
344 set l [expr {$l - $inc}]
345 if {$l <= 0.0} {
346 set l 0.0
347 set progressdirn 1
349 set r [expr {$l + 0.2}]
351 set progresscoords [list $l $r]
352 adjustprogress
355 return 2
358 proc chewcommits {view} {
359 global curview hlview viewcomplete
360 global selectedline pending_select
362 if {$view == $curview} {
363 layoutmore
364 if {$viewcomplete($view)} {
365 global displayorder commitidx phase
366 global numcommits startmsecs
368 if {[info exists pending_select]} {
369 set row [first_real_row]
370 selectline $row 1
372 if {$commitidx($curview) > 0} {
373 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
374 #puts "overall $ms ms for $numcommits commits"
375 } else {
376 show_status [mc "No commits selected"]
378 notbusy layout
379 set phase {}
382 if {[info exists hlview] && $view == $hlview} {
383 vhighlightmore
385 return 0
388 proc readcommit {id} {
389 if {[catch {set contents [exec git cat-file commit $id]}]} return
390 parsecommit $id $contents 0
393 proc updatecommits {} {
394 global viewdata curview phase displayorder ordertok idpending
395 global children commitrow selectedline thickerline showneartags
397 if {$phase ne {}} {
398 stop_rev_list
399 set phase {}
401 set n $curview
402 foreach id $displayorder {
403 catch {unset children($n,$id)}
404 catch {unset commitrow($n,$id)}
405 catch {unset ordertok($n,$id)}
407 foreach vid [array names idpending "$n,*"] {
408 unset idpending($vid)
410 set curview -1
411 catch {unset selectedline}
412 catch {unset thickerline}
413 catch {unset viewdata($n)}
414 readrefs
415 changedrefs
416 if {$showneartags} {
417 getallcommits
419 showview $n
422 proc parsecommit {id contents listed} {
423 global commitinfo cdate
425 set inhdr 1
426 set comment {}
427 set headline {}
428 set auname {}
429 set audate {}
430 set comname {}
431 set comdate {}
432 set hdrend [string first "\n\n" $contents]
433 if {$hdrend < 0} {
434 # should never happen...
435 set hdrend [string length $contents]
437 set header [string range $contents 0 [expr {$hdrend - 1}]]
438 set comment [string range $contents [expr {$hdrend + 2}] end]
439 foreach line [split $header "\n"] {
440 set tag [lindex $line 0]
441 if {$tag == "author"} {
442 set audate [lindex $line end-1]
443 set auname [lrange $line 1 end-2]
444 } elseif {$tag == "committer"} {
445 set comdate [lindex $line end-1]
446 set comname [lrange $line 1 end-2]
449 set headline {}
450 # take the first non-blank line of the comment as the headline
451 set headline [string trimleft $comment]
452 set i [string first "\n" $headline]
453 if {$i >= 0} {
454 set headline [string range $headline 0 $i]
456 set headline [string trimright $headline]
457 set i [string first "\r" $headline]
458 if {$i >= 0} {
459 set headline [string trimright [string range $headline 0 $i]]
461 if {!$listed} {
462 # git rev-list indents the comment by 4 spaces;
463 # if we got this via git cat-file, add the indentation
464 set newcomment {}
465 foreach line [split $comment "\n"] {
466 append newcomment " "
467 append newcomment $line
468 append newcomment "\n"
470 set comment $newcomment
472 if {$comdate != {}} {
473 set cdate($id) $comdate
475 set commitinfo($id) [list $headline $auname $audate \
476 $comname $comdate $comment]
479 proc getcommit {id} {
480 global commitdata commitinfo
482 if {[info exists commitdata($id)]} {
483 parsecommit $id $commitdata($id) 1
484 } else {
485 readcommit $id
486 if {![info exists commitinfo($id)]} {
487 set commitinfo($id) [list [mc "No commit information available"]]
490 return 1
493 proc readrefs {} {
494 global tagids idtags headids idheads tagobjid
495 global otherrefids idotherrefs mainhead mainheadid
497 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
498 catch {unset $v}
500 set refd [open [list | git show-ref -d] r]
501 while {[gets $refd line] >= 0} {
502 if {[string index $line 40] ne " "} continue
503 set id [string range $line 0 39]
504 set ref [string range $line 41 end]
505 if {![string match "refs/*" $ref]} continue
506 set name [string range $ref 5 end]
507 if {[string match "remotes/*" $name]} {
508 if {![string match "*/HEAD" $name]} {
509 set headids($name) $id
510 lappend idheads($id) $name
512 } elseif {[string match "heads/*" $name]} {
513 set name [string range $name 6 end]
514 set headids($name) $id
515 lappend idheads($id) $name
516 } elseif {[string match "tags/*" $name]} {
517 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
518 # which is what we want since the former is the commit ID
519 set name [string range $name 5 end]
520 if {[string match "*^{}" $name]} {
521 set name [string range $name 0 end-3]
522 } else {
523 set tagobjid($name) $id
525 set tagids($name) $id
526 lappend idtags($id) $name
527 } else {
528 set otherrefids($name) $id
529 lappend idotherrefs($id) $name
532 catch {close $refd}
533 set mainhead {}
534 set mainheadid {}
535 catch {
536 set thehead [exec git symbolic-ref HEAD]
537 if {[string match "refs/heads/*" $thehead]} {
538 set mainhead [string range $thehead 11 end]
539 if {[info exists headids($mainhead)]} {
540 set mainheadid $headids($mainhead)
546 # skip over fake commits
547 proc first_real_row {} {
548 global nullid nullid2 displayorder numcommits
550 for {set row 0} {$row < $numcommits} {incr row} {
551 set id [lindex $displayorder $row]
552 if {$id ne $nullid && $id ne $nullid2} {
553 break
556 return $row
559 # update things for a head moved to a child of its previous location
560 proc movehead {id name} {
561 global headids idheads
563 removehead $headids($name) $name
564 set headids($name) $id
565 lappend idheads($id) $name
568 # update things when a head has been removed
569 proc removehead {id name} {
570 global headids idheads
572 if {$idheads($id) eq $name} {
573 unset idheads($id)
574 } else {
575 set i [lsearch -exact $idheads($id) $name]
576 if {$i >= 0} {
577 set idheads($id) [lreplace $idheads($id) $i $i]
580 unset headids($name)
583 proc show_error {w top msg} {
584 message $w.m -text $msg -justify center -aspect 400
585 pack $w.m -side top -fill x -padx 20 -pady 20
586 button $w.ok -text [mc OK] -command "destroy $top"
587 pack $w.ok -side bottom -fill x
588 bind $top <Visibility> "grab $top; focus $top"
589 bind $top <Key-Return> "destroy $top"
590 tkwait window $top
593 proc error_popup msg {
594 set w .error
595 toplevel $w
596 wm transient $w .
597 show_error $w $w $msg
600 proc confirm_popup msg {
601 global confirm_ok
602 set confirm_ok 0
603 set w .confirm
604 toplevel $w
605 wm transient $w .
606 message $w.m -text $msg -justify center -aspect 400
607 pack $w.m -side top -fill x -padx 20 -pady 20
608 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
609 pack $w.ok -side left -fill x
610 button $w.cancel -text [mc Cancel] -command "destroy $w"
611 pack $w.cancel -side right -fill x
612 bind $w <Visibility> "grab $w; focus $w"
613 tkwait window $w
614 return $confirm_ok
617 proc setoptions {} {
618 option add *Panedwindow.showHandle 1 startupFile
619 option add *Panedwindow.sashRelief raised startupFile
620 option add *Button.font uifont startupFile
621 option add *Checkbutton.font uifont startupFile
622 option add *Radiobutton.font uifont startupFile
623 option add *Menu.font uifont startupFile
624 option add *Menubutton.font uifont startupFile
625 option add *Label.font uifont startupFile
626 option add *Message.font uifont startupFile
627 option add *Entry.font uifont startupFile
630 proc makewindow {} {
631 global canv canv2 canv3 linespc charspc ctext cflist
632 global tabstop
633 global findtype findtypemenu findloc findstring fstring geometry
634 global entries sha1entry sha1string sha1but
635 global diffcontextstring diffcontext
636 global ignorespace
637 global maincursor textcursor curtextcursor
638 global rowctxmenu fakerowmenu mergemax wrapcomment
639 global highlight_files gdttype
640 global searchstring sstring
641 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
642 global headctxmenu progresscanv progressitem progresscoords statusw
643 global fprogitem fprogcoord lastprogupdate progupdatepending
644 global rprogitem rprogcoord
645 global have_tk85
647 menu .bar
648 .bar add cascade -label [mc "File"] -menu .bar.file
649 menu .bar.file
650 .bar.file add command -label [mc "Update"] -command updatecommits
651 .bar.file add command -label [mc "Reread references"] -command rereadrefs
652 .bar.file add command -label [mc "List references"] -command showrefs
653 .bar.file add command -label [mc "Quit"] -command doquit
654 menu .bar.edit
655 .bar add cascade -label [mc "Edit"] -menu .bar.edit
656 .bar.edit add command -label [mc "Preferences"] -command doprefs
658 menu .bar.view
659 .bar add cascade -label [mc "View"] -menu .bar.view
660 .bar.view add command -label [mc "New view..."] -command {newview 0}
661 .bar.view add command -label [mc "Edit view..."] -command editview \
662 -state disabled
663 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
664 .bar.view add separator
665 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
666 -variable selectedview -value 0
668 menu .bar.help
669 .bar add cascade -label [mc "Help"] -menu .bar.help
670 .bar.help add command -label [mc "About gitk"] -command about
671 .bar.help add command -label [mc "Key bindings"] -command keys
672 .bar.help configure
673 . configure -menu .bar
675 # the gui has upper and lower half, parts of a paned window.
676 panedwindow .ctop -orient vertical
678 # possibly use assumed geometry
679 if {![info exists geometry(pwsash0)]} {
680 set geometry(topheight) [expr {15 * $linespc}]
681 set geometry(topwidth) [expr {80 * $charspc}]
682 set geometry(botheight) [expr {15 * $linespc}]
683 set geometry(botwidth) [expr {50 * $charspc}]
684 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
685 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
688 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
689 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
690 frame .tf.histframe
691 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
693 # create three canvases
694 set cscroll .tf.histframe.csb
695 set canv .tf.histframe.pwclist.canv
696 canvas $canv \
697 -selectbackground $selectbgcolor \
698 -background $bgcolor -bd 0 \
699 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
700 .tf.histframe.pwclist add $canv
701 set canv2 .tf.histframe.pwclist.canv2
702 canvas $canv2 \
703 -selectbackground $selectbgcolor \
704 -background $bgcolor -bd 0 -yscrollincr $linespc
705 .tf.histframe.pwclist add $canv2
706 set canv3 .tf.histframe.pwclist.canv3
707 canvas $canv3 \
708 -selectbackground $selectbgcolor \
709 -background $bgcolor -bd 0 -yscrollincr $linespc
710 .tf.histframe.pwclist add $canv3
711 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
712 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
714 # a scroll bar to rule them
715 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
716 pack $cscroll -side right -fill y
717 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
718 lappend bglist $canv $canv2 $canv3
719 pack .tf.histframe.pwclist -fill both -expand 1 -side left
721 # we have two button bars at bottom of top frame. Bar 1
722 frame .tf.bar
723 frame .tf.lbar -height 15
725 set sha1entry .tf.bar.sha1
726 set entries $sha1entry
727 set sha1but .tf.bar.sha1label
728 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
729 -command gotocommit -width 8
730 $sha1but conf -disabledforeground [$sha1but cget -foreground]
731 pack .tf.bar.sha1label -side left
732 entry $sha1entry -width 40 -font textfont -textvariable sha1string
733 trace add variable sha1string write sha1change
734 pack $sha1entry -side left -pady 2
736 image create bitmap bm-left -data {
737 #define left_width 16
738 #define left_height 16
739 static unsigned char left_bits[] = {
740 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
741 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
742 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
744 image create bitmap bm-right -data {
745 #define right_width 16
746 #define right_height 16
747 static unsigned char right_bits[] = {
748 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
749 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
750 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
752 button .tf.bar.leftbut -image bm-left -command goback \
753 -state disabled -width 26
754 pack .tf.bar.leftbut -side left -fill y
755 button .tf.bar.rightbut -image bm-right -command goforw \
756 -state disabled -width 26
757 pack .tf.bar.rightbut -side left -fill y
759 # Status label and progress bar
760 set statusw .tf.bar.status
761 label $statusw -width 15 -relief sunken
762 pack $statusw -side left -padx 5
763 set h [expr {[font metrics uifont -linespace] + 2}]
764 set progresscanv .tf.bar.progress
765 canvas $progresscanv -relief sunken -height $h -borderwidth 2
766 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
767 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
768 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
769 pack $progresscanv -side right -expand 1 -fill x
770 set progresscoords {0 0}
771 set fprogcoord 0
772 set rprogcoord 0
773 bind $progresscanv <Configure> adjustprogress
774 set lastprogupdate [clock clicks -milliseconds]
775 set progupdatepending 0
777 # build up the bottom bar of upper window
778 label .tf.lbar.flabel -text "[mc "Find"] "
779 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
780 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
781 label .tf.lbar.flab2 -text " [mc "commit"] "
782 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
783 -side left -fill y
784 set gdttype [mc "containing:"]
785 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
786 [mc "containing:"] \
787 [mc "touching paths:"] \
788 [mc "adding/removing string:"]]
789 trace add variable gdttype write gdttype_change
790 pack .tf.lbar.gdttype -side left -fill y
792 set findstring {}
793 set fstring .tf.lbar.findstring
794 lappend entries $fstring
795 entry $fstring -width 30 -font textfont -textvariable findstring
796 trace add variable findstring write find_change
797 set findtype [mc "Exact"]
798 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
799 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
800 trace add variable findtype write findcom_change
801 set findloc [mc "All fields"]
802 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
803 [mc "Comments"] [mc "Author"] [mc "Committer"]
804 trace add variable findloc write find_change
805 pack .tf.lbar.findloc -side right
806 pack .tf.lbar.findtype -side right
807 pack $fstring -side left -expand 1 -fill x
809 # Finish putting the upper half of the viewer together
810 pack .tf.lbar -in .tf -side bottom -fill x
811 pack .tf.bar -in .tf -side bottom -fill x
812 pack .tf.histframe -fill both -side top -expand 1
813 .ctop add .tf
814 .ctop paneconfigure .tf -height $geometry(topheight)
815 .ctop paneconfigure .tf -width $geometry(topwidth)
817 # now build up the bottom
818 panedwindow .pwbottom -orient horizontal
820 # lower left, a text box over search bar, scroll bar to the right
821 # if we know window height, then that will set the lower text height, otherwise
822 # we set lower text height which will drive window height
823 if {[info exists geometry(main)]} {
824 frame .bleft -width $geometry(botwidth)
825 } else {
826 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
828 frame .bleft.top
829 frame .bleft.mid
831 button .bleft.top.search -text [mc "Search"] -command dosearch
832 pack .bleft.top.search -side left -padx 5
833 set sstring .bleft.top.sstring
834 entry $sstring -width 20 -font textfont -textvariable searchstring
835 lappend entries $sstring
836 trace add variable searchstring write incrsearch
837 pack $sstring -side left -expand 1 -fill x
838 radiobutton .bleft.mid.diff -text [mc "Diff"] \
839 -command changediffdisp -variable diffelide -value {0 0}
840 radiobutton .bleft.mid.old -text [mc "Old version"] \
841 -command changediffdisp -variable diffelide -value {0 1}
842 radiobutton .bleft.mid.new -text [mc "New version"] \
843 -command changediffdisp -variable diffelide -value {1 0}
844 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
845 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
846 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
847 -from 1 -increment 1 -to 10000000 \
848 -validate all -validatecommand "diffcontextvalidate %P" \
849 -textvariable diffcontextstring
850 .bleft.mid.diffcontext set $diffcontext
851 trace add variable diffcontextstring write diffcontextchange
852 lappend entries .bleft.mid.diffcontext
853 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
854 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
855 -command changeignorespace -variable ignorespace
856 pack .bleft.mid.ignspace -side left -padx 5
857 set ctext .bleft.ctext
858 text $ctext -background $bgcolor -foreground $fgcolor \
859 -state disabled -font textfont \
860 -yscrollcommand scrolltext -wrap none
861 if {$have_tk85} {
862 $ctext conf -tabstyle wordprocessor
864 scrollbar .bleft.sb -command "$ctext yview"
865 pack .bleft.top -side top -fill x
866 pack .bleft.mid -side top -fill x
867 pack .bleft.sb -side right -fill y
868 pack $ctext -side left -fill both -expand 1
869 lappend bglist $ctext
870 lappend fglist $ctext
872 $ctext tag conf comment -wrap $wrapcomment
873 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
874 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
875 $ctext tag conf d0 -fore [lindex $diffcolors 0]
876 $ctext tag conf d1 -fore [lindex $diffcolors 1]
877 $ctext tag conf m0 -fore red
878 $ctext tag conf m1 -fore blue
879 $ctext tag conf m2 -fore green
880 $ctext tag conf m3 -fore purple
881 $ctext tag conf m4 -fore brown
882 $ctext tag conf m5 -fore "#009090"
883 $ctext tag conf m6 -fore magenta
884 $ctext tag conf m7 -fore "#808000"
885 $ctext tag conf m8 -fore "#009000"
886 $ctext tag conf m9 -fore "#ff0080"
887 $ctext tag conf m10 -fore cyan
888 $ctext tag conf m11 -fore "#b07070"
889 $ctext tag conf m12 -fore "#70b0f0"
890 $ctext tag conf m13 -fore "#70f0b0"
891 $ctext tag conf m14 -fore "#f0b070"
892 $ctext tag conf m15 -fore "#ff70b0"
893 $ctext tag conf mmax -fore darkgrey
894 set mergemax 16
895 $ctext tag conf mresult -font textfontbold
896 $ctext tag conf msep -font textfontbold
897 $ctext tag conf found -back yellow
899 .pwbottom add .bleft
900 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
902 # lower right
903 frame .bright
904 frame .bright.mode
905 radiobutton .bright.mode.patch -text [mc "Patch"] \
906 -command reselectline -variable cmitmode -value "patch"
907 radiobutton .bright.mode.tree -text [mc "Tree"] \
908 -command reselectline -variable cmitmode -value "tree"
909 grid .bright.mode.patch .bright.mode.tree -sticky ew
910 pack .bright.mode -side top -fill x
911 set cflist .bright.cfiles
912 set indent [font measure mainfont "nn"]
913 text $cflist \
914 -selectbackground $selectbgcolor \
915 -background $bgcolor -foreground $fgcolor \
916 -font mainfont \
917 -tabs [list $indent [expr {2 * $indent}]] \
918 -yscrollcommand ".bright.sb set" \
919 -cursor [. cget -cursor] \
920 -spacing1 1 -spacing3 1
921 lappend bglist $cflist
922 lappend fglist $cflist
923 scrollbar .bright.sb -command "$cflist yview"
924 pack .bright.sb -side right -fill y
925 pack $cflist -side left -fill both -expand 1
926 $cflist tag configure highlight \
927 -background [$cflist cget -selectbackground]
928 $cflist tag configure bold -font mainfontbold
930 .pwbottom add .bright
931 .ctop add .pwbottom
933 # restore window width & height if known
934 if {[info exists geometry(main)]} {
935 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
936 if {$w > [winfo screenwidth .]} {
937 set w [winfo screenwidth .]
939 if {$h > [winfo screenheight .]} {
940 set h [winfo screenheight .]
942 wm geometry . "${w}x$h"
946 if {[tk windowingsystem] eq {aqua}} {
947 set M1B M1
948 } else {
949 set M1B Control
952 bind .pwbottom <Configure> {resizecdetpanes %W %w}
953 pack .ctop -fill both -expand 1
954 bindall <1> {selcanvline %W %x %y}
955 #bindall <B1-Motion> {selcanvline %W %x %y}
956 if {[tk windowingsystem] == "win32"} {
957 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
958 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
959 } else {
960 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
961 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
962 if {[tk windowingsystem] eq "aqua"} {
963 bindall <MouseWheel> {
964 set delta [expr {- (%D)}]
965 allcanvs yview scroll $delta units
969 bindall <2> "canvscan mark %W %x %y"
970 bindall <B2-Motion> "canvscan dragto %W %x %y"
971 bindkey <Home> selfirstline
972 bindkey <End> sellastline
973 bind . <Key-Up> "selnextline -1"
974 bind . <Key-Down> "selnextline 1"
975 bind . <Shift-Key-Up> "dofind -1 0"
976 bind . <Shift-Key-Down> "dofind 1 0"
977 bindkey <Key-Right> "goforw"
978 bindkey <Key-Left> "goback"
979 bind . <Key-Prior> "selnextpage -1"
980 bind . <Key-Next> "selnextpage 1"
981 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
982 bind . <$M1B-End> "allcanvs yview moveto 1.0"
983 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
984 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
985 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
986 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
987 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
988 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
989 bindkey <Key-space> "$ctext yview scroll 1 pages"
990 bindkey p "selnextline -1"
991 bindkey n "selnextline 1"
992 bindkey z "goback"
993 bindkey x "goforw"
994 bindkey i "selnextline -1"
995 bindkey k "selnextline 1"
996 bindkey j "goback"
997 bindkey l "goforw"
998 bindkey b "$ctext yview scroll -1 pages"
999 bindkey d "$ctext yview scroll 18 units"
1000 bindkey u "$ctext yview scroll -18 units"
1001 bindkey / {dofind 1 1}
1002 bindkey <Key-Return> {dofind 1 1}
1003 bindkey ? {dofind -1 1}
1004 bindkey f nextfile
1005 bindkey <F5> updatecommits
1006 bind . <$M1B-q> doquit
1007 bind . <$M1B-f> {dofind 1 1}
1008 bind . <$M1B-g> {dofind 1 0}
1009 bind . <$M1B-r> dosearchback
1010 bind . <$M1B-s> dosearch
1011 bind . <$M1B-equal> {incrfont 1}
1012 bind . <$M1B-plus> {incrfont 1}
1013 bind . <$M1B-KP_Add> {incrfont 1}
1014 bind . <$M1B-minus> {incrfont -1}
1015 bind . <$M1B-KP_Subtract> {incrfont -1}
1016 wm protocol . WM_DELETE_WINDOW doquit
1017 bind . <Button-1> "click %W"
1018 bind $fstring <Key-Return> {dofind 1 1}
1019 bind $sha1entry <Key-Return> gotocommit
1020 bind $sha1entry <<PasteSelection>> clearsha1
1021 bind $cflist <1> {sel_flist %W %x %y; break}
1022 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1023 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1024 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1026 set maincursor [. cget -cursor]
1027 set textcursor [$ctext cget -cursor]
1028 set curtextcursor $textcursor
1030 set rowctxmenu .rowctxmenu
1031 menu $rowctxmenu -tearoff 0
1032 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1033 -command {diffvssel 0}
1034 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1035 -command {diffvssel 1}
1036 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1037 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1038 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1039 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1040 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1041 -command cherrypick
1042 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1043 -command resethead
1045 set fakerowmenu .fakerowmenu
1046 menu $fakerowmenu -tearoff 0
1047 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1048 -command {diffvssel 0}
1049 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1050 -command {diffvssel 1}
1051 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1052 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1053 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1054 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1056 set headctxmenu .headctxmenu
1057 menu $headctxmenu -tearoff 0
1058 $headctxmenu add command -label [mc "Check out this branch"] \
1059 -command cobranch
1060 $headctxmenu add command -label [mc "Remove this branch"] \
1061 -command rmbranch
1063 global flist_menu
1064 set flist_menu .flistctxmenu
1065 menu $flist_menu -tearoff 0
1066 $flist_menu add command -label [mc "Highlight this too"] \
1067 -command {flist_hl 0}
1068 $flist_menu add command -label [mc "Highlight this only"] \
1069 -command {flist_hl 1}
1072 # Windows sends all mouse wheel events to the current focused window, not
1073 # the one where the mouse hovers, so bind those events here and redirect
1074 # to the correct window
1075 proc windows_mousewheel_redirector {W X Y D} {
1076 global canv canv2 canv3
1077 set w [winfo containing -displayof $W $X $Y]
1078 if {$w ne ""} {
1079 set u [expr {$D < 0 ? 5 : -5}]
1080 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1081 allcanvs yview scroll $u units
1082 } else {
1083 catch {
1084 $w yview scroll $u units
1090 # mouse-2 makes all windows scan vertically, but only the one
1091 # the cursor is in scans horizontally
1092 proc canvscan {op w x y} {
1093 global canv canv2 canv3
1094 foreach c [list $canv $canv2 $canv3] {
1095 if {$c == $w} {
1096 $c scan $op $x $y
1097 } else {
1098 $c scan $op 0 $y
1103 proc scrollcanv {cscroll f0 f1} {
1104 $cscroll set $f0 $f1
1105 drawfrac $f0 $f1
1106 flushhighlights
1109 # when we make a key binding for the toplevel, make sure
1110 # it doesn't get triggered when that key is pressed in the
1111 # find string entry widget.
1112 proc bindkey {ev script} {
1113 global entries
1114 bind . $ev $script
1115 set escript [bind Entry $ev]
1116 if {$escript == {}} {
1117 set escript [bind Entry <Key>]
1119 foreach e $entries {
1120 bind $e $ev "$escript; break"
1124 # set the focus back to the toplevel for any click outside
1125 # the entry widgets
1126 proc click {w} {
1127 global ctext entries
1128 foreach e [concat $entries $ctext] {
1129 if {$w == $e} return
1131 focus .
1134 # Adjust the progress bar for a change in requested extent or canvas size
1135 proc adjustprogress {} {
1136 global progresscanv progressitem progresscoords
1137 global fprogitem fprogcoord lastprogupdate progupdatepending
1138 global rprogitem rprogcoord
1140 set w [expr {[winfo width $progresscanv] - 4}]
1141 set x0 [expr {$w * [lindex $progresscoords 0]}]
1142 set x1 [expr {$w * [lindex $progresscoords 1]}]
1143 set h [winfo height $progresscanv]
1144 $progresscanv coords $progressitem $x0 0 $x1 $h
1145 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1146 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1147 set now [clock clicks -milliseconds]
1148 if {$now >= $lastprogupdate + 100} {
1149 set progupdatepending 0
1150 update
1151 } elseif {!$progupdatepending} {
1152 set progupdatepending 1
1153 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1157 proc doprogupdate {} {
1158 global lastprogupdate progupdatepending
1160 if {$progupdatepending} {
1161 set progupdatepending 0
1162 set lastprogupdate [clock clicks -milliseconds]
1163 update
1167 proc savestuff {w} {
1168 global canv canv2 canv3 mainfont textfont uifont tabstop
1169 global stuffsaved findmergefiles maxgraphpct
1170 global maxwidth showneartags showlocalchanges
1171 global viewname viewfiles viewargs viewperm nextviewnum
1172 global cmitmode wrapcomment datetimeformat limitdiffs
1173 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1175 if {$stuffsaved} return
1176 if {![winfo viewable .]} return
1177 catch {
1178 set f [open "~/.gitk-new" w]
1179 puts $f [list set mainfont $mainfont]
1180 puts $f [list set textfont $textfont]
1181 puts $f [list set uifont $uifont]
1182 puts $f [list set tabstop $tabstop]
1183 puts $f [list set findmergefiles $findmergefiles]
1184 puts $f [list set maxgraphpct $maxgraphpct]
1185 puts $f [list set maxwidth $maxwidth]
1186 puts $f [list set cmitmode $cmitmode]
1187 puts $f [list set wrapcomment $wrapcomment]
1188 puts $f [list set showneartags $showneartags]
1189 puts $f [list set showlocalchanges $showlocalchanges]
1190 puts $f [list set datetimeformat $datetimeformat]
1191 puts $f [list set limitdiffs $limitdiffs]
1192 puts $f [list set bgcolor $bgcolor]
1193 puts $f [list set fgcolor $fgcolor]
1194 puts $f [list set colors $colors]
1195 puts $f [list set diffcolors $diffcolors]
1196 puts $f [list set diffcontext $diffcontext]
1197 puts $f [list set selectbgcolor $selectbgcolor]
1199 puts $f "set geometry(main) [wm geometry .]"
1200 puts $f "set geometry(topwidth) [winfo width .tf]"
1201 puts $f "set geometry(topheight) [winfo height .tf]"
1202 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1203 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1204 puts $f "set geometry(botwidth) [winfo width .bleft]"
1205 puts $f "set geometry(botheight) [winfo height .bleft]"
1207 puts -nonewline $f "set permviews {"
1208 for {set v 0} {$v < $nextviewnum} {incr v} {
1209 if {$viewperm($v)} {
1210 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1213 puts $f "}"
1214 close $f
1215 file rename -force "~/.gitk-new" "~/.gitk"
1217 set stuffsaved 1
1220 proc resizeclistpanes {win w} {
1221 global oldwidth
1222 if {[info exists oldwidth($win)]} {
1223 set s0 [$win sash coord 0]
1224 set s1 [$win sash coord 1]
1225 if {$w < 60} {
1226 set sash0 [expr {int($w/2 - 2)}]
1227 set sash1 [expr {int($w*5/6 - 2)}]
1228 } else {
1229 set factor [expr {1.0 * $w / $oldwidth($win)}]
1230 set sash0 [expr {int($factor * [lindex $s0 0])}]
1231 set sash1 [expr {int($factor * [lindex $s1 0])}]
1232 if {$sash0 < 30} {
1233 set sash0 30
1235 if {$sash1 < $sash0 + 20} {
1236 set sash1 [expr {$sash0 + 20}]
1238 if {$sash1 > $w - 10} {
1239 set sash1 [expr {$w - 10}]
1240 if {$sash0 > $sash1 - 20} {
1241 set sash0 [expr {$sash1 - 20}]
1245 $win sash place 0 $sash0 [lindex $s0 1]
1246 $win sash place 1 $sash1 [lindex $s1 1]
1248 set oldwidth($win) $w
1251 proc resizecdetpanes {win w} {
1252 global oldwidth
1253 if {[info exists oldwidth($win)]} {
1254 set s0 [$win sash coord 0]
1255 if {$w < 60} {
1256 set sash0 [expr {int($w*3/4 - 2)}]
1257 } else {
1258 set factor [expr {1.0 * $w / $oldwidth($win)}]
1259 set sash0 [expr {int($factor * [lindex $s0 0])}]
1260 if {$sash0 < 45} {
1261 set sash0 45
1263 if {$sash0 > $w - 15} {
1264 set sash0 [expr {$w - 15}]
1267 $win sash place 0 $sash0 [lindex $s0 1]
1269 set oldwidth($win) $w
1272 proc allcanvs args {
1273 global canv canv2 canv3
1274 eval $canv $args
1275 eval $canv2 $args
1276 eval $canv3 $args
1279 proc bindall {event action} {
1280 global canv canv2 canv3
1281 bind $canv $event $action
1282 bind $canv2 $event $action
1283 bind $canv3 $event $action
1286 proc about {} {
1287 global uifont
1288 set w .about
1289 if {[winfo exists $w]} {
1290 raise $w
1291 return
1293 toplevel $w
1294 wm title $w [mc "About gitk"]
1295 message $w.m -text [mc "
1296 Gitk - a commit viewer for git
1298 Copyright © 2005-2006 Paul Mackerras
1300 Use and redistribute under the terms of the GNU General Public License"] \
1301 -justify center -aspect 400 -border 2 -bg white -relief groove
1302 pack $w.m -side top -fill x -padx 2 -pady 2
1303 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1304 pack $w.ok -side bottom
1305 bind $w <Visibility> "focus $w.ok"
1306 bind $w <Key-Escape> "destroy $w"
1307 bind $w <Key-Return> "destroy $w"
1310 proc keys {} {
1311 set w .keys
1312 if {[winfo exists $w]} {
1313 raise $w
1314 return
1316 if {[tk windowingsystem] eq {aqua}} {
1317 set M1T Cmd
1318 } else {
1319 set M1T Ctrl
1321 toplevel $w
1322 wm title $w [mc "Gitk key bindings"]
1323 message $w.m -text "
1324 [mc "Gitk key bindings:"]
1326 [mc "<%s-Q> Quit" $M1T]
1327 [mc "<Home> Move to first commit"]
1328 [mc "<End> Move to last commit"]
1329 [mc "<Up>, p, i Move up one commit"]
1330 [mc "<Down>, n, k Move down one commit"]
1331 [mc "<Left>, z, j Go back in history list"]
1332 [mc "<Right>, x, l Go forward in history list"]
1333 [mc "<PageUp> Move up one page in commit list"]
1334 [mc "<PageDown> Move down one page in commit list"]
1335 [mc "<%s-Home> Scroll to top of commit list" $M1T]
1336 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
1337 [mc "<%s-Up> Scroll commit list up one line" $M1T]
1338 [mc "<%s-Down> Scroll commit list down one line" $M1T]
1339 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
1340 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
1341 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
1342 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
1343 [mc "<Delete>, b Scroll diff view up one page"]
1344 [mc "<Backspace> Scroll diff view up one page"]
1345 [mc "<Space> Scroll diff view down one page"]
1346 [mc "u Scroll diff view up 18 lines"]
1347 [mc "d Scroll diff view down 18 lines"]
1348 [mc "<%s-F> Find" $M1T]
1349 [mc "<%s-G> Move to next find hit" $M1T]
1350 [mc "<Return> Move to next find hit"]
1351 [mc "/ Move to next find hit, or redo find"]
1352 [mc "? Move to previous find hit"]
1353 [mc "f Scroll diff view to next file"]
1354 [mc "<%s-S> Search for next hit in diff view" $M1T]
1355 [mc "<%s-R> Search for previous hit in diff view" $M1T]
1356 [mc "<%s-KP+> Increase font size" $M1T]
1357 [mc "<%s-plus> Increase font size" $M1T]
1358 [mc "<%s-KP-> Decrease font size" $M1T]
1359 [mc "<%s-minus> Decrease font size" $M1T]
1360 [mc "<F5> Update"]
1362 -justify left -bg white -border 2 -relief groove
1363 pack $w.m -side top -fill both -padx 2 -pady 2
1364 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1365 pack $w.ok -side bottom
1366 bind $w <Visibility> "focus $w.ok"
1367 bind $w <Key-Escape> "destroy $w"
1368 bind $w <Key-Return> "destroy $w"
1371 # Procedures for manipulating the file list window at the
1372 # bottom right of the overall window.
1374 proc treeview {w l openlevs} {
1375 global treecontents treediropen treeheight treeparent treeindex
1377 set ix 0
1378 set treeindex() 0
1379 set lev 0
1380 set prefix {}
1381 set prefixend -1
1382 set prefendstack {}
1383 set htstack {}
1384 set ht 0
1385 set treecontents() {}
1386 $w conf -state normal
1387 foreach f $l {
1388 while {[string range $f 0 $prefixend] ne $prefix} {
1389 if {$lev <= $openlevs} {
1390 $w mark set e:$treeindex($prefix) "end -1c"
1391 $w mark gravity e:$treeindex($prefix) left
1393 set treeheight($prefix) $ht
1394 incr ht [lindex $htstack end]
1395 set htstack [lreplace $htstack end end]
1396 set prefixend [lindex $prefendstack end]
1397 set prefendstack [lreplace $prefendstack end end]
1398 set prefix [string range $prefix 0 $prefixend]
1399 incr lev -1
1401 set tail [string range $f [expr {$prefixend+1}] end]
1402 while {[set slash [string first "/" $tail]] >= 0} {
1403 lappend htstack $ht
1404 set ht 0
1405 lappend prefendstack $prefixend
1406 incr prefixend [expr {$slash + 1}]
1407 set d [string range $tail 0 $slash]
1408 lappend treecontents($prefix) $d
1409 set oldprefix $prefix
1410 append prefix $d
1411 set treecontents($prefix) {}
1412 set treeindex($prefix) [incr ix]
1413 set treeparent($prefix) $oldprefix
1414 set tail [string range $tail [expr {$slash+1}] end]
1415 if {$lev <= $openlevs} {
1416 set ht 1
1417 set treediropen($prefix) [expr {$lev < $openlevs}]
1418 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1419 $w mark set d:$ix "end -1c"
1420 $w mark gravity d:$ix left
1421 set str "\n"
1422 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1423 $w insert end $str
1424 $w image create end -align center -image $bm -padx 1 \
1425 -name a:$ix
1426 $w insert end $d [highlight_tag $prefix]
1427 $w mark set s:$ix "end -1c"
1428 $w mark gravity s:$ix left
1430 incr lev
1432 if {$tail ne {}} {
1433 if {$lev <= $openlevs} {
1434 incr ht
1435 set str "\n"
1436 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1437 $w insert end $str
1438 $w insert end $tail [highlight_tag $f]
1440 lappend treecontents($prefix) $tail
1443 while {$htstack ne {}} {
1444 set treeheight($prefix) $ht
1445 incr ht [lindex $htstack end]
1446 set htstack [lreplace $htstack end end]
1447 set prefixend [lindex $prefendstack end]
1448 set prefendstack [lreplace $prefendstack end end]
1449 set prefix [string range $prefix 0 $prefixend]
1451 $w conf -state disabled
1454 proc linetoelt {l} {
1455 global treeheight treecontents
1457 set y 2
1458 set prefix {}
1459 while {1} {
1460 foreach e $treecontents($prefix) {
1461 if {$y == $l} {
1462 return "$prefix$e"
1464 set n 1
1465 if {[string index $e end] eq "/"} {
1466 set n $treeheight($prefix$e)
1467 if {$y + $n > $l} {
1468 append prefix $e
1469 incr y
1470 break
1473 incr y $n
1478 proc highlight_tree {y prefix} {
1479 global treeheight treecontents cflist
1481 foreach e $treecontents($prefix) {
1482 set path $prefix$e
1483 if {[highlight_tag $path] ne {}} {
1484 $cflist tag add bold $y.0 "$y.0 lineend"
1486 incr y
1487 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1488 set y [highlight_tree $y $path]
1491 return $y
1494 proc treeclosedir {w dir} {
1495 global treediropen treeheight treeparent treeindex
1497 set ix $treeindex($dir)
1498 $w conf -state normal
1499 $w delete s:$ix e:$ix
1500 set treediropen($dir) 0
1501 $w image configure a:$ix -image tri-rt
1502 $w conf -state disabled
1503 set n [expr {1 - $treeheight($dir)}]
1504 while {$dir ne {}} {
1505 incr treeheight($dir) $n
1506 set dir $treeparent($dir)
1510 proc treeopendir {w dir} {
1511 global treediropen treeheight treeparent treecontents treeindex
1513 set ix $treeindex($dir)
1514 $w conf -state normal
1515 $w image configure a:$ix -image tri-dn
1516 $w mark set e:$ix s:$ix
1517 $w mark gravity e:$ix right
1518 set lev 0
1519 set str "\n"
1520 set n [llength $treecontents($dir)]
1521 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1522 incr lev
1523 append str "\t"
1524 incr treeheight($x) $n
1526 foreach e $treecontents($dir) {
1527 set de $dir$e
1528 if {[string index $e end] eq "/"} {
1529 set iy $treeindex($de)
1530 $w mark set d:$iy e:$ix
1531 $w mark gravity d:$iy left
1532 $w insert e:$ix $str
1533 set treediropen($de) 0
1534 $w image create e:$ix -align center -image tri-rt -padx 1 \
1535 -name a:$iy
1536 $w insert e:$ix $e [highlight_tag $de]
1537 $w mark set s:$iy e:$ix
1538 $w mark gravity s:$iy left
1539 set treeheight($de) 1
1540 } else {
1541 $w insert e:$ix $str
1542 $w insert e:$ix $e [highlight_tag $de]
1545 $w mark gravity e:$ix left
1546 $w conf -state disabled
1547 set treediropen($dir) 1
1548 set top [lindex [split [$w index @0,0] .] 0]
1549 set ht [$w cget -height]
1550 set l [lindex [split [$w index s:$ix] .] 0]
1551 if {$l < $top} {
1552 $w yview $l.0
1553 } elseif {$l + $n + 1 > $top + $ht} {
1554 set top [expr {$l + $n + 2 - $ht}]
1555 if {$l < $top} {
1556 set top $l
1558 $w yview $top.0
1562 proc treeclick {w x y} {
1563 global treediropen cmitmode ctext cflist cflist_top
1565 if {$cmitmode ne "tree"} return
1566 if {![info exists cflist_top]} return
1567 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1568 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1569 $cflist tag add highlight $l.0 "$l.0 lineend"
1570 set cflist_top $l
1571 if {$l == 1} {
1572 $ctext yview 1.0
1573 return
1575 set e [linetoelt $l]
1576 if {[string index $e end] ne "/"} {
1577 showfile $e
1578 } elseif {$treediropen($e)} {
1579 treeclosedir $w $e
1580 } else {
1581 treeopendir $w $e
1585 proc setfilelist {id} {
1586 global treefilelist cflist
1588 treeview $cflist $treefilelist($id) 0
1591 image create bitmap tri-rt -background black -foreground blue -data {
1592 #define tri-rt_width 13
1593 #define tri-rt_height 13
1594 static unsigned char tri-rt_bits[] = {
1595 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1596 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1597 0x00, 0x00};
1598 } -maskdata {
1599 #define tri-rt-mask_width 13
1600 #define tri-rt-mask_height 13
1601 static unsigned char tri-rt-mask_bits[] = {
1602 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1603 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1604 0x08, 0x00};
1606 image create bitmap tri-dn -background black -foreground blue -data {
1607 #define tri-dn_width 13
1608 #define tri-dn_height 13
1609 static unsigned char tri-dn_bits[] = {
1610 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1611 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1612 0x00, 0x00};
1613 } -maskdata {
1614 #define tri-dn-mask_width 13
1615 #define tri-dn-mask_height 13
1616 static unsigned char tri-dn-mask_bits[] = {
1617 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1618 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1619 0x00, 0x00};
1622 image create bitmap reficon-T -background black -foreground yellow -data {
1623 #define tagicon_width 13
1624 #define tagicon_height 9
1625 static unsigned char tagicon_bits[] = {
1626 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1627 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1628 } -maskdata {
1629 #define tagicon-mask_width 13
1630 #define tagicon-mask_height 9
1631 static unsigned char tagicon-mask_bits[] = {
1632 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1633 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1635 set rectdata {
1636 #define headicon_width 13
1637 #define headicon_height 9
1638 static unsigned char headicon_bits[] = {
1639 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1640 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1642 set rectmask {
1643 #define headicon-mask_width 13
1644 #define headicon-mask_height 9
1645 static unsigned char headicon-mask_bits[] = {
1646 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1647 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1649 image create bitmap reficon-H -background black -foreground green \
1650 -data $rectdata -maskdata $rectmask
1651 image create bitmap reficon-o -background black -foreground "#ddddff" \
1652 -data $rectdata -maskdata $rectmask
1654 proc init_flist {first} {
1655 global cflist cflist_top selectedline difffilestart
1657 $cflist conf -state normal
1658 $cflist delete 0.0 end
1659 if {$first ne {}} {
1660 $cflist insert end $first
1661 set cflist_top 1
1662 $cflist tag add highlight 1.0 "1.0 lineend"
1663 } else {
1664 catch {unset cflist_top}
1666 $cflist conf -state disabled
1667 set difffilestart {}
1670 proc highlight_tag {f} {
1671 global highlight_paths
1673 foreach p $highlight_paths {
1674 if {[string match $p $f]} {
1675 return "bold"
1678 return {}
1681 proc highlight_filelist {} {
1682 global cmitmode cflist
1684 $cflist conf -state normal
1685 if {$cmitmode ne "tree"} {
1686 set end [lindex [split [$cflist index end] .] 0]
1687 for {set l 2} {$l < $end} {incr l} {
1688 set line [$cflist get $l.0 "$l.0 lineend"]
1689 if {[highlight_tag $line] ne {}} {
1690 $cflist tag add bold $l.0 "$l.0 lineend"
1693 } else {
1694 highlight_tree 2 {}
1696 $cflist conf -state disabled
1699 proc unhighlight_filelist {} {
1700 global cflist
1702 $cflist conf -state normal
1703 $cflist tag remove bold 1.0 end
1704 $cflist conf -state disabled
1707 proc add_flist {fl} {
1708 global cflist
1710 $cflist conf -state normal
1711 foreach f $fl {
1712 $cflist insert end "\n"
1713 $cflist insert end $f [highlight_tag $f]
1715 $cflist conf -state disabled
1718 proc sel_flist {w x y} {
1719 global ctext difffilestart cflist cflist_top cmitmode
1721 if {$cmitmode eq "tree"} return
1722 if {![info exists cflist_top]} return
1723 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1724 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1725 $cflist tag add highlight $l.0 "$l.0 lineend"
1726 set cflist_top $l
1727 if {$l == 1} {
1728 $ctext yview 1.0
1729 } else {
1730 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1734 proc pop_flist_menu {w X Y x y} {
1735 global ctext cflist cmitmode flist_menu flist_menu_file
1736 global treediffs diffids
1738 stopfinding
1739 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1740 if {$l <= 1} return
1741 if {$cmitmode eq "tree"} {
1742 set e [linetoelt $l]
1743 if {[string index $e end] eq "/"} return
1744 } else {
1745 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1747 set flist_menu_file $e
1748 tk_popup $flist_menu $X $Y
1751 proc flist_hl {only} {
1752 global flist_menu_file findstring gdttype
1754 set x [shellquote $flist_menu_file]
1755 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1756 set findstring $x
1757 } else {
1758 append findstring " " $x
1760 set gdttype [mc "touching paths:"]
1763 # Functions for adding and removing shell-type quoting
1765 proc shellquote {str} {
1766 if {![string match "*\['\"\\ \t]*" $str]} {
1767 return $str
1769 if {![string match "*\['\"\\]*" $str]} {
1770 return "\"$str\""
1772 if {![string match "*'*" $str]} {
1773 return "'$str'"
1775 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1778 proc shellarglist {l} {
1779 set str {}
1780 foreach a $l {
1781 if {$str ne {}} {
1782 append str " "
1784 append str [shellquote $a]
1786 return $str
1789 proc shelldequote {str} {
1790 set ret {}
1791 set used -1
1792 while {1} {
1793 incr used
1794 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1795 append ret [string range $str $used end]
1796 set used [string length $str]
1797 break
1799 set first [lindex $first 0]
1800 set ch [string index $str $first]
1801 if {$first > $used} {
1802 append ret [string range $str $used [expr {$first - 1}]]
1803 set used $first
1805 if {$ch eq " " || $ch eq "\t"} break
1806 incr used
1807 if {$ch eq "'"} {
1808 set first [string first "'" $str $used]
1809 if {$first < 0} {
1810 error "unmatched single-quote"
1812 append ret [string range $str $used [expr {$first - 1}]]
1813 set used $first
1814 continue
1816 if {$ch eq "\\"} {
1817 if {$used >= [string length $str]} {
1818 error "trailing backslash"
1820 append ret [string index $str $used]
1821 continue
1823 # here ch == "\""
1824 while {1} {
1825 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1826 error "unmatched double-quote"
1828 set first [lindex $first 0]
1829 set ch [string index $str $first]
1830 if {$first > $used} {
1831 append ret [string range $str $used [expr {$first - 1}]]
1832 set used $first
1834 if {$ch eq "\""} break
1835 incr used
1836 append ret [string index $str $used]
1837 incr used
1840 return [list $used $ret]
1843 proc shellsplit {str} {
1844 set l {}
1845 while {1} {
1846 set str [string trimleft $str]
1847 if {$str eq {}} break
1848 set dq [shelldequote $str]
1849 set n [lindex $dq 0]
1850 set word [lindex $dq 1]
1851 set str [string range $str $n end]
1852 lappend l $word
1854 return $l
1857 # Code to implement multiple views
1859 proc newview {ishighlight} {
1860 global nextviewnum newviewname newviewperm newishighlight
1861 global newviewargs revtreeargs
1863 set newishighlight $ishighlight
1864 set top .gitkview
1865 if {[winfo exists $top]} {
1866 raise $top
1867 return
1869 set newviewname($nextviewnum) "View $nextviewnum"
1870 set newviewperm($nextviewnum) 0
1871 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1872 vieweditor $top $nextviewnum [mc "Gitk view definition"]
1875 proc editview {} {
1876 global curview
1877 global viewname viewperm newviewname newviewperm
1878 global viewargs newviewargs
1880 set top .gitkvedit-$curview
1881 if {[winfo exists $top]} {
1882 raise $top
1883 return
1885 set newviewname($curview) $viewname($curview)
1886 set newviewperm($curview) $viewperm($curview)
1887 set newviewargs($curview) [shellarglist $viewargs($curview)]
1888 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1891 proc vieweditor {top n title} {
1892 global newviewname newviewperm viewfiles bgcolor
1894 toplevel $top
1895 wm title $top $title
1896 label $top.nl -text [mc "Name"]
1897 entry $top.name -width 20 -textvariable newviewname($n)
1898 grid $top.nl $top.name -sticky w -pady 5
1899 checkbutton $top.perm -text [mc "Remember this view"] \
1900 -variable newviewperm($n)
1901 grid $top.perm - -pady 5 -sticky w
1902 message $top.al -aspect 1000 \
1903 -text [mc "Commits to include (arguments to git rev-list):"]
1904 grid $top.al - -sticky w -pady 5
1905 entry $top.args -width 50 -textvariable newviewargs($n) \
1906 -background $bgcolor
1907 grid $top.args - -sticky ew -padx 5
1908 message $top.l -aspect 1000 \
1909 -text [mc "Enter files and directories to include, one per line:"]
1910 grid $top.l - -sticky w
1911 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1912 if {[info exists viewfiles($n)]} {
1913 foreach f $viewfiles($n) {
1914 $top.t insert end $f
1915 $top.t insert end "\n"
1917 $top.t delete {end - 1c} end
1918 $top.t mark set insert 0.0
1920 grid $top.t - -sticky ew -padx 5
1921 frame $top.buts
1922 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1923 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1924 grid $top.buts.ok $top.buts.can
1925 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1926 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1927 grid $top.buts - -pady 10 -sticky ew
1928 focus $top.t
1931 proc doviewmenu {m first cmd op argv} {
1932 set nmenu [$m index end]
1933 for {set i $first} {$i <= $nmenu} {incr i} {
1934 if {[$m entrycget $i -command] eq $cmd} {
1935 eval $m $op $i $argv
1936 break
1941 proc allviewmenus {n op args} {
1942 # global viewhlmenu
1944 doviewmenu .bar.view 5 [list showview $n] $op $args
1945 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1948 proc newviewok {top n} {
1949 global nextviewnum newviewperm newviewname newishighlight
1950 global viewname viewfiles viewperm selectedview curview
1951 global viewargs newviewargs viewhlmenu
1953 if {[catch {
1954 set newargs [shellsplit $newviewargs($n)]
1955 } err]} {
1956 error_popup "[mc "Error in commit selection arguments:"] $err"
1957 wm raise $top
1958 focus $top
1959 return
1961 set files {}
1962 foreach f [split [$top.t get 0.0 end] "\n"] {
1963 set ft [string trim $f]
1964 if {$ft ne {}} {
1965 lappend files $ft
1968 if {![info exists viewfiles($n)]} {
1969 # creating a new view
1970 incr nextviewnum
1971 set viewname($n) $newviewname($n)
1972 set viewperm($n) $newviewperm($n)
1973 set viewfiles($n) $files
1974 set viewargs($n) $newargs
1975 addviewmenu $n
1976 if {!$newishighlight} {
1977 run showview $n
1978 } else {
1979 run addvhighlight $n
1981 } else {
1982 # editing an existing view
1983 set viewperm($n) $newviewperm($n)
1984 if {$newviewname($n) ne $viewname($n)} {
1985 set viewname($n) $newviewname($n)
1986 doviewmenu .bar.view 5 [list showview $n] \
1987 entryconf [list -label $viewname($n)]
1988 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1989 # entryconf [list -label $viewname($n) -value $viewname($n)]
1991 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1992 set viewfiles($n) $files
1993 set viewargs($n) $newargs
1994 if {$curview == $n} {
1995 run updatecommits
1999 catch {destroy $top}
2002 proc delview {} {
2003 global curview viewdata viewperm hlview selectedhlview
2005 if {$curview == 0} return
2006 if {[info exists hlview] && $hlview == $curview} {
2007 set selectedhlview [mc "None"]
2008 unset hlview
2010 allviewmenus $curview delete
2011 set viewdata($curview) {}
2012 set viewperm($curview) 0
2013 showview 0
2016 proc addviewmenu {n} {
2017 global viewname viewhlmenu
2019 .bar.view add radiobutton -label $viewname($n) \
2020 -command [list showview $n] -variable selectedview -value $n
2021 #$viewhlmenu add radiobutton -label $viewname($n) \
2022 # -command [list addvhighlight $n] -variable selectedhlview
2025 proc flatten {var} {
2026 global $var
2028 set ret {}
2029 foreach i [array names $var] {
2030 lappend ret $i [set $var\($i\)]
2032 return $ret
2035 proc unflatten {var l} {
2036 global $var
2038 catch {unset $var}
2039 foreach {i v} $l {
2040 set $var\($i\) $v
2044 proc showview {n} {
2045 global curview viewdata viewfiles
2046 global displayorder parentlist rowidlist rowisopt rowfinal
2047 global colormap rowtextx commitrow nextcolor canvxmax
2048 global numcommits commitlisted
2049 global selectedline currentid canv canvy0
2050 global treediffs
2051 global pending_select phase
2052 global commitidx
2053 global commfd
2054 global selectedview selectfirst
2055 global vparentlist vdisporder vcmitlisted
2056 global hlview selectedhlview commitinterest
2058 if {$n == $curview} return
2059 set selid {}
2060 if {[info exists selectedline]} {
2061 set selid $currentid
2062 set y [yc $selectedline]
2063 set ymax [lindex [$canv cget -scrollregion] 3]
2064 set span [$canv yview]
2065 set ytop [expr {[lindex $span 0] * $ymax}]
2066 set ybot [expr {[lindex $span 1] * $ymax}]
2067 if {$ytop < $y && $y < $ybot} {
2068 set yscreen [expr {$y - $ytop}]
2069 } else {
2070 set yscreen [expr {($ybot - $ytop) / 2}]
2072 } elseif {[info exists pending_select]} {
2073 set selid $pending_select
2074 unset pending_select
2076 unselectline
2077 normalline
2078 if {$curview >= 0} {
2079 set vparentlist($curview) $parentlist
2080 set vdisporder($curview) $displayorder
2081 set vcmitlisted($curview) $commitlisted
2082 if {$phase ne {} ||
2083 ![info exists viewdata($curview)] ||
2084 [lindex $viewdata($curview) 0] ne {}} {
2085 set viewdata($curview) \
2086 [list $phase $rowidlist $rowisopt $rowfinal]
2089 catch {unset treediffs}
2090 clear_display
2091 if {[info exists hlview] && $hlview == $n} {
2092 unset hlview
2093 set selectedhlview [mc "None"]
2095 catch {unset commitinterest}
2097 set curview $n
2098 set selectedview $n
2099 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2100 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2102 run refill_reflist
2103 if {![info exists viewdata($n)]} {
2104 if {$selid ne {}} {
2105 set pending_select $selid
2107 getcommits
2108 return
2111 set v $viewdata($n)
2112 set phase [lindex $v 0]
2113 set displayorder $vdisporder($n)
2114 set parentlist $vparentlist($n)
2115 set commitlisted $vcmitlisted($n)
2116 set rowidlist [lindex $v 1]
2117 set rowisopt [lindex $v 2]
2118 set rowfinal [lindex $v 3]
2119 set numcommits $commitidx($n)
2121 catch {unset colormap}
2122 catch {unset rowtextx}
2123 set nextcolor 0
2124 set canvxmax [$canv cget -width]
2125 set curview $n
2126 set row 0
2127 setcanvscroll
2128 set yf 0
2129 set row {}
2130 set selectfirst 0
2131 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2132 set row $commitrow($n,$selid)
2133 # try to get the selected row in the same position on the screen
2134 set ymax [lindex [$canv cget -scrollregion] 3]
2135 set ytop [expr {[yc $row] - $yscreen}]
2136 if {$ytop < 0} {
2137 set ytop 0
2139 set yf [expr {$ytop * 1.0 / $ymax}]
2141 allcanvs yview moveto $yf
2142 drawvisible
2143 if {$row ne {}} {
2144 selectline $row 0
2145 } elseif {$selid ne {}} {
2146 set pending_select $selid
2147 } else {
2148 set row [first_real_row]
2149 if {$row < $numcommits} {
2150 selectline $row 0
2151 } else {
2152 set selectfirst 1
2155 if {$phase ne {}} {
2156 if {$phase eq "getcommits"} {
2157 show_status [mc "Reading commits..."]
2159 run chewcommits $n
2160 } elseif {$numcommits == 0} {
2161 show_status [mc "No commits selected"]
2165 # Stuff relating to the highlighting facility
2167 proc ishighlighted {row} {
2168 global vhighlights fhighlights nhighlights rhighlights
2170 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2171 return $nhighlights($row)
2173 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2174 return $vhighlights($row)
2176 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2177 return $fhighlights($row)
2179 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2180 return $rhighlights($row)
2182 return 0
2185 proc bolden {row font} {
2186 global canv linehtag selectedline boldrows
2188 lappend boldrows $row
2189 $canv itemconf $linehtag($row) -font $font
2190 if {[info exists selectedline] && $row == $selectedline} {
2191 $canv delete secsel
2192 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2193 -outline {{}} -tags secsel \
2194 -fill [$canv cget -selectbackground]]
2195 $canv lower $t
2199 proc bolden_name {row font} {
2200 global canv2 linentag selectedline boldnamerows
2202 lappend boldnamerows $row
2203 $canv2 itemconf $linentag($row) -font $font
2204 if {[info exists selectedline] && $row == $selectedline} {
2205 $canv2 delete secsel
2206 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2207 -outline {{}} -tags secsel \
2208 -fill [$canv2 cget -selectbackground]]
2209 $canv2 lower $t
2213 proc unbolden {} {
2214 global boldrows
2216 set stillbold {}
2217 foreach row $boldrows {
2218 if {![ishighlighted $row]} {
2219 bolden $row mainfont
2220 } else {
2221 lappend stillbold $row
2224 set boldrows $stillbold
2227 proc addvhighlight {n} {
2228 global hlview curview viewdata vhl_done vhighlights commitidx
2230 if {[info exists hlview]} {
2231 delvhighlight
2233 set hlview $n
2234 if {$n != $curview && ![info exists viewdata($n)]} {
2235 set viewdata($n) [list getcommits {{}} 0 0 0]
2236 set vparentlist($n) {}
2237 set vdisporder($n) {}
2238 set vcmitlisted($n) {}
2239 start_rev_list $n
2241 set vhl_done $commitidx($hlview)
2242 if {$vhl_done > 0} {
2243 drawvisible
2247 proc delvhighlight {} {
2248 global hlview vhighlights
2250 if {![info exists hlview]} return
2251 unset hlview
2252 catch {unset vhighlights}
2253 unbolden
2256 proc vhighlightmore {} {
2257 global hlview vhl_done commitidx vhighlights
2258 global displayorder vdisporder curview
2260 set max $commitidx($hlview)
2261 if {$hlview == $curview} {
2262 set disp $displayorder
2263 } else {
2264 set disp $vdisporder($hlview)
2266 set vr [visiblerows]
2267 set r0 [lindex $vr 0]
2268 set r1 [lindex $vr 1]
2269 for {set i $vhl_done} {$i < $max} {incr i} {
2270 set id [lindex $disp $i]
2271 if {[info exists commitrow($curview,$id)]} {
2272 set row $commitrow($curview,$id)
2273 if {$r0 <= $row && $row <= $r1} {
2274 if {![highlighted $row]} {
2275 bolden $row mainfontbold
2277 set vhighlights($row) 1
2281 set vhl_done $max
2284 proc askvhighlight {row id} {
2285 global hlview vhighlights commitrow iddrawn
2287 if {[info exists commitrow($hlview,$id)]} {
2288 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2289 bolden $row mainfontbold
2291 set vhighlights($row) 1
2292 } else {
2293 set vhighlights($row) 0
2297 proc hfiles_change {} {
2298 global highlight_files filehighlight fhighlights fh_serial
2299 global highlight_paths gdttype
2301 if {[info exists filehighlight]} {
2302 # delete previous highlights
2303 catch {close $filehighlight}
2304 unset filehighlight
2305 catch {unset fhighlights}
2306 unbolden
2307 unhighlight_filelist
2309 set highlight_paths {}
2310 after cancel do_file_hl $fh_serial
2311 incr fh_serial
2312 if {$highlight_files ne {}} {
2313 after 300 do_file_hl $fh_serial
2317 proc gdttype_change {name ix op} {
2318 global gdttype highlight_files findstring findpattern
2320 stopfinding
2321 if {$findstring ne {}} {
2322 if {$gdttype eq [mc "containing:"]} {
2323 if {$highlight_files ne {}} {
2324 set highlight_files {}
2325 hfiles_change
2327 findcom_change
2328 } else {
2329 if {$findpattern ne {}} {
2330 set findpattern {}
2331 findcom_change
2333 set highlight_files $findstring
2334 hfiles_change
2336 drawvisible
2338 # enable/disable findtype/findloc menus too
2341 proc find_change {name ix op} {
2342 global gdttype findstring highlight_files
2344 stopfinding
2345 if {$gdttype eq [mc "containing:"]} {
2346 findcom_change
2347 } else {
2348 if {$highlight_files ne $findstring} {
2349 set highlight_files $findstring
2350 hfiles_change
2353 drawvisible
2356 proc findcom_change args {
2357 global nhighlights boldnamerows
2358 global findpattern findtype findstring gdttype
2360 stopfinding
2361 # delete previous highlights, if any
2362 foreach row $boldnamerows {
2363 bolden_name $row mainfont
2365 set boldnamerows {}
2366 catch {unset nhighlights}
2367 unbolden
2368 unmarkmatches
2369 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2370 set findpattern {}
2371 } elseif {$findtype eq [mc "Regexp"]} {
2372 set findpattern $findstring
2373 } else {
2374 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2375 $findstring]
2376 set findpattern "*$e*"
2380 proc makepatterns {l} {
2381 set ret {}
2382 foreach e $l {
2383 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2384 if {[string index $ee end] eq "/"} {
2385 lappend ret "$ee*"
2386 } else {
2387 lappend ret $ee
2388 lappend ret "$ee/*"
2391 return $ret
2394 proc do_file_hl {serial} {
2395 global highlight_files filehighlight highlight_paths gdttype fhl_list
2397 if {$gdttype eq [mc "touching paths:"]} {
2398 if {[catch {set paths [shellsplit $highlight_files]}]} return
2399 set highlight_paths [makepatterns $paths]
2400 highlight_filelist
2401 set gdtargs [concat -- $paths]
2402 } elseif {$gdttype eq [mc "adding/removing string:"]} {
2403 set gdtargs [list "-S$highlight_files"]
2404 } else {
2405 # must be "containing:", i.e. we're searching commit info
2406 return
2408 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2409 set filehighlight [open $cmd r+]
2410 fconfigure $filehighlight -blocking 0
2411 filerun $filehighlight readfhighlight
2412 set fhl_list {}
2413 drawvisible
2414 flushhighlights
2417 proc flushhighlights {} {
2418 global filehighlight fhl_list
2420 if {[info exists filehighlight]} {
2421 lappend fhl_list {}
2422 puts $filehighlight ""
2423 flush $filehighlight
2427 proc askfilehighlight {row id} {
2428 global filehighlight fhighlights fhl_list
2430 lappend fhl_list $id
2431 set fhighlights($row) -1
2432 puts $filehighlight $id
2435 proc readfhighlight {} {
2436 global filehighlight fhighlights commitrow curview iddrawn
2437 global fhl_list find_dirn
2439 if {![info exists filehighlight]} {
2440 return 0
2442 set nr 0
2443 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2444 set line [string trim $line]
2445 set i [lsearch -exact $fhl_list $line]
2446 if {$i < 0} continue
2447 for {set j 0} {$j < $i} {incr j} {
2448 set id [lindex $fhl_list $j]
2449 if {[info exists commitrow($curview,$id)]} {
2450 set fhighlights($commitrow($curview,$id)) 0
2453 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2454 if {$line eq {}} continue
2455 if {![info exists commitrow($curview,$line)]} continue
2456 set row $commitrow($curview,$line)
2457 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2458 bolden $row mainfontbold
2460 set fhighlights($row) 1
2462 if {[eof $filehighlight]} {
2463 # strange...
2464 puts "oops, git diff-tree died"
2465 catch {close $filehighlight}
2466 unset filehighlight
2467 return 0
2469 if {[info exists find_dirn]} {
2470 run findmore
2472 return 1
2475 proc doesmatch {f} {
2476 global findtype findpattern
2478 if {$findtype eq [mc "Regexp"]} {
2479 return [regexp $findpattern $f]
2480 } elseif {$findtype eq [mc "IgnCase"]} {
2481 return [string match -nocase $findpattern $f]
2482 } else {
2483 return [string match $findpattern $f]
2487 proc askfindhighlight {row id} {
2488 global nhighlights commitinfo iddrawn
2489 global findloc
2490 global markingmatches
2492 if {![info exists commitinfo($id)]} {
2493 getcommit $id
2495 set info $commitinfo($id)
2496 set isbold 0
2497 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2498 foreach f $info ty $fldtypes {
2499 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2500 [doesmatch $f]} {
2501 if {$ty eq [mc "Author"]} {
2502 set isbold 2
2503 break
2505 set isbold 1
2508 if {$isbold && [info exists iddrawn($id)]} {
2509 if {![ishighlighted $row]} {
2510 bolden $row mainfontbold
2511 if {$isbold > 1} {
2512 bolden_name $row mainfontbold
2515 if {$markingmatches} {
2516 markrowmatches $row $id
2519 set nhighlights($row) $isbold
2522 proc markrowmatches {row id} {
2523 global canv canv2 linehtag linentag commitinfo findloc
2525 set headline [lindex $commitinfo($id) 0]
2526 set author [lindex $commitinfo($id) 1]
2527 $canv delete match$row
2528 $canv2 delete match$row
2529 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2530 set m [findmatches $headline]
2531 if {$m ne {}} {
2532 markmatches $canv $row $headline $linehtag($row) $m \
2533 [$canv itemcget $linehtag($row) -font] $row
2536 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2537 set m [findmatches $author]
2538 if {$m ne {}} {
2539 markmatches $canv2 $row $author $linentag($row) $m \
2540 [$canv2 itemcget $linentag($row) -font] $row
2545 proc vrel_change {name ix op} {
2546 global highlight_related
2548 rhighlight_none
2549 if {$highlight_related ne [mc "None"]} {
2550 run drawvisible
2554 # prepare for testing whether commits are descendents or ancestors of a
2555 proc rhighlight_sel {a} {
2556 global descendent desc_todo ancestor anc_todo
2557 global highlight_related rhighlights
2559 catch {unset descendent}
2560 set desc_todo [list $a]
2561 catch {unset ancestor}
2562 set anc_todo [list $a]
2563 if {$highlight_related ne [mc "None"]} {
2564 rhighlight_none
2565 run drawvisible
2569 proc rhighlight_none {} {
2570 global rhighlights
2572 catch {unset rhighlights}
2573 unbolden
2576 proc is_descendent {a} {
2577 global curview children commitrow descendent desc_todo
2579 set v $curview
2580 set la $commitrow($v,$a)
2581 set todo $desc_todo
2582 set leftover {}
2583 set done 0
2584 for {set i 0} {$i < [llength $todo]} {incr i} {
2585 set do [lindex $todo $i]
2586 if {$commitrow($v,$do) < $la} {
2587 lappend leftover $do
2588 continue
2590 foreach nk $children($v,$do) {
2591 if {![info exists descendent($nk)]} {
2592 set descendent($nk) 1
2593 lappend todo $nk
2594 if {$nk eq $a} {
2595 set done 1
2599 if {$done} {
2600 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2601 return
2604 set descendent($a) 0
2605 set desc_todo $leftover
2608 proc is_ancestor {a} {
2609 global curview parentlist commitrow ancestor anc_todo
2611 set v $curview
2612 set la $commitrow($v,$a)
2613 set todo $anc_todo
2614 set leftover {}
2615 set done 0
2616 for {set i 0} {$i < [llength $todo]} {incr i} {
2617 set do [lindex $todo $i]
2618 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2619 lappend leftover $do
2620 continue
2622 foreach np [lindex $parentlist $commitrow($v,$do)] {
2623 if {![info exists ancestor($np)]} {
2624 set ancestor($np) 1
2625 lappend todo $np
2626 if {$np eq $a} {
2627 set done 1
2631 if {$done} {
2632 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2633 return
2636 set ancestor($a) 0
2637 set anc_todo $leftover
2640 proc askrelhighlight {row id} {
2641 global descendent highlight_related iddrawn rhighlights
2642 global selectedline ancestor
2644 if {![info exists selectedline]} return
2645 set isbold 0
2646 if {$highlight_related eq [mc "Descendant"] ||
2647 $highlight_related eq [mc "Not descendant"]} {
2648 if {![info exists descendent($id)]} {
2649 is_descendent $id
2651 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2652 set isbold 1
2654 } elseif {$highlight_related eq [mc "Ancestor"] ||
2655 $highlight_related eq [mc "Not ancestor"]} {
2656 if {![info exists ancestor($id)]} {
2657 is_ancestor $id
2659 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2660 set isbold 1
2663 if {[info exists iddrawn($id)]} {
2664 if {$isbold && ![ishighlighted $row]} {
2665 bolden $row mainfontbold
2668 set rhighlights($row) $isbold
2671 # Graph layout functions
2673 proc shortids {ids} {
2674 set res {}
2675 foreach id $ids {
2676 if {[llength $id] > 1} {
2677 lappend res [shortids $id]
2678 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2679 lappend res [string range $id 0 7]
2680 } else {
2681 lappend res $id
2684 return $res
2687 proc ntimes {n o} {
2688 set ret {}
2689 set o [list $o]
2690 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2691 if {($n & $mask) != 0} {
2692 set ret [concat $ret $o]
2694 set o [concat $o $o]
2696 return $ret
2699 # Work out where id should go in idlist so that order-token
2700 # values increase from left to right
2701 proc idcol {idlist id {i 0}} {
2702 global ordertok curview
2704 set t $ordertok($curview,$id)
2705 if {$i >= [llength $idlist] ||
2706 $t < $ordertok($curview,[lindex $idlist $i])} {
2707 if {$i > [llength $idlist]} {
2708 set i [llength $idlist]
2710 while {[incr i -1] >= 0 &&
2711 $t < $ordertok($curview,[lindex $idlist $i])} {}
2712 incr i
2713 } else {
2714 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2715 while {[incr i] < [llength $idlist] &&
2716 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2719 return $i
2722 proc initlayout {} {
2723 global rowidlist rowisopt rowfinal displayorder commitlisted
2724 global numcommits canvxmax canv
2725 global nextcolor
2726 global parentlist
2727 global colormap rowtextx
2728 global selectfirst
2730 set numcommits 0
2731 set displayorder {}
2732 set commitlisted {}
2733 set parentlist {}
2734 set nextcolor 0
2735 set rowidlist {}
2736 set rowisopt {}
2737 set rowfinal {}
2738 set canvxmax [$canv cget -width]
2739 catch {unset colormap}
2740 catch {unset rowtextx}
2741 set selectfirst 1
2744 proc setcanvscroll {} {
2745 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2747 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2748 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2749 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2750 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2753 proc visiblerows {} {
2754 global canv numcommits linespc
2756 set ymax [lindex [$canv cget -scrollregion] 3]
2757 if {$ymax eq {} || $ymax == 0} return
2758 set f [$canv yview]
2759 set y0 [expr {int([lindex $f 0] * $ymax)}]
2760 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2761 if {$r0 < 0} {
2762 set r0 0
2764 set y1 [expr {int([lindex $f 1] * $ymax)}]
2765 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2766 if {$r1 >= $numcommits} {
2767 set r1 [expr {$numcommits - 1}]
2769 return [list $r0 $r1]
2772 proc layoutmore {} {
2773 global commitidx viewcomplete numcommits
2774 global uparrowlen downarrowlen mingaplen curview
2776 set show $commitidx($curview)
2777 if {$show > $numcommits || $viewcomplete($curview)} {
2778 showstuff $show $viewcomplete($curview)
2782 proc showstuff {canshow last} {
2783 global numcommits commitrow pending_select selectedline curview
2784 global mainheadid displayorder selectfirst
2785 global lastscrollset commitinterest
2787 if {$numcommits == 0} {
2788 global phase
2789 set phase "incrdraw"
2790 allcanvs delete all
2792 set r0 $numcommits
2793 set prev $numcommits
2794 set numcommits $canshow
2795 set t [clock clicks -milliseconds]
2796 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2797 set lastscrollset $t
2798 setcanvscroll
2800 set rows [visiblerows]
2801 set r1 [lindex $rows 1]
2802 if {$r1 >= $canshow} {
2803 set r1 [expr {$canshow - 1}]
2805 if {$r0 <= $r1} {
2806 drawcommits $r0 $r1
2808 if {[info exists pending_select] &&
2809 [info exists commitrow($curview,$pending_select)] &&
2810 $commitrow($curview,$pending_select) < $numcommits} {
2811 selectline $commitrow($curview,$pending_select) 1
2813 if {$selectfirst} {
2814 if {[info exists selectedline] || [info exists pending_select]} {
2815 set selectfirst 0
2816 } else {
2817 set l [first_real_row]
2818 selectline $l 1
2819 set selectfirst 0
2824 proc doshowlocalchanges {} {
2825 global curview mainheadid phase commitrow
2827 if {[info exists commitrow($curview,$mainheadid)] &&
2828 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2829 dodiffindex
2830 } elseif {$phase ne {}} {
2831 lappend commitinterest($mainheadid) {}
2835 proc dohidelocalchanges {} {
2836 global localfrow localirow lserial
2838 if {$localfrow >= 0} {
2839 removerow $localfrow
2840 set localfrow -1
2841 if {$localirow > 0} {
2842 incr localirow -1
2845 if {$localirow >= 0} {
2846 removerow $localirow
2847 set localirow -1
2849 incr lserial
2852 # spawn off a process to do git diff-index --cached HEAD
2853 proc dodiffindex {} {
2854 global localirow localfrow lserial showlocalchanges
2856 if {!$showlocalchanges} return
2857 incr lserial
2858 set localfrow -1
2859 set localirow -1
2860 set fd [open "|git diff-index --cached HEAD" r]
2861 fconfigure $fd -blocking 0
2862 filerun $fd [list readdiffindex $fd $lserial]
2865 proc readdiffindex {fd serial} {
2866 global localirow commitrow mainheadid nullid2 curview
2867 global commitinfo commitdata lserial
2869 set isdiff 1
2870 if {[gets $fd line] < 0} {
2871 if {![eof $fd]} {
2872 return 1
2874 set isdiff 0
2876 # we only need to see one line and we don't really care what it says...
2877 close $fd
2879 # now see if there are any local changes not checked in to the index
2880 if {$serial == $lserial} {
2881 set fd [open "|git diff-files" r]
2882 fconfigure $fd -blocking 0
2883 filerun $fd [list readdifffiles $fd $serial]
2886 if {$isdiff && $serial == $lserial && $localirow == -1} {
2887 # add the line for the changes in the index to the graph
2888 set localirow $commitrow($curview,$mainheadid)
2889 set hl [mc "Local changes checked in to index but not committed"]
2890 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2891 set commitdata($nullid2) "\n $hl\n"
2892 insertrow $localirow $nullid2
2894 return 0
2897 proc readdifffiles {fd serial} {
2898 global localirow localfrow commitrow mainheadid nullid curview
2899 global commitinfo commitdata lserial
2901 set isdiff 1
2902 if {[gets $fd line] < 0} {
2903 if {![eof $fd]} {
2904 return 1
2906 set isdiff 0
2908 # we only need to see one line and we don't really care what it says...
2909 close $fd
2911 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2912 # add the line for the local diff to the graph
2913 if {$localirow >= 0} {
2914 set localfrow $localirow
2915 incr localirow
2916 } else {
2917 set localfrow $commitrow($curview,$mainheadid)
2919 set hl [mc "Local uncommitted changes, not checked in to index"]
2920 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2921 set commitdata($nullid) "\n $hl\n"
2922 insertrow $localfrow $nullid
2924 return 0
2927 proc nextuse {id row} {
2928 global commitrow curview children
2930 if {[info exists children($curview,$id)]} {
2931 foreach kid $children($curview,$id) {
2932 if {![info exists commitrow($curview,$kid)]} {
2933 return -1
2935 if {$commitrow($curview,$kid) > $row} {
2936 return $commitrow($curview,$kid)
2940 if {[info exists commitrow($curview,$id)]} {
2941 return $commitrow($curview,$id)
2943 return -1
2946 proc prevuse {id row} {
2947 global commitrow curview children
2949 set ret -1
2950 if {[info exists children($curview,$id)]} {
2951 foreach kid $children($curview,$id) {
2952 if {![info exists commitrow($curview,$kid)]} break
2953 if {$commitrow($curview,$kid) < $row} {
2954 set ret $commitrow($curview,$kid)
2958 return $ret
2961 proc make_idlist {row} {
2962 global displayorder parentlist uparrowlen downarrowlen mingaplen
2963 global commitidx curview ordertok children commitrow
2965 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2966 if {$r < 0} {
2967 set r 0
2969 set ra [expr {$row - $downarrowlen}]
2970 if {$ra < 0} {
2971 set ra 0
2973 set rb [expr {$row + $uparrowlen}]
2974 if {$rb > $commitidx($curview)} {
2975 set rb $commitidx($curview)
2977 set ids {}
2978 for {} {$r < $ra} {incr r} {
2979 set nextid [lindex $displayorder [expr {$r + 1}]]
2980 foreach p [lindex $parentlist $r] {
2981 if {$p eq $nextid} continue
2982 set rn [nextuse $p $r]
2983 if {$rn >= $row &&
2984 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2985 lappend ids [list $ordertok($curview,$p) $p]
2989 for {} {$r < $row} {incr r} {
2990 set nextid [lindex $displayorder [expr {$r + 1}]]
2991 foreach p [lindex $parentlist $r] {
2992 if {$p eq $nextid} continue
2993 set rn [nextuse $p $r]
2994 if {$rn < 0 || $rn >= $row} {
2995 lappend ids [list $ordertok($curview,$p) $p]
2999 set id [lindex $displayorder $row]
3000 lappend ids [list $ordertok($curview,$id) $id]
3001 while {$r < $rb} {
3002 foreach p [lindex $parentlist $r] {
3003 set firstkid [lindex $children($curview,$p) 0]
3004 if {$commitrow($curview,$firstkid) < $row} {
3005 lappend ids [list $ordertok($curview,$p) $p]
3008 incr r
3009 set id [lindex $displayorder $r]
3010 if {$id ne {}} {
3011 set firstkid [lindex $children($curview,$id) 0]
3012 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3013 lappend ids [list $ordertok($curview,$id) $id]
3017 set idlist {}
3018 foreach idx [lsort -unique $ids] {
3019 lappend idlist [lindex $idx 1]
3021 return $idlist
3024 proc rowsequal {a b} {
3025 while {[set i [lsearch -exact $a {}]] >= 0} {
3026 set a [lreplace $a $i $i]
3028 while {[set i [lsearch -exact $b {}]] >= 0} {
3029 set b [lreplace $b $i $i]
3031 return [expr {$a eq $b}]
3034 proc makeupline {id row rend col} {
3035 global rowidlist uparrowlen downarrowlen mingaplen
3037 for {set r $rend} {1} {set r $rstart} {
3038 set rstart [prevuse $id $r]
3039 if {$rstart < 0} return
3040 if {$rstart < $row} break
3042 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3043 set rstart [expr {$rend - $uparrowlen - 1}]
3045 for {set r $rstart} {[incr r] <= $row} {} {
3046 set idlist [lindex $rowidlist $r]
3047 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3048 set col [idcol $idlist $id $col]
3049 lset rowidlist $r [linsert $idlist $col $id]
3050 changedrow $r
3055 proc layoutrows {row endrow} {
3056 global rowidlist rowisopt rowfinal displayorder
3057 global uparrowlen downarrowlen maxwidth mingaplen
3058 global children parentlist
3059 global commitidx viewcomplete curview commitrow
3061 set idlist {}
3062 if {$row > 0} {
3063 set rm1 [expr {$row - 1}]
3064 foreach id [lindex $rowidlist $rm1] {
3065 if {$id ne {}} {
3066 lappend idlist $id
3069 set final [lindex $rowfinal $rm1]
3071 for {} {$row < $endrow} {incr row} {
3072 set rm1 [expr {$row - 1}]
3073 if {$rm1 < 0 || $idlist eq {}} {
3074 set idlist [make_idlist $row]
3075 set final 1
3076 } else {
3077 set id [lindex $displayorder $rm1]
3078 set col [lsearch -exact $idlist $id]
3079 set idlist [lreplace $idlist $col $col]
3080 foreach p [lindex $parentlist $rm1] {
3081 if {[lsearch -exact $idlist $p] < 0} {
3082 set col [idcol $idlist $p $col]
3083 set idlist [linsert $idlist $col $p]
3084 # if not the first child, we have to insert a line going up
3085 if {$id ne [lindex $children($curview,$p) 0]} {
3086 makeupline $p $rm1 $row $col
3090 set id [lindex $displayorder $row]
3091 if {$row > $downarrowlen} {
3092 set termrow [expr {$row - $downarrowlen - 1}]
3093 foreach p [lindex $parentlist $termrow] {
3094 set i [lsearch -exact $idlist $p]
3095 if {$i < 0} continue
3096 set nr [nextuse $p $termrow]
3097 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3098 set idlist [lreplace $idlist $i $i]
3102 set col [lsearch -exact $idlist $id]
3103 if {$col < 0} {
3104 set col [idcol $idlist $id]
3105 set idlist [linsert $idlist $col $id]
3106 if {$children($curview,$id) ne {}} {
3107 makeupline $id $rm1 $row $col
3110 set r [expr {$row + $uparrowlen - 1}]
3111 if {$r < $commitidx($curview)} {
3112 set x $col
3113 foreach p [lindex $parentlist $r] {
3114 if {[lsearch -exact $idlist $p] >= 0} continue
3115 set fk [lindex $children($curview,$p) 0]
3116 if {$commitrow($curview,$fk) < $row} {
3117 set x [idcol $idlist $p $x]
3118 set idlist [linsert $idlist $x $p]
3121 if {[incr r] < $commitidx($curview)} {
3122 set p [lindex $displayorder $r]
3123 if {[lsearch -exact $idlist $p] < 0} {
3124 set fk [lindex $children($curview,$p) 0]
3125 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3126 set x [idcol $idlist $p $x]
3127 set idlist [linsert $idlist $x $p]
3133 if {$final && !$viewcomplete($curview) &&
3134 $row + $uparrowlen + $mingaplen + $downarrowlen
3135 >= $commitidx($curview)} {
3136 set final 0
3138 set l [llength $rowidlist]
3139 if {$row == $l} {
3140 lappend rowidlist $idlist
3141 lappend rowisopt 0
3142 lappend rowfinal $final
3143 } elseif {$row < $l} {
3144 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3145 lset rowidlist $row $idlist
3146 changedrow $row
3148 lset rowfinal $row $final
3149 } else {
3150 set pad [ntimes [expr {$row - $l}] {}]
3151 set rowidlist [concat $rowidlist $pad]
3152 lappend rowidlist $idlist
3153 set rowfinal [concat $rowfinal $pad]
3154 lappend rowfinal $final
3155 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3158 return $row
3161 proc changedrow {row} {
3162 global displayorder iddrawn rowisopt need_redisplay
3164 set l [llength $rowisopt]
3165 if {$row < $l} {
3166 lset rowisopt $row 0
3167 if {$row + 1 < $l} {
3168 lset rowisopt [expr {$row + 1}] 0
3169 if {$row + 2 < $l} {
3170 lset rowisopt [expr {$row + 2}] 0
3174 set id [lindex $displayorder $row]
3175 if {[info exists iddrawn($id)]} {
3176 set need_redisplay 1
3180 proc insert_pad {row col npad} {
3181 global rowidlist
3183 set pad [ntimes $npad {}]
3184 set idlist [lindex $rowidlist $row]
3185 set bef [lrange $idlist 0 [expr {$col - 1}]]
3186 set aft [lrange $idlist $col end]
3187 set i [lsearch -exact $aft {}]
3188 if {$i > 0} {
3189 set aft [lreplace $aft $i $i]
3191 lset rowidlist $row [concat $bef $pad $aft]
3192 changedrow $row
3195 proc optimize_rows {row col endrow} {
3196 global rowidlist rowisopt displayorder curview children
3198 if {$row < 1} {
3199 set row 1
3201 for {} {$row < $endrow} {incr row; set col 0} {
3202 if {[lindex $rowisopt $row]} continue
3203 set haspad 0
3204 set y0 [expr {$row - 1}]
3205 set ym [expr {$row - 2}]
3206 set idlist [lindex $rowidlist $row]
3207 set previdlist [lindex $rowidlist $y0]
3208 if {$idlist eq {} || $previdlist eq {}} continue
3209 if {$ym >= 0} {
3210 set pprevidlist [lindex $rowidlist $ym]
3211 if {$pprevidlist eq {}} continue
3212 } else {
3213 set pprevidlist {}
3215 set x0 -1
3216 set xm -1
3217 for {} {$col < [llength $idlist]} {incr col} {
3218 set id [lindex $idlist $col]
3219 if {[lindex $previdlist $col] eq $id} continue
3220 if {$id eq {}} {
3221 set haspad 1
3222 continue
3224 set x0 [lsearch -exact $previdlist $id]
3225 if {$x0 < 0} continue
3226 set z [expr {$x0 - $col}]
3227 set isarrow 0
3228 set z0 {}
3229 if {$ym >= 0} {
3230 set xm [lsearch -exact $pprevidlist $id]
3231 if {$xm >= 0} {
3232 set z0 [expr {$xm - $x0}]
3235 if {$z0 eq {}} {
3236 # if row y0 is the first child of $id then it's not an arrow
3237 if {[lindex $children($curview,$id) 0] ne
3238 [lindex $displayorder $y0]} {
3239 set isarrow 1
3242 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3243 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3244 set isarrow 1
3246 # Looking at lines from this row to the previous row,
3247 # make them go straight up if they end in an arrow on
3248 # the previous row; otherwise make them go straight up
3249 # or at 45 degrees.
3250 if {$z < -1 || ($z < 0 && $isarrow)} {
3251 # Line currently goes left too much;
3252 # insert pads in the previous row, then optimize it
3253 set npad [expr {-1 - $z + $isarrow}]
3254 insert_pad $y0 $x0 $npad
3255 if {$y0 > 0} {
3256 optimize_rows $y0 $x0 $row
3258 set previdlist [lindex $rowidlist $y0]
3259 set x0 [lsearch -exact $previdlist $id]
3260 set z [expr {$x0 - $col}]
3261 if {$z0 ne {}} {
3262 set pprevidlist [lindex $rowidlist $ym]
3263 set xm [lsearch -exact $pprevidlist $id]
3264 set z0 [expr {$xm - $x0}]
3266 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3267 # Line currently goes right too much;
3268 # insert pads in this line
3269 set npad [expr {$z - 1 + $isarrow}]
3270 insert_pad $row $col $npad
3271 set idlist [lindex $rowidlist $row]
3272 incr col $npad
3273 set z [expr {$x0 - $col}]
3274 set haspad 1
3276 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3277 # this line links to its first child on row $row-2
3278 set id [lindex $displayorder $ym]
3279 set xc [lsearch -exact $pprevidlist $id]
3280 if {$xc >= 0} {
3281 set z0 [expr {$xc - $x0}]
3284 # avoid lines jigging left then immediately right
3285 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3286 insert_pad $y0 $x0 1
3287 incr x0
3288 optimize_rows $y0 $x0 $row
3289 set previdlist [lindex $rowidlist $y0]
3292 if {!$haspad} {
3293 # Find the first column that doesn't have a line going right
3294 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3295 set id [lindex $idlist $col]
3296 if {$id eq {}} break
3297 set x0 [lsearch -exact $previdlist $id]
3298 if {$x0 < 0} {
3299 # check if this is the link to the first child
3300 set kid [lindex $displayorder $y0]
3301 if {[lindex $children($curview,$id) 0] eq $kid} {
3302 # it is, work out offset to child
3303 set x0 [lsearch -exact $previdlist $kid]
3306 if {$x0 <= $col} break
3308 # Insert a pad at that column as long as it has a line and
3309 # isn't the last column
3310 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3311 set idlist [linsert $idlist $col {}]
3312 lset rowidlist $row $idlist
3313 changedrow $row
3319 proc xc {row col} {
3320 global canvx0 linespc
3321 return [expr {$canvx0 + $col * $linespc}]
3324 proc yc {row} {
3325 global canvy0 linespc
3326 return [expr {$canvy0 + $row * $linespc}]
3329 proc linewidth {id} {
3330 global thickerline lthickness
3332 set wid $lthickness
3333 if {[info exists thickerline] && $id eq $thickerline} {
3334 set wid [expr {2 * $lthickness}]
3336 return $wid
3339 proc rowranges {id} {
3340 global commitrow curview children uparrowlen downarrowlen
3341 global rowidlist
3343 set kids $children($curview,$id)
3344 if {$kids eq {}} {
3345 return {}
3347 set ret {}
3348 lappend kids $id
3349 foreach child $kids {
3350 if {![info exists commitrow($curview,$child)]} break
3351 set row $commitrow($curview,$child)
3352 if {![info exists prev]} {
3353 lappend ret [expr {$row + 1}]
3354 } else {
3355 if {$row <= $prevrow} {
3356 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3358 # see if the line extends the whole way from prevrow to row
3359 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3360 [lsearch -exact [lindex $rowidlist \
3361 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3362 # it doesn't, see where it ends
3363 set r [expr {$prevrow + $downarrowlen}]
3364 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3365 while {[incr r -1] > $prevrow &&
3366 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3367 } else {
3368 while {[incr r] <= $row &&
3369 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3370 incr r -1
3372 lappend ret $r
3373 # see where it starts up again
3374 set r [expr {$row - $uparrowlen}]
3375 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3376 while {[incr r] < $row &&
3377 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3378 } else {
3379 while {[incr r -1] >= $prevrow &&
3380 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3381 incr r
3383 lappend ret $r
3386 if {$child eq $id} {
3387 lappend ret $row
3389 set prev $id
3390 set prevrow $row
3392 return $ret
3395 proc drawlineseg {id row endrow arrowlow} {
3396 global rowidlist displayorder iddrawn linesegs
3397 global canv colormap linespc curview maxlinelen parentlist
3399 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3400 set le [expr {$row + 1}]
3401 set arrowhigh 1
3402 while {1} {
3403 set c [lsearch -exact [lindex $rowidlist $le] $id]
3404 if {$c < 0} {
3405 incr le -1
3406 break
3408 lappend cols $c
3409 set x [lindex $displayorder $le]
3410 if {$x eq $id} {
3411 set arrowhigh 0
3412 break
3414 if {[info exists iddrawn($x)] || $le == $endrow} {
3415 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3416 if {$c >= 0} {
3417 lappend cols $c
3418 set arrowhigh 0
3420 break
3422 incr le
3424 if {$le <= $row} {
3425 return $row
3428 set lines {}
3429 set i 0
3430 set joinhigh 0
3431 if {[info exists linesegs($id)]} {
3432 set lines $linesegs($id)
3433 foreach li $lines {
3434 set r0 [lindex $li 0]
3435 if {$r0 > $row} {
3436 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3437 set joinhigh 1
3439 break
3441 incr i
3444 set joinlow 0
3445 if {$i > 0} {
3446 set li [lindex $lines [expr {$i-1}]]
3447 set r1 [lindex $li 1]
3448 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3449 set joinlow 1
3453 set x [lindex $cols [expr {$le - $row}]]
3454 set xp [lindex $cols [expr {$le - 1 - $row}]]
3455 set dir [expr {$xp - $x}]
3456 if {$joinhigh} {
3457 set ith [lindex $lines $i 2]
3458 set coords [$canv coords $ith]
3459 set ah [$canv itemcget $ith -arrow]
3460 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3461 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3462 if {$x2 ne {} && $x - $x2 == $dir} {
3463 set coords [lrange $coords 0 end-2]
3465 } else {
3466 set coords [list [xc $le $x] [yc $le]]
3468 if {$joinlow} {
3469 set itl [lindex $lines [expr {$i-1}] 2]
3470 set al [$canv itemcget $itl -arrow]
3471 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3472 } elseif {$arrowlow} {
3473 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3474 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3475 set arrowlow 0
3478 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3479 for {set y $le} {[incr y -1] > $row} {} {
3480 set x $xp
3481 set xp [lindex $cols [expr {$y - 1 - $row}]]
3482 set ndir [expr {$xp - $x}]
3483 if {$dir != $ndir || $xp < 0} {
3484 lappend coords [xc $y $x] [yc $y]
3486 set dir $ndir
3488 if {!$joinlow} {
3489 if {$xp < 0} {
3490 # join parent line to first child
3491 set ch [lindex $displayorder $row]
3492 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3493 if {$xc < 0} {
3494 puts "oops: drawlineseg: child $ch not on row $row"
3495 } elseif {$xc != $x} {
3496 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3497 set d [expr {int(0.5 * $linespc)}]
3498 set x1 [xc $row $x]
3499 if {$xc < $x} {
3500 set x2 [expr {$x1 - $d}]
3501 } else {
3502 set x2 [expr {$x1 + $d}]
3504 set y2 [yc $row]
3505 set y1 [expr {$y2 + $d}]
3506 lappend coords $x1 $y1 $x2 $y2
3507 } elseif {$xc < $x - 1} {
3508 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3509 } elseif {$xc > $x + 1} {
3510 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3512 set x $xc
3514 lappend coords [xc $row $x] [yc $row]
3515 } else {
3516 set xn [xc $row $xp]
3517 set yn [yc $row]
3518 lappend coords $xn $yn
3520 if {!$joinhigh} {
3521 assigncolor $id
3522 set t [$canv create line $coords -width [linewidth $id] \
3523 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3524 $canv lower $t
3525 bindline $t $id
3526 set lines [linsert $lines $i [list $row $le $t]]
3527 } else {
3528 $canv coords $ith $coords
3529 if {$arrow ne $ah} {
3530 $canv itemconf $ith -arrow $arrow
3532 lset lines $i 0 $row
3534 } else {
3535 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3536 set ndir [expr {$xo - $xp}]
3537 set clow [$canv coords $itl]
3538 if {$dir == $ndir} {
3539 set clow [lrange $clow 2 end]
3541 set coords [concat $coords $clow]
3542 if {!$joinhigh} {
3543 lset lines [expr {$i-1}] 1 $le
3544 } else {
3545 # coalesce two pieces
3546 $canv delete $ith
3547 set b [lindex $lines [expr {$i-1}] 0]
3548 set e [lindex $lines $i 1]
3549 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3551 $canv coords $itl $coords
3552 if {$arrow ne $al} {
3553 $canv itemconf $itl -arrow $arrow
3557 set linesegs($id) $lines
3558 return $le
3561 proc drawparentlinks {id row} {
3562 global rowidlist canv colormap curview parentlist
3563 global idpos linespc
3565 set rowids [lindex $rowidlist $row]
3566 set col [lsearch -exact $rowids $id]
3567 if {$col < 0} return
3568 set olds [lindex $parentlist $row]
3569 set row2 [expr {$row + 1}]
3570 set x [xc $row $col]
3571 set y [yc $row]
3572 set y2 [yc $row2]
3573 set d [expr {int(0.5 * $linespc)}]
3574 set ymid [expr {$y + $d}]
3575 set ids [lindex $rowidlist $row2]
3576 # rmx = right-most X coord used
3577 set rmx 0
3578 foreach p $olds {
3579 set i [lsearch -exact $ids $p]
3580 if {$i < 0} {
3581 puts "oops, parent $p of $id not in list"
3582 continue
3584 set x2 [xc $row2 $i]
3585 if {$x2 > $rmx} {
3586 set rmx $x2
3588 set j [lsearch -exact $rowids $p]
3589 if {$j < 0} {
3590 # drawlineseg will do this one for us
3591 continue
3593 assigncolor $p
3594 # should handle duplicated parents here...
3595 set coords [list $x $y]
3596 if {$i != $col} {
3597 # if attaching to a vertical segment, draw a smaller
3598 # slant for visual distinctness
3599 if {$i == $j} {
3600 if {$i < $col} {
3601 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3602 } else {
3603 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3605 } elseif {$i < $col && $i < $j} {
3606 # segment slants towards us already
3607 lappend coords [xc $row $j] $y
3608 } else {
3609 if {$i < $col - 1} {
3610 lappend coords [expr {$x2 + $linespc}] $y
3611 } elseif {$i > $col + 1} {
3612 lappend coords [expr {$x2 - $linespc}] $y
3614 lappend coords $x2 $y2
3616 } else {
3617 lappend coords $x2 $y2
3619 set t [$canv create line $coords -width [linewidth $p] \
3620 -fill $colormap($p) -tags lines.$p]
3621 $canv lower $t
3622 bindline $t $p
3624 if {$rmx > [lindex $idpos($id) 1]} {
3625 lset idpos($id) 1 $rmx
3626 redrawtags $id
3630 proc drawlines {id} {
3631 global canv
3633 $canv itemconf lines.$id -width [linewidth $id]
3636 proc drawcmittext {id row col} {
3637 global linespc canv canv2 canv3 canvy0 fgcolor curview
3638 global commitlisted commitinfo rowidlist parentlist
3639 global rowtextx idpos idtags idheads idotherrefs
3640 global linehtag linentag linedtag selectedline
3641 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3643 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3644 set listed [lindex $commitlisted $row]
3645 if {$id eq $nullid} {
3646 set ofill red
3647 } elseif {$id eq $nullid2} {
3648 set ofill green
3649 } else {
3650 set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
3652 set x [xc $row $col]
3653 set y [yc $row]
3654 set orad [expr {$linespc / 3}]
3655 if {$listed <= 2} {
3656 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3657 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3658 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3659 } elseif {$listed == 3} {
3660 # triangle pointing left for left-side commits
3661 set t [$canv create polygon \
3662 [expr {$x - $orad}] $y \
3663 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3664 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3665 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3666 } else {
3667 # triangle pointing right for right-side commits
3668 set t [$canv create polygon \
3669 [expr {$x + $orad - 1}] $y \
3670 [expr {$x - $orad}] [expr {$y - $orad}] \
3671 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3672 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3674 $canv raise $t
3675 $canv bind $t <1> {selcanvline {} %x %y}
3676 set rmx [llength [lindex $rowidlist $row]]
3677 set olds [lindex $parentlist $row]
3678 if {$olds ne {}} {
3679 set nextids [lindex $rowidlist [expr {$row + 1}]]
3680 foreach p $olds {
3681 set i [lsearch -exact $nextids $p]
3682 if {$i > $rmx} {
3683 set rmx $i
3687 set xt [xc $row $rmx]
3688 set rowtextx($row) $xt
3689 set idpos($id) [list $x $xt $y]
3690 if {[info exists idtags($id)] || [info exists idheads($id)]
3691 || [info exists idotherrefs($id)]} {
3692 set xt [drawtags $id $x $xt $y]
3694 set headline [lindex $commitinfo($id) 0]
3695 set name [lindex $commitinfo($id) 1]
3696 set date [lindex $commitinfo($id) 2]
3697 set date [formatdate $date]
3698 set font mainfont
3699 set nfont mainfont
3700 set isbold [ishighlighted $row]
3701 if {$isbold > 0} {
3702 lappend boldrows $row
3703 set font mainfontbold
3704 if {$isbold > 1} {
3705 lappend boldnamerows $row
3706 set nfont mainfontbold
3709 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3710 -text $headline -font $font -tags text]
3711 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3712 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3713 -text $name -font $nfont -tags text]
3714 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3715 -text $date -font mainfont -tags text]
3716 if {[info exists selectedline] && $selectedline == $row} {
3717 make_secsel $row
3719 set xr [expr {$xt + [font measure $font $headline]}]
3720 if {$xr > $canvxmax} {
3721 set canvxmax $xr
3722 setcanvscroll
3726 proc drawcmitrow {row} {
3727 global displayorder rowidlist nrows_drawn
3728 global iddrawn markingmatches
3729 global commitinfo parentlist numcommits
3730 global filehighlight fhighlights findpattern nhighlights
3731 global hlview vhighlights
3732 global highlight_related rhighlights
3734 if {$row >= $numcommits} return
3736 set id [lindex $displayorder $row]
3737 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3738 askvhighlight $row $id
3740 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3741 askfilehighlight $row $id
3743 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3744 askfindhighlight $row $id
3746 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3747 askrelhighlight $row $id
3749 if {![info exists iddrawn($id)]} {
3750 set col [lsearch -exact [lindex $rowidlist $row] $id]
3751 if {$col < 0} {
3752 puts "oops, row $row id $id not in list"
3753 return
3755 if {![info exists commitinfo($id)]} {
3756 getcommit $id
3758 assigncolor $id
3759 drawcmittext $id $row $col
3760 set iddrawn($id) 1
3761 incr nrows_drawn
3763 if {$markingmatches} {
3764 markrowmatches $row $id
3768 proc drawcommits {row {endrow {}}} {
3769 global numcommits iddrawn displayorder curview need_redisplay
3770 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3772 if {$row < 0} {
3773 set row 0
3775 if {$endrow eq {}} {
3776 set endrow $row
3778 if {$endrow >= $numcommits} {
3779 set endrow [expr {$numcommits - 1}]
3782 set rl1 [expr {$row - $downarrowlen - 3}]
3783 if {$rl1 < 0} {
3784 set rl1 0
3786 set ro1 [expr {$row - 3}]
3787 if {$ro1 < 0} {
3788 set ro1 0
3790 set r2 [expr {$endrow + $uparrowlen + 3}]
3791 if {$r2 > $numcommits} {
3792 set r2 $numcommits
3794 for {set r $rl1} {$r < $r2} {incr r} {
3795 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3796 if {$rl1 < $r} {
3797 layoutrows $rl1 $r
3799 set rl1 [expr {$r + 1}]
3802 if {$rl1 < $r} {
3803 layoutrows $rl1 $r
3805 optimize_rows $ro1 0 $r2
3806 if {$need_redisplay || $nrows_drawn > 2000} {
3807 clear_display
3808 drawvisible
3811 # make the lines join to already-drawn rows either side
3812 set r [expr {$row - 1}]
3813 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3814 set r $row
3816 set er [expr {$endrow + 1}]
3817 if {$er >= $numcommits ||
3818 ![info exists iddrawn([lindex $displayorder $er])]} {
3819 set er $endrow
3821 for {} {$r <= $er} {incr r} {
3822 set id [lindex $displayorder $r]
3823 set wasdrawn [info exists iddrawn($id)]
3824 drawcmitrow $r
3825 if {$r == $er} break
3826 set nextid [lindex $displayorder [expr {$r + 1}]]
3827 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3828 drawparentlinks $id $r
3830 set rowids [lindex $rowidlist $r]
3831 foreach lid $rowids {
3832 if {$lid eq {}} continue
3833 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3834 if {$lid eq $id} {
3835 # see if this is the first child of any of its parents
3836 foreach p [lindex $parentlist $r] {
3837 if {[lsearch -exact $rowids $p] < 0} {
3838 # make this line extend up to the child
3839 set lineend($p) [drawlineseg $p $r $er 0]
3842 } else {
3843 set lineend($lid) [drawlineseg $lid $r $er 1]
3849 proc drawfrac {f0 f1} {
3850 global canv linespc
3852 set ymax [lindex [$canv cget -scrollregion] 3]
3853 if {$ymax eq {} || $ymax == 0} return
3854 set y0 [expr {int($f0 * $ymax)}]
3855 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3856 set y1 [expr {int($f1 * $ymax)}]
3857 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3858 drawcommits $row $endrow
3861 proc drawvisible {} {
3862 global canv
3863 eval drawfrac [$canv yview]
3866 proc clear_display {} {
3867 global iddrawn linesegs need_redisplay nrows_drawn
3868 global vhighlights fhighlights nhighlights rhighlights
3870 allcanvs delete all
3871 catch {unset iddrawn}
3872 catch {unset linesegs}
3873 catch {unset vhighlights}
3874 catch {unset fhighlights}
3875 catch {unset nhighlights}
3876 catch {unset rhighlights}
3877 set need_redisplay 0
3878 set nrows_drawn 0
3881 proc findcrossings {id} {
3882 global rowidlist parentlist numcommits displayorder
3884 set cross {}
3885 set ccross {}
3886 foreach {s e} [rowranges $id] {
3887 if {$e >= $numcommits} {
3888 set e [expr {$numcommits - 1}]
3890 if {$e <= $s} continue
3891 for {set row $e} {[incr row -1] >= $s} {} {
3892 set x [lsearch -exact [lindex $rowidlist $row] $id]
3893 if {$x < 0} break
3894 set olds [lindex $parentlist $row]
3895 set kid [lindex $displayorder $row]
3896 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3897 if {$kidx < 0} continue
3898 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3899 foreach p $olds {
3900 set px [lsearch -exact $nextrow $p]
3901 if {$px < 0} continue
3902 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3903 if {[lsearch -exact $ccross $p] >= 0} continue
3904 if {$x == $px + ($kidx < $px? -1: 1)} {
3905 lappend ccross $p
3906 } elseif {[lsearch -exact $cross $p] < 0} {
3907 lappend cross $p
3913 return [concat $ccross {{}} $cross]
3916 proc assigncolor {id} {
3917 global colormap colors nextcolor
3918 global commitrow parentlist children children curview
3920 if {[info exists colormap($id)]} return
3921 set ncolors [llength $colors]
3922 if {[info exists children($curview,$id)]} {
3923 set kids $children($curview,$id)
3924 } else {
3925 set kids {}
3927 if {[llength $kids] == 1} {
3928 set child [lindex $kids 0]
3929 if {[info exists colormap($child)]
3930 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3931 set colormap($id) $colormap($child)
3932 return
3935 set badcolors {}
3936 set origbad {}
3937 foreach x [findcrossings $id] {
3938 if {$x eq {}} {
3939 # delimiter between corner crossings and other crossings
3940 if {[llength $badcolors] >= $ncolors - 1} break
3941 set origbad $badcolors
3943 if {[info exists colormap($x)]
3944 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3945 lappend badcolors $colormap($x)
3948 if {[llength $badcolors] >= $ncolors} {
3949 set badcolors $origbad
3951 set origbad $badcolors
3952 if {[llength $badcolors] < $ncolors - 1} {
3953 foreach child $kids {
3954 if {[info exists colormap($child)]
3955 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3956 lappend badcolors $colormap($child)
3958 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3959 if {[info exists colormap($p)]
3960 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3961 lappend badcolors $colormap($p)
3965 if {[llength $badcolors] >= $ncolors} {
3966 set badcolors $origbad
3969 for {set i 0} {$i <= $ncolors} {incr i} {
3970 set c [lindex $colors $nextcolor]
3971 if {[incr nextcolor] >= $ncolors} {
3972 set nextcolor 0
3974 if {[lsearch -exact $badcolors $c]} break
3976 set colormap($id) $c
3979 proc bindline {t id} {
3980 global canv
3982 $canv bind $t <Enter> "lineenter %x %y $id"
3983 $canv bind $t <Motion> "linemotion %x %y $id"
3984 $canv bind $t <Leave> "lineleave $id"
3985 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3988 proc drawtags {id x xt y1} {
3989 global idtags idheads idotherrefs mainhead
3990 global linespc lthickness
3991 global canv commitrow rowtextx curview fgcolor bgcolor
3993 set marks {}
3994 set ntags 0
3995 set nheads 0
3996 if {[info exists idtags($id)]} {
3997 set marks $idtags($id)
3998 set ntags [llength $marks]
4000 if {[info exists idheads($id)]} {
4001 set marks [concat $marks $idheads($id)]
4002 set nheads [llength $idheads($id)]
4004 if {[info exists idotherrefs($id)]} {
4005 set marks [concat $marks $idotherrefs($id)]
4007 if {$marks eq {}} {
4008 return $xt
4011 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4012 set yt [expr {$y1 - 0.5 * $linespc}]
4013 set yb [expr {$yt + $linespc - 1}]
4014 set xvals {}
4015 set wvals {}
4016 set i -1
4017 foreach tag $marks {
4018 incr i
4019 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4020 set wid [font measure mainfontbold $tag]
4021 } else {
4022 set wid [font measure mainfont $tag]
4024 lappend xvals $xt
4025 lappend wvals $wid
4026 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4028 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4029 -width $lthickness -fill black -tags tag.$id]
4030 $canv lower $t
4031 foreach tag $marks x $xvals wid $wvals {
4032 set xl [expr {$x + $delta}]
4033 set xr [expr {$x + $delta + $wid + $lthickness}]
4034 set font mainfont
4035 if {[incr ntags -1] >= 0} {
4036 # draw a tag
4037 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4038 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4039 -width 1 -outline black -fill yellow -tags tag.$id]
4040 $canv bind $t <1> [list showtag $tag 1]
4041 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4042 } else {
4043 # draw a head or other ref
4044 if {[incr nheads -1] >= 0} {
4045 set col green
4046 if {$tag eq $mainhead} {
4047 set font mainfontbold
4049 } else {
4050 set col "#ddddff"
4052 set xl [expr {$xl - $delta/2}]
4053 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4054 -width 1 -outline black -fill $col -tags tag.$id
4055 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4056 set rwid [font measure mainfont $remoteprefix]
4057 set xi [expr {$x + 1}]
4058 set yti [expr {$yt + 1}]
4059 set xri [expr {$x + $rwid}]
4060 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4061 -width 0 -fill "#ffddaa" -tags tag.$id
4064 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4065 -font $font -tags [list tag.$id text]]
4066 if {$ntags >= 0} {
4067 $canv bind $t <1> [list showtag $tag 1]
4068 } elseif {$nheads >= 0} {
4069 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4072 return $xt
4075 proc xcoord {i level ln} {
4076 global canvx0 xspc1 xspc2
4078 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4079 if {$i > 0 && $i == $level} {
4080 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4081 } elseif {$i > $level} {
4082 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4084 return $x
4087 proc show_status {msg} {
4088 global canv fgcolor
4090 clear_display
4091 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4092 -tags text -fill $fgcolor
4095 # Insert a new commit as the child of the commit on row $row.
4096 # The new commit will be displayed on row $row and the commits
4097 # on that row and below will move down one row.
4098 proc insertrow {row newcmit} {
4099 global displayorder parentlist commitlisted children
4100 global commitrow curview rowidlist rowisopt rowfinal numcommits
4101 global numcommits
4102 global selectedline commitidx ordertok
4104 if {$row >= $numcommits} {
4105 puts "oops, inserting new row $row but only have $numcommits rows"
4106 return
4108 set p [lindex $displayorder $row]
4109 set displayorder [linsert $displayorder $row $newcmit]
4110 set parentlist [linsert $parentlist $row $p]
4111 set kids $children($curview,$p)
4112 lappend kids $newcmit
4113 set children($curview,$p) $kids
4114 set children($curview,$newcmit) {}
4115 set commitlisted [linsert $commitlisted $row 1]
4116 set l [llength $displayorder]
4117 for {set r $row} {$r < $l} {incr r} {
4118 set id [lindex $displayorder $r]
4119 set commitrow($curview,$id) $r
4121 incr commitidx($curview)
4122 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4124 if {$row < [llength $rowidlist]} {
4125 set idlist [lindex $rowidlist $row]
4126 if {$idlist ne {}} {
4127 if {[llength $kids] == 1} {
4128 set col [lsearch -exact $idlist $p]
4129 lset idlist $col $newcmit
4130 } else {
4131 set col [llength $idlist]
4132 lappend idlist $newcmit
4135 set rowidlist [linsert $rowidlist $row $idlist]
4136 set rowisopt [linsert $rowisopt $row 0]
4137 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4140 incr numcommits
4142 if {[info exists selectedline] && $selectedline >= $row} {
4143 incr selectedline
4145 redisplay
4148 # Remove a commit that was inserted with insertrow on row $row.
4149 proc removerow {row} {
4150 global displayorder parentlist commitlisted children
4151 global commitrow curview rowidlist rowisopt rowfinal numcommits
4152 global numcommits
4153 global linesegends selectedline commitidx
4155 if {$row >= $numcommits} {
4156 puts "oops, removing row $row but only have $numcommits rows"
4157 return
4159 set rp1 [expr {$row + 1}]
4160 set id [lindex $displayorder $row]
4161 set p [lindex $parentlist $row]
4162 set displayorder [lreplace $displayorder $row $row]
4163 set parentlist [lreplace $parentlist $row $row]
4164 set commitlisted [lreplace $commitlisted $row $row]
4165 set kids $children($curview,$p)
4166 set i [lsearch -exact $kids $id]
4167 if {$i >= 0} {
4168 set kids [lreplace $kids $i $i]
4169 set children($curview,$p) $kids
4171 set l [llength $displayorder]
4172 for {set r $row} {$r < $l} {incr r} {
4173 set id [lindex $displayorder $r]
4174 set commitrow($curview,$id) $r
4176 incr commitidx($curview) -1
4178 if {$row < [llength $rowidlist]} {
4179 set rowidlist [lreplace $rowidlist $row $row]
4180 set rowisopt [lreplace $rowisopt $row $row]
4181 set rowfinal [lreplace $rowfinal $row $row]
4184 incr numcommits -1
4186 if {[info exists selectedline] && $selectedline > $row} {
4187 incr selectedline -1
4189 redisplay
4192 # Don't change the text pane cursor if it is currently the hand cursor,
4193 # showing that we are over a sha1 ID link.
4194 proc settextcursor {c} {
4195 global ctext curtextcursor
4197 if {[$ctext cget -cursor] == $curtextcursor} {
4198 $ctext config -cursor $c
4200 set curtextcursor $c
4203 proc nowbusy {what {name {}}} {
4204 global isbusy busyname statusw
4206 if {[array names isbusy] eq {}} {
4207 . config -cursor watch
4208 settextcursor watch
4210 set isbusy($what) 1
4211 set busyname($what) $name
4212 if {$name ne {}} {
4213 $statusw conf -text $name
4217 proc notbusy {what} {
4218 global isbusy maincursor textcursor busyname statusw
4220 catch {
4221 unset isbusy($what)
4222 if {$busyname($what) ne {} &&
4223 [$statusw cget -text] eq $busyname($what)} {
4224 $statusw conf -text {}
4227 if {[array names isbusy] eq {}} {
4228 . config -cursor $maincursor
4229 settextcursor $textcursor
4233 proc findmatches {f} {
4234 global findtype findstring
4235 if {$findtype == [mc "Regexp"]} {
4236 set matches [regexp -indices -all -inline $findstring $f]
4237 } else {
4238 set fs $findstring
4239 if {$findtype == [mc "IgnCase"]} {
4240 set f [string tolower $f]
4241 set fs [string tolower $fs]
4243 set matches {}
4244 set i 0
4245 set l [string length $fs]
4246 while {[set j [string first $fs $f $i]] >= 0} {
4247 lappend matches [list $j [expr {$j+$l-1}]]
4248 set i [expr {$j + $l}]
4251 return $matches
4254 proc dofind {{dirn 1} {wrap 1}} {
4255 global findstring findstartline findcurline selectedline numcommits
4256 global gdttype filehighlight fh_serial find_dirn findallowwrap
4258 if {[info exists find_dirn]} {
4259 if {$find_dirn == $dirn} return
4260 stopfinding
4262 focus .
4263 if {$findstring eq {} || $numcommits == 0} return
4264 if {![info exists selectedline]} {
4265 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4266 } else {
4267 set findstartline $selectedline
4269 set findcurline $findstartline
4270 nowbusy finding [mc "Searching"]
4271 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4272 after cancel do_file_hl $fh_serial
4273 do_file_hl $fh_serial
4275 set find_dirn $dirn
4276 set findallowwrap $wrap
4277 run findmore
4280 proc stopfinding {} {
4281 global find_dirn findcurline fprogcoord
4283 if {[info exists find_dirn]} {
4284 unset find_dirn
4285 unset findcurline
4286 notbusy finding
4287 set fprogcoord 0
4288 adjustprogress
4292 proc findmore {} {
4293 global commitdata commitinfo numcommits findpattern findloc
4294 global findstartline findcurline displayorder
4295 global find_dirn gdttype fhighlights fprogcoord
4296 global findallowwrap
4298 if {![info exists find_dirn]} {
4299 return 0
4301 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4302 set l $findcurline
4303 set moretodo 0
4304 if {$find_dirn > 0} {
4305 incr l
4306 if {$l >= $numcommits} {
4307 set l 0
4309 if {$l <= $findstartline} {
4310 set lim [expr {$findstartline + 1}]
4311 } else {
4312 set lim $numcommits
4313 set moretodo $findallowwrap
4315 } else {
4316 if {$l == 0} {
4317 set l $numcommits
4319 incr l -1
4320 if {$l >= $findstartline} {
4321 set lim [expr {$findstartline - 1}]
4322 } else {
4323 set lim -1
4324 set moretodo $findallowwrap
4327 set n [expr {($lim - $l) * $find_dirn}]
4328 if {$n > 500} {
4329 set n 500
4330 set moretodo 1
4332 set found 0
4333 set domore 1
4334 if {$gdttype eq [mc "containing:"]} {
4335 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4336 set id [lindex $displayorder $l]
4337 # shouldn't happen unless git log doesn't give all the commits...
4338 if {![info exists commitdata($id)]} continue
4339 if {![doesmatch $commitdata($id)]} continue
4340 if {![info exists commitinfo($id)]} {
4341 getcommit $id
4343 set info $commitinfo($id)
4344 foreach f $info ty $fldtypes {
4345 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4346 [doesmatch $f]} {
4347 set found 1
4348 break
4351 if {$found} break
4353 } else {
4354 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4355 set id [lindex $displayorder $l]
4356 if {![info exists fhighlights($l)]} {
4357 askfilehighlight $l $id
4358 if {$domore} {
4359 set domore 0
4360 set findcurline [expr {$l - $find_dirn}]
4362 } elseif {$fhighlights($l)} {
4363 set found $domore
4364 break
4368 if {$found || ($domore && !$moretodo)} {
4369 unset findcurline
4370 unset find_dirn
4371 notbusy finding
4372 set fprogcoord 0
4373 adjustprogress
4374 if {$found} {
4375 findselectline $l
4376 } else {
4377 bell
4379 return 0
4381 if {!$domore} {
4382 flushhighlights
4383 } else {
4384 set findcurline [expr {$l - $find_dirn}]
4386 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4387 if {$n < 0} {
4388 incr n $numcommits
4390 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4391 adjustprogress
4392 return $domore
4395 proc findselectline {l} {
4396 global findloc commentend ctext findcurline markingmatches gdttype
4398 set markingmatches 1
4399 set findcurline $l
4400 selectline $l 1
4401 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4402 # highlight the matches in the comments
4403 set f [$ctext get 1.0 $commentend]
4404 set matches [findmatches $f]
4405 foreach match $matches {
4406 set start [lindex $match 0]
4407 set end [expr {[lindex $match 1] + 1}]
4408 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4411 drawvisible
4414 # mark the bits of a headline or author that match a find string
4415 proc markmatches {canv l str tag matches font row} {
4416 global selectedline
4418 set bbox [$canv bbox $tag]
4419 set x0 [lindex $bbox 0]
4420 set y0 [lindex $bbox 1]
4421 set y1 [lindex $bbox 3]
4422 foreach match $matches {
4423 set start [lindex $match 0]
4424 set end [lindex $match 1]
4425 if {$start > $end} continue
4426 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4427 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4428 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4429 [expr {$x0+$xlen+2}] $y1 \
4430 -outline {} -tags [list match$l matches] -fill yellow]
4431 $canv lower $t
4432 if {[info exists selectedline] && $row == $selectedline} {
4433 $canv raise $t secsel
4438 proc unmarkmatches {} {
4439 global markingmatches
4441 allcanvs delete matches
4442 set markingmatches 0
4443 stopfinding
4446 proc selcanvline {w x y} {
4447 global canv canvy0 ctext linespc
4448 global rowtextx
4449 set ymax [lindex [$canv cget -scrollregion] 3]
4450 if {$ymax == {}} return
4451 set yfrac [lindex [$canv yview] 0]
4452 set y [expr {$y + $yfrac * $ymax}]
4453 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4454 if {$l < 0} {
4455 set l 0
4457 if {$w eq $canv} {
4458 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4460 unmarkmatches
4461 selectline $l 1
4464 proc commit_descriptor {p} {
4465 global commitinfo
4466 if {![info exists commitinfo($p)]} {
4467 getcommit $p
4469 set l "..."
4470 if {[llength $commitinfo($p)] > 1} {
4471 set l [lindex $commitinfo($p) 0]
4473 return "$p ($l)\n"
4476 # append some text to the ctext widget, and make any SHA1 ID
4477 # that we know about be a clickable link.
4478 proc appendwithlinks {text tags} {
4479 global ctext commitrow linknum curview pendinglinks
4481 set start [$ctext index "end - 1c"]
4482 $ctext insert end $text $tags
4483 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4484 foreach l $links {
4485 set s [lindex $l 0]
4486 set e [lindex $l 1]
4487 set linkid [string range $text $s $e]
4488 incr e
4489 $ctext tag delete link$linknum
4490 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4491 setlink $linkid link$linknum
4492 incr linknum
4496 proc setlink {id lk} {
4497 global curview commitrow ctext pendinglinks commitinterest
4499 if {[info exists commitrow($curview,$id)]} {
4500 $ctext tag conf $lk -foreground blue -underline 1
4501 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4502 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4503 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4504 } else {
4505 lappend pendinglinks($id) $lk
4506 lappend commitinterest($id) {makelink %I}
4510 proc makelink {id} {
4511 global pendinglinks
4513 if {![info exists pendinglinks($id)]} return
4514 foreach lk $pendinglinks($id) {
4515 setlink $id $lk
4517 unset pendinglinks($id)
4520 proc linkcursor {w inc} {
4521 global linkentercount curtextcursor
4523 if {[incr linkentercount $inc] > 0} {
4524 $w configure -cursor hand2
4525 } else {
4526 $w configure -cursor $curtextcursor
4527 if {$linkentercount < 0} {
4528 set linkentercount 0
4533 proc viewnextline {dir} {
4534 global canv linespc
4536 $canv delete hover
4537 set ymax [lindex [$canv cget -scrollregion] 3]
4538 set wnow [$canv yview]
4539 set wtop [expr {[lindex $wnow 0] * $ymax}]
4540 set newtop [expr {$wtop + $dir * $linespc}]
4541 if {$newtop < 0} {
4542 set newtop 0
4543 } elseif {$newtop > $ymax} {
4544 set newtop $ymax
4546 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4549 # add a list of tag or branch names at position pos
4550 # returns the number of names inserted
4551 proc appendrefs {pos ids var} {
4552 global ctext commitrow linknum curview $var maxrefs
4554 if {[catch {$ctext index $pos}]} {
4555 return 0
4557 $ctext conf -state normal
4558 $ctext delete $pos "$pos lineend"
4559 set tags {}
4560 foreach id $ids {
4561 foreach tag [set $var\($id\)] {
4562 lappend tags [list $tag $id]
4565 if {[llength $tags] > $maxrefs} {
4566 $ctext insert $pos "many ([llength $tags])"
4567 } else {
4568 set tags [lsort -index 0 -decreasing $tags]
4569 set sep {}
4570 foreach ti $tags {
4571 set id [lindex $ti 1]
4572 set lk link$linknum
4573 incr linknum
4574 $ctext tag delete $lk
4575 $ctext insert $pos $sep
4576 $ctext insert $pos [lindex $ti 0] $lk
4577 setlink $id $lk
4578 set sep ", "
4581 $ctext conf -state disabled
4582 return [llength $tags]
4585 # called when we have finished computing the nearby tags
4586 proc dispneartags {delay} {
4587 global selectedline currentid showneartags tagphase
4589 if {![info exists selectedline] || !$showneartags} return
4590 after cancel dispnexttag
4591 if {$delay} {
4592 after 200 dispnexttag
4593 set tagphase -1
4594 } else {
4595 after idle dispnexttag
4596 set tagphase 0
4600 proc dispnexttag {} {
4601 global selectedline currentid showneartags tagphase ctext
4603 if {![info exists selectedline] || !$showneartags} return
4604 switch -- $tagphase {
4606 set dtags [desctags $currentid]
4607 if {$dtags ne {}} {
4608 appendrefs precedes $dtags idtags
4612 set atags [anctags $currentid]
4613 if {$atags ne {}} {
4614 appendrefs follows $atags idtags
4618 set dheads [descheads $currentid]
4619 if {$dheads ne {}} {
4620 if {[appendrefs branch $dheads idheads] > 1
4621 && [$ctext get "branch -3c"] eq "h"} {
4622 # turn "Branch" into "Branches"
4623 $ctext conf -state normal
4624 $ctext insert "branch -2c" "es"
4625 $ctext conf -state disabled
4630 if {[incr tagphase] <= 2} {
4631 after idle dispnexttag
4635 proc make_secsel {l} {
4636 global linehtag linentag linedtag canv canv2 canv3
4638 if {![info exists linehtag($l)]} return
4639 $canv delete secsel
4640 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4641 -tags secsel -fill [$canv cget -selectbackground]]
4642 $canv lower $t
4643 $canv2 delete secsel
4644 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4645 -tags secsel -fill [$canv2 cget -selectbackground]]
4646 $canv2 lower $t
4647 $canv3 delete secsel
4648 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4649 -tags secsel -fill [$canv3 cget -selectbackground]]
4650 $canv3 lower $t
4653 proc selectline {l isnew} {
4654 global canv ctext commitinfo selectedline
4655 global displayorder
4656 global canvy0 linespc parentlist children curview
4657 global currentid sha1entry
4658 global commentend idtags linknum
4659 global mergemax numcommits pending_select
4660 global cmitmode showneartags allcommits
4662 catch {unset pending_select}
4663 $canv delete hover
4664 normalline
4665 unsel_reflist
4666 stopfinding
4667 if {$l < 0 || $l >= $numcommits} return
4668 set y [expr {$canvy0 + $l * $linespc}]
4669 set ymax [lindex [$canv cget -scrollregion] 3]
4670 set ytop [expr {$y - $linespc - 1}]
4671 set ybot [expr {$y + $linespc + 1}]
4672 set wnow [$canv yview]
4673 set wtop [expr {[lindex $wnow 0] * $ymax}]
4674 set wbot [expr {[lindex $wnow 1] * $ymax}]
4675 set wh [expr {$wbot - $wtop}]
4676 set newtop $wtop
4677 if {$ytop < $wtop} {
4678 if {$ybot < $wtop} {
4679 set newtop [expr {$y - $wh / 2.0}]
4680 } else {
4681 set newtop $ytop
4682 if {$newtop > $wtop - $linespc} {
4683 set newtop [expr {$wtop - $linespc}]
4686 } elseif {$ybot > $wbot} {
4687 if {$ytop > $wbot} {
4688 set newtop [expr {$y - $wh / 2.0}]
4689 } else {
4690 set newtop [expr {$ybot - $wh}]
4691 if {$newtop < $wtop + $linespc} {
4692 set newtop [expr {$wtop + $linespc}]
4696 if {$newtop != $wtop} {
4697 if {$newtop < 0} {
4698 set newtop 0
4700 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4701 drawvisible
4704 make_secsel $l
4706 if {$isnew} {
4707 addtohistory [list selectline $l 0]
4710 set selectedline $l
4712 set id [lindex $displayorder $l]
4713 set currentid $id
4714 $sha1entry delete 0 end
4715 $sha1entry insert 0 $id
4716 $sha1entry selection from 0
4717 $sha1entry selection to end
4718 rhighlight_sel $id
4720 $ctext conf -state normal
4721 clear_ctext
4722 set linknum 0
4723 set info $commitinfo($id)
4724 set date [formatdate [lindex $info 2]]
4725 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
4726 set date [formatdate [lindex $info 4]]
4727 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
4728 if {[info exists idtags($id)]} {
4729 $ctext insert end [mc "Tags:"]
4730 foreach tag $idtags($id) {
4731 $ctext insert end " $tag"
4733 $ctext insert end "\n"
4736 set headers {}
4737 set olds [lindex $parentlist $l]
4738 if {[llength $olds] > 1} {
4739 set np 0
4740 foreach p $olds {
4741 if {$np >= $mergemax} {
4742 set tag mmax
4743 } else {
4744 set tag m$np
4746 $ctext insert end "[mc "Parent"]: " $tag
4747 appendwithlinks [commit_descriptor $p] {}
4748 incr np
4750 } else {
4751 foreach p $olds {
4752 append headers "[mc "Parent"]: [commit_descriptor $p]"
4756 foreach c $children($curview,$id) {
4757 append headers "[mc "Child"]: [commit_descriptor $c]"
4760 # make anything that looks like a SHA1 ID be a clickable link
4761 appendwithlinks $headers {}
4762 if {$showneartags} {
4763 if {![info exists allcommits]} {
4764 getallcommits
4766 $ctext insert end "[mc "Branch"]: "
4767 $ctext mark set branch "end -1c"
4768 $ctext mark gravity branch left
4769 $ctext insert end "\n[mc "Follows"]: "
4770 $ctext mark set follows "end -1c"
4771 $ctext mark gravity follows left
4772 $ctext insert end "\n[mc "Precedes"]: "
4773 $ctext mark set precedes "end -1c"
4774 $ctext mark gravity precedes left
4775 $ctext insert end "\n"
4776 dispneartags 1
4778 $ctext insert end "\n"
4779 set comment [lindex $info 5]
4780 if {[string first "\r" $comment] >= 0} {
4781 set comment [string map {"\r" "\n "} $comment]
4783 appendwithlinks $comment {comment}
4785 $ctext tag remove found 1.0 end
4786 $ctext conf -state disabled
4787 set commentend [$ctext index "end - 1c"]
4789 init_flist [mc "Comments"]
4790 if {$cmitmode eq "tree"} {
4791 gettree $id
4792 } elseif {[llength $olds] <= 1} {
4793 startdiff $id
4794 } else {
4795 mergediff $id $l
4799 proc selfirstline {} {
4800 unmarkmatches
4801 selectline 0 1
4804 proc sellastline {} {
4805 global numcommits
4806 unmarkmatches
4807 set l [expr {$numcommits - 1}]
4808 selectline $l 1
4811 proc selnextline {dir} {
4812 global selectedline
4813 focus .
4814 if {![info exists selectedline]} return
4815 set l [expr {$selectedline + $dir}]
4816 unmarkmatches
4817 selectline $l 1
4820 proc selnextpage {dir} {
4821 global canv linespc selectedline numcommits
4823 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4824 if {$lpp < 1} {
4825 set lpp 1
4827 allcanvs yview scroll [expr {$dir * $lpp}] units
4828 drawvisible
4829 if {![info exists selectedline]} return
4830 set l [expr {$selectedline + $dir * $lpp}]
4831 if {$l < 0} {
4832 set l 0
4833 } elseif {$l >= $numcommits} {
4834 set l [expr $numcommits - 1]
4836 unmarkmatches
4837 selectline $l 1
4840 proc unselectline {} {
4841 global selectedline currentid
4843 catch {unset selectedline}
4844 catch {unset currentid}
4845 allcanvs delete secsel
4846 rhighlight_none
4849 proc reselectline {} {
4850 global selectedline
4852 if {[info exists selectedline]} {
4853 selectline $selectedline 0
4857 proc addtohistory {cmd} {
4858 global history historyindex curview
4860 set elt [list $curview $cmd]
4861 if {$historyindex > 0
4862 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4863 return
4866 if {$historyindex < [llength $history]} {
4867 set history [lreplace $history $historyindex end $elt]
4868 } else {
4869 lappend history $elt
4871 incr historyindex
4872 if {$historyindex > 1} {
4873 .tf.bar.leftbut conf -state normal
4874 } else {
4875 .tf.bar.leftbut conf -state disabled
4877 .tf.bar.rightbut conf -state disabled
4880 proc godo {elt} {
4881 global curview
4883 set view [lindex $elt 0]
4884 set cmd [lindex $elt 1]
4885 if {$curview != $view} {
4886 showview $view
4888 eval $cmd
4891 proc goback {} {
4892 global history historyindex
4893 focus .
4895 if {$historyindex > 1} {
4896 incr historyindex -1
4897 godo [lindex $history [expr {$historyindex - 1}]]
4898 .tf.bar.rightbut conf -state normal
4900 if {$historyindex <= 1} {
4901 .tf.bar.leftbut conf -state disabled
4905 proc goforw {} {
4906 global history historyindex
4907 focus .
4909 if {$historyindex < [llength $history]} {
4910 set cmd [lindex $history $historyindex]
4911 incr historyindex
4912 godo $cmd
4913 .tf.bar.leftbut conf -state normal
4915 if {$historyindex >= [llength $history]} {
4916 .tf.bar.rightbut conf -state disabled
4920 proc gettree {id} {
4921 global treefilelist treeidlist diffids diffmergeid treepending
4922 global nullid nullid2
4924 set diffids $id
4925 catch {unset diffmergeid}
4926 if {![info exists treefilelist($id)]} {
4927 if {![info exists treepending]} {
4928 if {$id eq $nullid} {
4929 set cmd [list | git ls-files]
4930 } elseif {$id eq $nullid2} {
4931 set cmd [list | git ls-files --stage -t]
4932 } else {
4933 set cmd [list | git ls-tree -r $id]
4935 if {[catch {set gtf [open $cmd r]}]} {
4936 return
4938 set treepending $id
4939 set treefilelist($id) {}
4940 set treeidlist($id) {}
4941 fconfigure $gtf -blocking 0
4942 filerun $gtf [list gettreeline $gtf $id]
4944 } else {
4945 setfilelist $id
4949 proc gettreeline {gtf id} {
4950 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4952 set nl 0
4953 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4954 if {$diffids eq $nullid} {
4955 set fname $line
4956 } else {
4957 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4958 set i [string first "\t" $line]
4959 if {$i < 0} continue
4960 set sha1 [lindex $line 2]
4961 set fname [string range $line [expr {$i+1}] end]
4962 if {[string index $fname 0] eq "\""} {
4963 set fname [lindex $fname 0]
4965 lappend treeidlist($id) $sha1
4967 lappend treefilelist($id) $fname
4969 if {![eof $gtf]} {
4970 return [expr {$nl >= 1000? 2: 1}]
4972 close $gtf
4973 unset treepending
4974 if {$cmitmode ne "tree"} {
4975 if {![info exists diffmergeid]} {
4976 gettreediffs $diffids
4978 } elseif {$id ne $diffids} {
4979 gettree $diffids
4980 } else {
4981 setfilelist $id
4983 return 0
4986 proc showfile {f} {
4987 global treefilelist treeidlist diffids nullid nullid2
4988 global ctext commentend
4990 set i [lsearch -exact $treefilelist($diffids) $f]
4991 if {$i < 0} {
4992 puts "oops, $f not in list for id $diffids"
4993 return
4995 if {$diffids eq $nullid} {
4996 if {[catch {set bf [open $f r]} err]} {
4997 puts "oops, can't read $f: $err"
4998 return
5000 } else {
5001 set blob [lindex $treeidlist($diffids) $i]
5002 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5003 puts "oops, error reading blob $blob: $err"
5004 return
5007 fconfigure $bf -blocking 0
5008 filerun $bf [list getblobline $bf $diffids]
5009 $ctext config -state normal
5010 clear_ctext $commentend
5011 $ctext insert end "\n"
5012 $ctext insert end "$f\n" filesep
5013 $ctext config -state disabled
5014 $ctext yview $commentend
5015 settabs 0
5018 proc getblobline {bf id} {
5019 global diffids cmitmode ctext
5021 if {$id ne $diffids || $cmitmode ne "tree"} {
5022 catch {close $bf}
5023 return 0
5025 $ctext config -state normal
5026 set nl 0
5027 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5028 $ctext insert end "$line\n"
5030 if {[eof $bf]} {
5031 # delete last newline
5032 $ctext delete "end - 2c" "end - 1c"
5033 close $bf
5034 return 0
5036 $ctext config -state disabled
5037 return [expr {$nl >= 1000? 2: 1}]
5040 proc mergediff {id l} {
5041 global diffmergeid mdifffd
5042 global diffids
5043 global diffcontext
5044 global parentlist
5045 global limitdiffs viewfiles curview
5047 set diffmergeid $id
5048 set diffids $id
5049 # this doesn't seem to actually affect anything...
5050 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5051 if {$limitdiffs && $viewfiles($curview) ne {}} {
5052 set cmd [concat $cmd -- $viewfiles($curview)]
5054 if {[catch {set mdf [open $cmd r]} err]} {
5055 error_popup "[mc "Error getting merge diffs:"] $err"
5056 return
5058 fconfigure $mdf -blocking 0
5059 set mdifffd($id) $mdf
5060 set np [llength [lindex $parentlist $l]]
5061 settabs $np
5062 filerun $mdf [list getmergediffline $mdf $id $np]
5065 proc getmergediffline {mdf id np} {
5066 global diffmergeid ctext cflist mergemax
5067 global difffilestart mdifffd
5069 $ctext conf -state normal
5070 set nr 0
5071 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5072 if {![info exists diffmergeid] || $id != $diffmergeid
5073 || $mdf != $mdifffd($id)} {
5074 close $mdf
5075 return 0
5077 if {[regexp {^diff --cc (.*)} $line match fname]} {
5078 # start of a new file
5079 $ctext insert end "\n"
5080 set here [$ctext index "end - 1c"]
5081 lappend difffilestart $here
5082 add_flist [list $fname]
5083 set l [expr {(78 - [string length $fname]) / 2}]
5084 set pad [string range "----------------------------------------" 1 $l]
5085 $ctext insert end "$pad $fname $pad\n" filesep
5086 } elseif {[regexp {^@@} $line]} {
5087 $ctext insert end "$line\n" hunksep
5088 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5089 # do nothing
5090 } else {
5091 # parse the prefix - one ' ', '-' or '+' for each parent
5092 set spaces {}
5093 set minuses {}
5094 set pluses {}
5095 set isbad 0
5096 for {set j 0} {$j < $np} {incr j} {
5097 set c [string range $line $j $j]
5098 if {$c == " "} {
5099 lappend spaces $j
5100 } elseif {$c == "-"} {
5101 lappend minuses $j
5102 } elseif {$c == "+"} {
5103 lappend pluses $j
5104 } else {
5105 set isbad 1
5106 break
5109 set tags {}
5110 set num {}
5111 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5112 # line doesn't appear in result, parents in $minuses have the line
5113 set num [lindex $minuses 0]
5114 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5115 # line appears in result, parents in $pluses don't have the line
5116 lappend tags mresult
5117 set num [lindex $spaces 0]
5119 if {$num ne {}} {
5120 if {$num >= $mergemax} {
5121 set num "max"
5123 lappend tags m$num
5125 $ctext insert end "$line\n" $tags
5128 $ctext conf -state disabled
5129 if {[eof $mdf]} {
5130 close $mdf
5131 return 0
5133 return [expr {$nr >= 1000? 2: 1}]
5136 proc startdiff {ids} {
5137 global treediffs diffids treepending diffmergeid nullid nullid2
5139 settabs 1
5140 set diffids $ids
5141 catch {unset diffmergeid}
5142 if {![info exists treediffs($ids)] ||
5143 [lsearch -exact $ids $nullid] >= 0 ||
5144 [lsearch -exact $ids $nullid2] >= 0} {
5145 if {![info exists treepending]} {
5146 gettreediffs $ids
5148 } else {
5149 addtocflist $ids
5153 proc path_filter {filter name} {
5154 foreach p $filter {
5155 set l [string length $p]
5156 if {[string index $p end] eq "/"} {
5157 if {[string compare -length $l $p $name] == 0} {
5158 return 1
5160 } else {
5161 if {[string compare -length $l $p $name] == 0 &&
5162 ([string length $name] == $l ||
5163 [string index $name $l] eq "/")} {
5164 return 1
5168 return 0
5171 proc addtocflist {ids} {
5172 global treediffs
5174 add_flist $treediffs($ids)
5175 getblobdiffs $ids
5178 proc diffcmd {ids flags} {
5179 global nullid nullid2
5181 set i [lsearch -exact $ids $nullid]
5182 set j [lsearch -exact $ids $nullid2]
5183 if {$i >= 0} {
5184 if {[llength $ids] > 1 && $j < 0} {
5185 # comparing working directory with some specific revision
5186 set cmd [concat | git diff-index $flags]
5187 if {$i == 0} {
5188 lappend cmd -R [lindex $ids 1]
5189 } else {
5190 lappend cmd [lindex $ids 0]
5192 } else {
5193 # comparing working directory with index
5194 set cmd [concat | git diff-files $flags]
5195 if {$j == 1} {
5196 lappend cmd -R
5199 } elseif {$j >= 0} {
5200 set cmd [concat | git diff-index --cached $flags]
5201 if {[llength $ids] > 1} {
5202 # comparing index with specific revision
5203 if {$i == 0} {
5204 lappend cmd -R [lindex $ids 1]
5205 } else {
5206 lappend cmd [lindex $ids 0]
5208 } else {
5209 # comparing index with HEAD
5210 lappend cmd HEAD
5212 } else {
5213 set cmd [concat | git diff-tree -r $flags $ids]
5215 return $cmd
5218 proc gettreediffs {ids} {
5219 global treediff treepending
5221 set treepending $ids
5222 set treediff {}
5223 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5224 fconfigure $gdtf -blocking 0
5225 filerun $gdtf [list gettreediffline $gdtf $ids]
5228 proc gettreediffline {gdtf ids} {
5229 global treediff treediffs treepending diffids diffmergeid
5230 global cmitmode viewfiles curview limitdiffs
5232 set nr 0
5233 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5234 set i [string first "\t" $line]
5235 if {$i >= 0} {
5236 set file [string range $line [expr {$i+1}] end]
5237 if {[string index $file 0] eq "\""} {
5238 set file [lindex $file 0]
5240 lappend treediff $file
5243 if {![eof $gdtf]} {
5244 return [expr {$nr >= 1000? 2: 1}]
5246 close $gdtf
5247 if {$limitdiffs && $viewfiles($curview) ne {}} {
5248 set flist {}
5249 foreach f $treediff {
5250 if {[path_filter $viewfiles($curview) $f]} {
5251 lappend flist $f
5254 set treediffs($ids) $flist
5255 } else {
5256 set treediffs($ids) $treediff
5258 unset treepending
5259 if {$cmitmode eq "tree"} {
5260 gettree $diffids
5261 } elseif {$ids != $diffids} {
5262 if {![info exists diffmergeid]} {
5263 gettreediffs $diffids
5265 } else {
5266 addtocflist $ids
5268 return 0
5271 # empty string or positive integer
5272 proc diffcontextvalidate {v} {
5273 return [regexp {^(|[1-9][0-9]*)$} $v]
5276 proc diffcontextchange {n1 n2 op} {
5277 global diffcontextstring diffcontext
5279 if {[string is integer -strict $diffcontextstring]} {
5280 if {$diffcontextstring > 0} {
5281 set diffcontext $diffcontextstring
5282 reselectline
5287 proc changeignorespace {} {
5288 reselectline
5291 proc getblobdiffs {ids} {
5292 global blobdifffd diffids env
5293 global diffinhdr treediffs
5294 global diffcontext
5295 global ignorespace
5296 global limitdiffs viewfiles curview
5298 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5299 if {$ignorespace} {
5300 append cmd " -w"
5302 if {$limitdiffs && $viewfiles($curview) ne {}} {
5303 set cmd [concat $cmd -- $viewfiles($curview)]
5305 if {[catch {set bdf [open $cmd r]} err]} {
5306 puts "error getting diffs: $err"
5307 return
5309 set diffinhdr 0
5310 fconfigure $bdf -blocking 0
5311 set blobdifffd($ids) $bdf
5312 filerun $bdf [list getblobdiffline $bdf $diffids]
5315 proc setinlist {var i val} {
5316 global $var
5318 while {[llength [set $var]] < $i} {
5319 lappend $var {}
5321 if {[llength [set $var]] == $i} {
5322 lappend $var $val
5323 } else {
5324 lset $var $i $val
5328 proc makediffhdr {fname ids} {
5329 global ctext curdiffstart treediffs
5331 set i [lsearch -exact $treediffs($ids) $fname]
5332 if {$i >= 0} {
5333 setinlist difffilestart $i $curdiffstart
5335 set l [expr {(78 - [string length $fname]) / 2}]
5336 set pad [string range "----------------------------------------" 1 $l]
5337 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5340 proc getblobdiffline {bdf ids} {
5341 global diffids blobdifffd ctext curdiffstart
5342 global diffnexthead diffnextnote difffilestart
5343 global diffinhdr treediffs
5345 set nr 0
5346 $ctext conf -state normal
5347 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5348 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5349 close $bdf
5350 return 0
5352 if {![string compare -length 11 "diff --git " $line]} {
5353 # trim off "diff --git "
5354 set line [string range $line 11 end]
5355 set diffinhdr 1
5356 # start of a new file
5357 $ctext insert end "\n"
5358 set curdiffstart [$ctext index "end - 1c"]
5359 $ctext insert end "\n" filesep
5360 # If the name hasn't changed the length will be odd,
5361 # the middle char will be a space, and the two bits either
5362 # side will be a/name and b/name, or "a/name" and "b/name".
5363 # If the name has changed we'll get "rename from" and
5364 # "rename to" or "copy from" and "copy to" lines following this,
5365 # and we'll use them to get the filenames.
5366 # This complexity is necessary because spaces in the filename(s)
5367 # don't get escaped.
5368 set l [string length $line]
5369 set i [expr {$l / 2}]
5370 if {!(($l & 1) && [string index $line $i] eq " " &&
5371 [string range $line 2 [expr {$i - 1}]] eq \
5372 [string range $line [expr {$i + 3}] end])} {
5373 continue
5375 # unescape if quoted and chop off the a/ from the front
5376 if {[string index $line 0] eq "\""} {
5377 set fname [string range [lindex $line 0] 2 end]
5378 } else {
5379 set fname [string range $line 2 [expr {$i - 1}]]
5381 makediffhdr $fname $ids
5383 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5384 $line match f1l f1c f2l f2c rest]} {
5385 $ctext insert end "$line\n" hunksep
5386 set diffinhdr 0
5388 } elseif {$diffinhdr} {
5389 if {![string compare -length 12 "rename from " $line]} {
5390 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5391 if {[string index $fname 0] eq "\""} {
5392 set fname [lindex $fname 0]
5394 set i [lsearch -exact $treediffs($ids) $fname]
5395 if {$i >= 0} {
5396 setinlist difffilestart $i $curdiffstart
5398 } elseif {![string compare -length 10 $line "rename to "] ||
5399 ![string compare -length 8 $line "copy to "]} {
5400 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5401 if {[string index $fname 0] eq "\""} {
5402 set fname [lindex $fname 0]
5404 makediffhdr $fname $ids
5405 } elseif {[string compare -length 3 $line "---"] == 0} {
5406 # do nothing
5407 continue
5408 } elseif {[string compare -length 3 $line "+++"] == 0} {
5409 set diffinhdr 0
5410 continue
5412 $ctext insert end "$line\n" filesep
5414 } else {
5415 set x [string range $line 0 0]
5416 if {$x == "-" || $x == "+"} {
5417 set tag [expr {$x == "+"}]
5418 $ctext insert end "$line\n" d$tag
5419 } elseif {$x == " "} {
5420 $ctext insert end "$line\n"
5421 } else {
5422 # "\ No newline at end of file",
5423 # or something else we don't recognize
5424 $ctext insert end "$line\n" hunksep
5428 $ctext conf -state disabled
5429 if {[eof $bdf]} {
5430 close $bdf
5431 return 0
5433 return [expr {$nr >= 1000? 2: 1}]
5436 proc changediffdisp {} {
5437 global ctext diffelide
5439 $ctext tag conf d0 -elide [lindex $diffelide 0]
5440 $ctext tag conf d1 -elide [lindex $diffelide 1]
5443 proc prevfile {} {
5444 global difffilestart ctext
5445 set prev [lindex $difffilestart 0]
5446 set here [$ctext index @0,0]
5447 foreach loc $difffilestart {
5448 if {[$ctext compare $loc >= $here]} {
5449 $ctext yview $prev
5450 return
5452 set prev $loc
5454 $ctext yview $prev
5457 proc nextfile {} {
5458 global difffilestart ctext
5459 set here [$ctext index @0,0]
5460 foreach loc $difffilestart {
5461 if {[$ctext compare $loc > $here]} {
5462 $ctext yview $loc
5463 return
5468 proc clear_ctext {{first 1.0}} {
5469 global ctext smarktop smarkbot
5470 global pendinglinks
5472 set l [lindex [split $first .] 0]
5473 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5474 set smarktop $l
5476 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5477 set smarkbot $l
5479 $ctext delete $first end
5480 if {$first eq "1.0"} {
5481 catch {unset pendinglinks}
5485 proc settabs {{firstab {}}} {
5486 global firsttabstop tabstop ctext have_tk85
5488 if {$firstab ne {} && $have_tk85} {
5489 set firsttabstop $firstab
5491 set w [font measure textfont "0"]
5492 if {$firsttabstop != 0} {
5493 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5494 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5495 } elseif {$have_tk85 || $tabstop != 8} {
5496 $ctext conf -tabs [expr {$tabstop * $w}]
5497 } else {
5498 $ctext conf -tabs {}
5502 proc incrsearch {name ix op} {
5503 global ctext searchstring searchdirn
5505 $ctext tag remove found 1.0 end
5506 if {[catch {$ctext index anchor}]} {
5507 # no anchor set, use start of selection, or of visible area
5508 set sel [$ctext tag ranges sel]
5509 if {$sel ne {}} {
5510 $ctext mark set anchor [lindex $sel 0]
5511 } elseif {$searchdirn eq "-forwards"} {
5512 $ctext mark set anchor @0,0
5513 } else {
5514 $ctext mark set anchor @0,[winfo height $ctext]
5517 if {$searchstring ne {}} {
5518 set here [$ctext search $searchdirn -- $searchstring anchor]
5519 if {$here ne {}} {
5520 $ctext see $here
5522 searchmarkvisible 1
5526 proc dosearch {} {
5527 global sstring ctext searchstring searchdirn
5529 focus $sstring
5530 $sstring icursor end
5531 set searchdirn -forwards
5532 if {$searchstring ne {}} {
5533 set sel [$ctext tag ranges sel]
5534 if {$sel ne {}} {
5535 set start "[lindex $sel 0] + 1c"
5536 } elseif {[catch {set start [$ctext index anchor]}]} {
5537 set start "@0,0"
5539 set match [$ctext search -count mlen -- $searchstring $start]
5540 $ctext tag remove sel 1.0 end
5541 if {$match eq {}} {
5542 bell
5543 return
5545 $ctext see $match
5546 set mend "$match + $mlen c"
5547 $ctext tag add sel $match $mend
5548 $ctext mark unset anchor
5552 proc dosearchback {} {
5553 global sstring ctext searchstring searchdirn
5555 focus $sstring
5556 $sstring icursor end
5557 set searchdirn -backwards
5558 if {$searchstring ne {}} {
5559 set sel [$ctext tag ranges sel]
5560 if {$sel ne {}} {
5561 set start [lindex $sel 0]
5562 } elseif {[catch {set start [$ctext index anchor]}]} {
5563 set start @0,[winfo height $ctext]
5565 set match [$ctext search -backwards -count ml -- $searchstring $start]
5566 $ctext tag remove sel 1.0 end
5567 if {$match eq {}} {
5568 bell
5569 return
5571 $ctext see $match
5572 set mend "$match + $ml c"
5573 $ctext tag add sel $match $mend
5574 $ctext mark unset anchor
5578 proc searchmark {first last} {
5579 global ctext searchstring
5581 set mend $first.0
5582 while {1} {
5583 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5584 if {$match eq {}} break
5585 set mend "$match + $mlen c"
5586 $ctext tag add found $match $mend
5590 proc searchmarkvisible {doall} {
5591 global ctext smarktop smarkbot
5593 set topline [lindex [split [$ctext index @0,0] .] 0]
5594 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5595 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5596 # no overlap with previous
5597 searchmark $topline $botline
5598 set smarktop $topline
5599 set smarkbot $botline
5600 } else {
5601 if {$topline < $smarktop} {
5602 searchmark $topline [expr {$smarktop-1}]
5603 set smarktop $topline
5605 if {$botline > $smarkbot} {
5606 searchmark [expr {$smarkbot+1}] $botline
5607 set smarkbot $botline
5612 proc scrolltext {f0 f1} {
5613 global searchstring
5615 .bleft.sb set $f0 $f1
5616 if {$searchstring ne {}} {
5617 searchmarkvisible 0
5621 proc setcoords {} {
5622 global linespc charspc canvx0 canvy0
5623 global xspc1 xspc2 lthickness
5625 set linespc [font metrics mainfont -linespace]
5626 set charspc [font measure mainfont "m"]
5627 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5628 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5629 set lthickness [expr {int($linespc / 9) + 1}]
5630 set xspc1(0) $linespc
5631 set xspc2 $linespc
5634 proc redisplay {} {
5635 global canv
5636 global selectedline
5638 set ymax [lindex [$canv cget -scrollregion] 3]
5639 if {$ymax eq {} || $ymax == 0} return
5640 set span [$canv yview]
5641 clear_display
5642 setcanvscroll
5643 allcanvs yview moveto [lindex $span 0]
5644 drawvisible
5645 if {[info exists selectedline]} {
5646 selectline $selectedline 0
5647 allcanvs yview moveto [lindex $span 0]
5651 proc parsefont {f n} {
5652 global fontattr
5654 set fontattr($f,family) [lindex $n 0]
5655 set s [lindex $n 1]
5656 if {$s eq {} || $s == 0} {
5657 set s 10
5658 } elseif {$s < 0} {
5659 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5661 set fontattr($f,size) $s
5662 set fontattr($f,weight) normal
5663 set fontattr($f,slant) roman
5664 foreach style [lrange $n 2 end] {
5665 switch -- $style {
5666 "normal" -
5667 "bold" {set fontattr($f,weight) $style}
5668 "roman" -
5669 "italic" {set fontattr($f,slant) $style}
5674 proc fontflags {f {isbold 0}} {
5675 global fontattr
5677 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5678 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5679 -slant $fontattr($f,slant)]
5682 proc fontname {f} {
5683 global fontattr
5685 set n [list $fontattr($f,family) $fontattr($f,size)]
5686 if {$fontattr($f,weight) eq "bold"} {
5687 lappend n "bold"
5689 if {$fontattr($f,slant) eq "italic"} {
5690 lappend n "italic"
5692 return $n
5695 proc incrfont {inc} {
5696 global mainfont textfont ctext canv phase cflist showrefstop
5697 global stopped entries fontattr
5699 unmarkmatches
5700 set s $fontattr(mainfont,size)
5701 incr s $inc
5702 if {$s < 1} {
5703 set s 1
5705 set fontattr(mainfont,size) $s
5706 font config mainfont -size $s
5707 font config mainfontbold -size $s
5708 set mainfont [fontname mainfont]
5709 set s $fontattr(textfont,size)
5710 incr s $inc
5711 if {$s < 1} {
5712 set s 1
5714 set fontattr(textfont,size) $s
5715 font config textfont -size $s
5716 font config textfontbold -size $s
5717 set textfont [fontname textfont]
5718 setcoords
5719 settabs
5720 redisplay
5723 proc clearsha1 {} {
5724 global sha1entry sha1string
5725 if {[string length $sha1string] == 40} {
5726 $sha1entry delete 0 end
5730 proc sha1change {n1 n2 op} {
5731 global sha1string currentid sha1but
5732 if {$sha1string == {}
5733 || ([info exists currentid] && $sha1string == $currentid)} {
5734 set state disabled
5735 } else {
5736 set state normal
5738 if {[$sha1but cget -state] == $state} return
5739 if {$state == "normal"} {
5740 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5741 } else {
5742 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5746 proc gotocommit {} {
5747 global sha1string currentid commitrow tagids headids
5748 global displayorder numcommits curview
5750 if {$sha1string == {}
5751 || ([info exists currentid] && $sha1string == $currentid)} return
5752 if {[info exists tagids($sha1string)]} {
5753 set id $tagids($sha1string)
5754 } elseif {[info exists headids($sha1string)]} {
5755 set id $headids($sha1string)
5756 } else {
5757 set id [string tolower $sha1string]
5758 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5759 set matches {}
5760 foreach i $displayorder {
5761 if {[string match $id* $i]} {
5762 lappend matches $i
5765 if {$matches ne {}} {
5766 if {[llength $matches] > 1} {
5767 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5768 return
5770 set id [lindex $matches 0]
5774 if {[info exists commitrow($curview,$id)]} {
5775 selectline $commitrow($curview,$id) 1
5776 return
5778 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5779 set msg [mc "SHA1 id %s is not known" $sha1string]
5780 } else {
5781 set msg [mc "Tag/Head %s is not known" $sha1string]
5783 error_popup $msg
5786 proc lineenter {x y id} {
5787 global hoverx hovery hoverid hovertimer
5788 global commitinfo canv
5790 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5791 set hoverx $x
5792 set hovery $y
5793 set hoverid $id
5794 if {[info exists hovertimer]} {
5795 after cancel $hovertimer
5797 set hovertimer [after 500 linehover]
5798 $canv delete hover
5801 proc linemotion {x y id} {
5802 global hoverx hovery hoverid hovertimer
5804 if {[info exists hoverid] && $id == $hoverid} {
5805 set hoverx $x
5806 set hovery $y
5807 if {[info exists hovertimer]} {
5808 after cancel $hovertimer
5810 set hovertimer [after 500 linehover]
5814 proc lineleave {id} {
5815 global hoverid hovertimer canv
5817 if {[info exists hoverid] && $id == $hoverid} {
5818 $canv delete hover
5819 if {[info exists hovertimer]} {
5820 after cancel $hovertimer
5821 unset hovertimer
5823 unset hoverid
5827 proc linehover {} {
5828 global hoverx hovery hoverid hovertimer
5829 global canv linespc lthickness
5830 global commitinfo
5832 set text [lindex $commitinfo($hoverid) 0]
5833 set ymax [lindex [$canv cget -scrollregion] 3]
5834 if {$ymax == {}} return
5835 set yfrac [lindex [$canv yview] 0]
5836 set x [expr {$hoverx + 2 * $linespc}]
5837 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5838 set x0 [expr {$x - 2 * $lthickness}]
5839 set y0 [expr {$y - 2 * $lthickness}]
5840 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5841 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5842 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5843 -fill \#ffff80 -outline black -width 1 -tags hover]
5844 $canv raise $t
5845 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5846 -font mainfont]
5847 $canv raise $t
5850 proc clickisonarrow {id y} {
5851 global lthickness
5853 set ranges [rowranges $id]
5854 set thresh [expr {2 * $lthickness + 6}]
5855 set n [expr {[llength $ranges] - 1}]
5856 for {set i 1} {$i < $n} {incr i} {
5857 set row [lindex $ranges $i]
5858 if {abs([yc $row] - $y) < $thresh} {
5859 return $i
5862 return {}
5865 proc arrowjump {id n y} {
5866 global canv
5868 # 1 <-> 2, 3 <-> 4, etc...
5869 set n [expr {(($n - 1) ^ 1) + 1}]
5870 set row [lindex [rowranges $id] $n]
5871 set yt [yc $row]
5872 set ymax [lindex [$canv cget -scrollregion] 3]
5873 if {$ymax eq {} || $ymax <= 0} return
5874 set view [$canv yview]
5875 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5876 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5877 if {$yfrac < 0} {
5878 set yfrac 0
5880 allcanvs yview moveto $yfrac
5883 proc lineclick {x y id isnew} {
5884 global ctext commitinfo children canv thickerline curview commitrow
5886 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5887 unmarkmatches
5888 unselectline
5889 normalline
5890 $canv delete hover
5891 # draw this line thicker than normal
5892 set thickerline $id
5893 drawlines $id
5894 if {$isnew} {
5895 set ymax [lindex [$canv cget -scrollregion] 3]
5896 if {$ymax eq {}} return
5897 set yfrac [lindex [$canv yview] 0]
5898 set y [expr {$y + $yfrac * $ymax}]
5900 set dirn [clickisonarrow $id $y]
5901 if {$dirn ne {}} {
5902 arrowjump $id $dirn $y
5903 return
5906 if {$isnew} {
5907 addtohistory [list lineclick $x $y $id 0]
5909 # fill the details pane with info about this line
5910 $ctext conf -state normal
5911 clear_ctext
5912 settabs 0
5913 $ctext insert end "[mc "Parent"]:\t"
5914 $ctext insert end $id link0
5915 setlink $id link0
5916 set info $commitinfo($id)
5917 $ctext insert end "\n\t[lindex $info 0]\n"
5918 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5919 set date [formatdate [lindex $info 2]]
5920 $ctext insert end "\t[mc "Date"]:\t$date\n"
5921 set kids $children($curview,$id)
5922 if {$kids ne {}} {
5923 $ctext insert end "\n[mc "Children"]:"
5924 set i 0
5925 foreach child $kids {
5926 incr i
5927 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5928 set info $commitinfo($child)
5929 $ctext insert end "\n\t"
5930 $ctext insert end $child link$i
5931 setlink $child link$i
5932 $ctext insert end "\n\t[lindex $info 0]"
5933 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5934 set date [formatdate [lindex $info 2]]
5935 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5938 $ctext conf -state disabled
5939 init_flist {}
5942 proc normalline {} {
5943 global thickerline
5944 if {[info exists thickerline]} {
5945 set id $thickerline
5946 unset thickerline
5947 drawlines $id
5951 proc selbyid {id} {
5952 global commitrow curview
5953 if {[info exists commitrow($curview,$id)]} {
5954 selectline $commitrow($curview,$id) 1
5958 proc mstime {} {
5959 global startmstime
5960 if {![info exists startmstime]} {
5961 set startmstime [clock clicks -milliseconds]
5963 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5966 proc rowmenu {x y id} {
5967 global rowctxmenu commitrow selectedline rowmenuid curview
5968 global nullid nullid2 fakerowmenu mainhead
5970 stopfinding
5971 set rowmenuid $id
5972 if {![info exists selectedline]
5973 || $commitrow($curview,$id) eq $selectedline} {
5974 set state disabled
5975 } else {
5976 set state normal
5978 if {$id ne $nullid && $id ne $nullid2} {
5979 set menu $rowctxmenu
5980 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
5981 } else {
5982 set menu $fakerowmenu
5984 $menu entryconfigure [mc "Diff this -> selected"] -state $state
5985 $menu entryconfigure [mc "Diff selected -> this"] -state $state
5986 $menu entryconfigure [mc "Make patch"] -state $state
5987 tk_popup $menu $x $y
5990 proc diffvssel {dirn} {
5991 global rowmenuid selectedline displayorder
5993 if {![info exists selectedline]} return
5994 if {$dirn} {
5995 set oldid [lindex $displayorder $selectedline]
5996 set newid $rowmenuid
5997 } else {
5998 set oldid $rowmenuid
5999 set newid [lindex $displayorder $selectedline]
6001 addtohistory [list doseldiff $oldid $newid]
6002 doseldiff $oldid $newid
6005 proc doseldiff {oldid newid} {
6006 global ctext
6007 global commitinfo
6009 $ctext conf -state normal
6010 clear_ctext
6011 init_flist [mc "Top"]
6012 $ctext insert end "[mc "From"] "
6013 $ctext insert end $oldid link0
6014 setlink $oldid link0
6015 $ctext insert end "\n "
6016 $ctext insert end [lindex $commitinfo($oldid) 0]
6017 $ctext insert end "\n\n[mc "To"] "
6018 $ctext insert end $newid link1
6019 setlink $newid link1
6020 $ctext insert end "\n "
6021 $ctext insert end [lindex $commitinfo($newid) 0]
6022 $ctext insert end "\n"
6023 $ctext conf -state disabled
6024 $ctext tag remove found 1.0 end
6025 startdiff [list $oldid $newid]
6028 proc mkpatch {} {
6029 global rowmenuid currentid commitinfo patchtop patchnum
6031 if {![info exists currentid]} return
6032 set oldid $currentid
6033 set oldhead [lindex $commitinfo($oldid) 0]
6034 set newid $rowmenuid
6035 set newhead [lindex $commitinfo($newid) 0]
6036 set top .patch
6037 set patchtop $top
6038 catch {destroy $top}
6039 toplevel $top
6040 label $top.title -text [mc "Generate patch"]
6041 grid $top.title - -pady 10
6042 label $top.from -text [mc "From:"]
6043 entry $top.fromsha1 -width 40 -relief flat
6044 $top.fromsha1 insert 0 $oldid
6045 $top.fromsha1 conf -state readonly
6046 grid $top.from $top.fromsha1 -sticky w
6047 entry $top.fromhead -width 60 -relief flat
6048 $top.fromhead insert 0 $oldhead
6049 $top.fromhead conf -state readonly
6050 grid x $top.fromhead -sticky w
6051 label $top.to -text [mc "To:"]
6052 entry $top.tosha1 -width 40 -relief flat
6053 $top.tosha1 insert 0 $newid
6054 $top.tosha1 conf -state readonly
6055 grid $top.to $top.tosha1 -sticky w
6056 entry $top.tohead -width 60 -relief flat
6057 $top.tohead insert 0 $newhead
6058 $top.tohead conf -state readonly
6059 grid x $top.tohead -sticky w
6060 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6061 grid $top.rev x -pady 10
6062 label $top.flab -text [mc "Output file:"]
6063 entry $top.fname -width 60
6064 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6065 incr patchnum
6066 grid $top.flab $top.fname -sticky w
6067 frame $top.buts
6068 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6069 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6070 grid $top.buts.gen $top.buts.can
6071 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6072 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6073 grid $top.buts - -pady 10 -sticky ew
6074 focus $top.fname
6077 proc mkpatchrev {} {
6078 global patchtop
6080 set oldid [$patchtop.fromsha1 get]
6081 set oldhead [$patchtop.fromhead get]
6082 set newid [$patchtop.tosha1 get]
6083 set newhead [$patchtop.tohead get]
6084 foreach e [list fromsha1 fromhead tosha1 tohead] \
6085 v [list $newid $newhead $oldid $oldhead] {
6086 $patchtop.$e conf -state normal
6087 $patchtop.$e delete 0 end
6088 $patchtop.$e insert 0 $v
6089 $patchtop.$e conf -state readonly
6093 proc mkpatchgo {} {
6094 global patchtop nullid nullid2
6096 set oldid [$patchtop.fromsha1 get]
6097 set newid [$patchtop.tosha1 get]
6098 set fname [$patchtop.fname get]
6099 set cmd [diffcmd [list $oldid $newid] -p]
6100 # trim off the initial "|"
6101 set cmd [lrange $cmd 1 end]
6102 lappend cmd >$fname &
6103 if {[catch {eval exec $cmd} err]} {
6104 error_popup "[mc "Error creating patch:"] $err"
6106 catch {destroy $patchtop}
6107 unset patchtop
6110 proc mkpatchcan {} {
6111 global patchtop
6113 catch {destroy $patchtop}
6114 unset patchtop
6117 proc mktag {} {
6118 global rowmenuid mktagtop commitinfo
6120 set top .maketag
6121 set mktagtop $top
6122 catch {destroy $top}
6123 toplevel $top
6124 label $top.title -text [mc "Create tag"]
6125 grid $top.title - -pady 10
6126 label $top.id -text [mc "ID:"]
6127 entry $top.sha1 -width 40 -relief flat
6128 $top.sha1 insert 0 $rowmenuid
6129 $top.sha1 conf -state readonly
6130 grid $top.id $top.sha1 -sticky w
6131 entry $top.head -width 60 -relief flat
6132 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6133 $top.head conf -state readonly
6134 grid x $top.head -sticky w
6135 label $top.tlab -text [mc "Tag name:"]
6136 entry $top.tag -width 60
6137 grid $top.tlab $top.tag -sticky w
6138 frame $top.buts
6139 button $top.buts.gen -text [mc "Create"] -command mktaggo
6140 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6141 grid $top.buts.gen $top.buts.can
6142 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6143 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6144 grid $top.buts - -pady 10 -sticky ew
6145 focus $top.tag
6148 proc domktag {} {
6149 global mktagtop env tagids idtags
6151 set id [$mktagtop.sha1 get]
6152 set tag [$mktagtop.tag get]
6153 if {$tag == {}} {
6154 error_popup [mc "No tag name specified"]
6155 return
6157 if {[info exists tagids($tag)]} {
6158 error_popup [mc "Tag \"%s\" already exists" $tag]
6159 return
6161 if {[catch {
6162 exec git tag $tag $id
6163 } err]} {
6164 error_popup "[mc "Error creating tag:"] $err"
6165 return
6168 set tagids($tag) $id
6169 lappend idtags($id) $tag
6170 redrawtags $id
6171 addedtag $id
6172 dispneartags 0
6173 run refill_reflist
6176 proc redrawtags {id} {
6177 global canv linehtag commitrow idpos selectedline curview
6178 global canvxmax iddrawn
6180 if {![info exists commitrow($curview,$id)]} return
6181 if {![info exists iddrawn($id)]} return
6182 drawcommits $commitrow($curview,$id)
6183 $canv delete tag.$id
6184 set xt [eval drawtags $id $idpos($id)]
6185 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6186 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6187 set xr [expr {$xt + [font measure mainfont $text]}]
6188 if {$xr > $canvxmax} {
6189 set canvxmax $xr
6190 setcanvscroll
6192 if {[info exists selectedline]
6193 && $selectedline == $commitrow($curview,$id)} {
6194 selectline $selectedline 0
6198 proc mktagcan {} {
6199 global mktagtop
6201 catch {destroy $mktagtop}
6202 unset mktagtop
6205 proc mktaggo {} {
6206 domktag
6207 mktagcan
6210 proc writecommit {} {
6211 global rowmenuid wrcomtop commitinfo wrcomcmd
6213 set top .writecommit
6214 set wrcomtop $top
6215 catch {destroy $top}
6216 toplevel $top
6217 label $top.title -text [mc "Write commit to file"]
6218 grid $top.title - -pady 10
6219 label $top.id -text [mc "ID:"]
6220 entry $top.sha1 -width 40 -relief flat
6221 $top.sha1 insert 0 $rowmenuid
6222 $top.sha1 conf -state readonly
6223 grid $top.id $top.sha1 -sticky w
6224 entry $top.head -width 60 -relief flat
6225 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6226 $top.head conf -state readonly
6227 grid x $top.head -sticky w
6228 label $top.clab -text [mc "Command:"]
6229 entry $top.cmd -width 60 -textvariable wrcomcmd
6230 grid $top.clab $top.cmd -sticky w -pady 10
6231 label $top.flab -text [mc "Output file:"]
6232 entry $top.fname -width 60
6233 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6234 grid $top.flab $top.fname -sticky w
6235 frame $top.buts
6236 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6237 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6238 grid $top.buts.gen $top.buts.can
6239 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6240 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6241 grid $top.buts - -pady 10 -sticky ew
6242 focus $top.fname
6245 proc wrcomgo {} {
6246 global wrcomtop
6248 set id [$wrcomtop.sha1 get]
6249 set cmd "echo $id | [$wrcomtop.cmd get]"
6250 set fname [$wrcomtop.fname get]
6251 if {[catch {exec sh -c $cmd >$fname &} err]} {
6252 error_popup "[mc "Error writing commit:"] $err"
6254 catch {destroy $wrcomtop}
6255 unset wrcomtop
6258 proc wrcomcan {} {
6259 global wrcomtop
6261 catch {destroy $wrcomtop}
6262 unset wrcomtop
6265 proc mkbranch {} {
6266 global rowmenuid mkbrtop
6268 set top .makebranch
6269 catch {destroy $top}
6270 toplevel $top
6271 label $top.title -text [mc "Create new branch"]
6272 grid $top.title - -pady 10
6273 label $top.id -text [mc "ID:"]
6274 entry $top.sha1 -width 40 -relief flat
6275 $top.sha1 insert 0 $rowmenuid
6276 $top.sha1 conf -state readonly
6277 grid $top.id $top.sha1 -sticky w
6278 label $top.nlab -text [mc "Name:"]
6279 entry $top.name -width 40
6280 grid $top.nlab $top.name -sticky w
6281 frame $top.buts
6282 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6283 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6284 grid $top.buts.go $top.buts.can
6285 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6286 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6287 grid $top.buts - -pady 10 -sticky ew
6288 focus $top.name
6291 proc mkbrgo {top} {
6292 global headids idheads
6294 set name [$top.name get]
6295 set id [$top.sha1 get]
6296 if {$name eq {}} {
6297 error_popup [mc "Please specify a name for the new branch"]
6298 return
6300 catch {destroy $top}
6301 nowbusy newbranch
6302 update
6303 if {[catch {
6304 exec git branch $name $id
6305 } err]} {
6306 notbusy newbranch
6307 error_popup $err
6308 } else {
6309 set headids($name) $id
6310 lappend idheads($id) $name
6311 addedhead $id $name
6312 notbusy newbranch
6313 redrawtags $id
6314 dispneartags 0
6315 run refill_reflist
6319 proc cherrypick {} {
6320 global rowmenuid curview commitrow
6321 global mainhead
6323 set oldhead [exec git rev-parse HEAD]
6324 set dheads [descheads $rowmenuid]
6325 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6326 set ok [confirm_popup [mc "Commit %s is already\
6327 included in branch %s -- really re-apply it?" \
6328 [string range $rowmenuid 0 7] $mainhead]]
6329 if {!$ok} return
6331 nowbusy cherrypick [mc "Cherry-picking"]
6332 update
6333 # Unfortunately git-cherry-pick writes stuff to stderr even when
6334 # no error occurs, and exec takes that as an indication of error...
6335 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6336 notbusy cherrypick
6337 error_popup $err
6338 return
6340 set newhead [exec git rev-parse HEAD]
6341 if {$newhead eq $oldhead} {
6342 notbusy cherrypick
6343 error_popup [mc "No changes committed"]
6344 return
6346 addnewchild $newhead $oldhead
6347 if {[info exists commitrow($curview,$oldhead)]} {
6348 insertrow $commitrow($curview,$oldhead) $newhead
6349 if {$mainhead ne {}} {
6350 movehead $newhead $mainhead
6351 movedhead $newhead $mainhead
6353 redrawtags $oldhead
6354 redrawtags $newhead
6356 notbusy cherrypick
6359 proc resethead {} {
6360 global mainheadid mainhead rowmenuid confirm_ok resettype
6362 set confirm_ok 0
6363 set w ".confirmreset"
6364 toplevel $w
6365 wm transient $w .
6366 wm title $w [mc "Confirm reset"]
6367 message $w.m -text \
6368 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6369 -justify center -aspect 1000
6370 pack $w.m -side top -fill x -padx 20 -pady 20
6371 frame $w.f -relief sunken -border 2
6372 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6373 grid $w.f.rt -sticky w
6374 set resettype mixed
6375 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6376 -text [mc "Soft: Leave working tree and index untouched"]
6377 grid $w.f.soft -sticky w
6378 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6379 -text [mc "Mixed: Leave working tree untouched, reset index"]
6380 grid $w.f.mixed -sticky w
6381 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6382 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6383 grid $w.f.hard -sticky w
6384 pack $w.f -side top -fill x
6385 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6386 pack $w.ok -side left -fill x -padx 20 -pady 20
6387 button $w.cancel -text [mc Cancel] -command "destroy $w"
6388 pack $w.cancel -side right -fill x -padx 20 -pady 20
6389 bind $w <Visibility> "grab $w; focus $w"
6390 tkwait window $w
6391 if {!$confirm_ok} return
6392 if {[catch {set fd [open \
6393 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6394 error_popup $err
6395 } else {
6396 dohidelocalchanges
6397 filerun $fd [list readresetstat $fd]
6398 nowbusy reset [mc "Resetting"]
6402 proc readresetstat {fd} {
6403 global mainhead mainheadid showlocalchanges rprogcoord
6405 if {[gets $fd line] >= 0} {
6406 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6407 set rprogcoord [expr {1.0 * $m / $n}]
6408 adjustprogress
6410 return 1
6412 set rprogcoord 0
6413 adjustprogress
6414 notbusy reset
6415 if {[catch {close $fd} err]} {
6416 error_popup $err
6418 set oldhead $mainheadid
6419 set newhead [exec git rev-parse HEAD]
6420 if {$newhead ne $oldhead} {
6421 movehead $newhead $mainhead
6422 movedhead $newhead $mainhead
6423 set mainheadid $newhead
6424 redrawtags $oldhead
6425 redrawtags $newhead
6427 if {$showlocalchanges} {
6428 doshowlocalchanges
6430 return 0
6433 # context menu for a head
6434 proc headmenu {x y id head} {
6435 global headmenuid headmenuhead headctxmenu mainhead
6437 stopfinding
6438 set headmenuid $id
6439 set headmenuhead $head
6440 set state normal
6441 if {$head eq $mainhead} {
6442 set state disabled
6444 $headctxmenu entryconfigure 0 -state $state
6445 $headctxmenu entryconfigure 1 -state $state
6446 tk_popup $headctxmenu $x $y
6449 proc cobranch {} {
6450 global headmenuid headmenuhead mainhead headids
6451 global showlocalchanges mainheadid
6453 # check the tree is clean first??
6454 set oldmainhead $mainhead
6455 nowbusy checkout [mc "Checking out"]
6456 update
6457 dohidelocalchanges
6458 if {[catch {
6459 exec git checkout -q $headmenuhead
6460 } err]} {
6461 notbusy checkout
6462 error_popup $err
6463 } else {
6464 notbusy checkout
6465 set mainhead $headmenuhead
6466 set mainheadid $headmenuid
6467 if {[info exists headids($oldmainhead)]} {
6468 redrawtags $headids($oldmainhead)
6470 redrawtags $headmenuid
6472 if {$showlocalchanges} {
6473 dodiffindex
6477 proc rmbranch {} {
6478 global headmenuid headmenuhead mainhead
6479 global idheads
6481 set head $headmenuhead
6482 set id $headmenuid
6483 # this check shouldn't be needed any more...
6484 if {$head eq $mainhead} {
6485 error_popup [mc "Cannot delete the currently checked-out branch"]
6486 return
6488 set dheads [descheads $id]
6489 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6490 # the stuff on this branch isn't on any other branch
6491 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6492 branch.\nReally delete branch %s?" $head $head]]} return
6494 nowbusy rmbranch
6495 update
6496 if {[catch {exec git branch -D $head} err]} {
6497 notbusy rmbranch
6498 error_popup $err
6499 return
6501 removehead $id $head
6502 removedhead $id $head
6503 redrawtags $id
6504 notbusy rmbranch
6505 dispneartags 0
6506 run refill_reflist
6509 # Display a list of tags and heads
6510 proc showrefs {} {
6511 global showrefstop bgcolor fgcolor selectbgcolor
6512 global bglist fglist reflistfilter reflist maincursor
6514 set top .showrefs
6515 set showrefstop $top
6516 if {[winfo exists $top]} {
6517 raise $top
6518 refill_reflist
6519 return
6521 toplevel $top
6522 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6523 text $top.list -background $bgcolor -foreground $fgcolor \
6524 -selectbackground $selectbgcolor -font mainfont \
6525 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6526 -width 30 -height 20 -cursor $maincursor \
6527 -spacing1 1 -spacing3 1 -state disabled
6528 $top.list tag configure highlight -background $selectbgcolor
6529 lappend bglist $top.list
6530 lappend fglist $top.list
6531 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6532 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6533 grid $top.list $top.ysb -sticky nsew
6534 grid $top.xsb x -sticky ew
6535 frame $top.f
6536 label $top.f.l -text "[mc "Filter"]: "
6537 entry $top.f.e -width 20 -textvariable reflistfilter
6538 set reflistfilter "*"
6539 trace add variable reflistfilter write reflistfilter_change
6540 pack $top.f.e -side right -fill x -expand 1
6541 pack $top.f.l -side left
6542 grid $top.f - -sticky ew -pady 2
6543 button $top.close -command [list destroy $top] -text [mc "Close"]
6544 grid $top.close -
6545 grid columnconfigure $top 0 -weight 1
6546 grid rowconfigure $top 0 -weight 1
6547 bind $top.list <1> {break}
6548 bind $top.list <B1-Motion> {break}
6549 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6550 set reflist {}
6551 refill_reflist
6554 proc sel_reflist {w x y} {
6555 global showrefstop reflist headids tagids otherrefids
6557 if {![winfo exists $showrefstop]} return
6558 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6559 set ref [lindex $reflist [expr {$l-1}]]
6560 set n [lindex $ref 0]
6561 switch -- [lindex $ref 1] {
6562 "H" {selbyid $headids($n)}
6563 "T" {selbyid $tagids($n)}
6564 "o" {selbyid $otherrefids($n)}
6566 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6569 proc unsel_reflist {} {
6570 global showrefstop
6572 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6573 $showrefstop.list tag remove highlight 0.0 end
6576 proc reflistfilter_change {n1 n2 op} {
6577 global reflistfilter
6579 after cancel refill_reflist
6580 after 200 refill_reflist
6583 proc refill_reflist {} {
6584 global reflist reflistfilter showrefstop headids tagids otherrefids
6585 global commitrow curview commitinterest
6587 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6588 set refs {}
6589 foreach n [array names headids] {
6590 if {[string match $reflistfilter $n]} {
6591 if {[info exists commitrow($curview,$headids($n))]} {
6592 lappend refs [list $n H]
6593 } else {
6594 set commitinterest($headids($n)) {run refill_reflist}
6598 foreach n [array names tagids] {
6599 if {[string match $reflistfilter $n]} {
6600 if {[info exists commitrow($curview,$tagids($n))]} {
6601 lappend refs [list $n T]
6602 } else {
6603 set commitinterest($tagids($n)) {run refill_reflist}
6607 foreach n [array names otherrefids] {
6608 if {[string match $reflistfilter $n]} {
6609 if {[info exists commitrow($curview,$otherrefids($n))]} {
6610 lappend refs [list $n o]
6611 } else {
6612 set commitinterest($otherrefids($n)) {run refill_reflist}
6616 set refs [lsort -index 0 $refs]
6617 if {$refs eq $reflist} return
6619 # Update the contents of $showrefstop.list according to the
6620 # differences between $reflist (old) and $refs (new)
6621 $showrefstop.list conf -state normal
6622 $showrefstop.list insert end "\n"
6623 set i 0
6624 set j 0
6625 while {$i < [llength $reflist] || $j < [llength $refs]} {
6626 if {$i < [llength $reflist]} {
6627 if {$j < [llength $refs]} {
6628 set cmp [string compare [lindex $reflist $i 0] \
6629 [lindex $refs $j 0]]
6630 if {$cmp == 0} {
6631 set cmp [string compare [lindex $reflist $i 1] \
6632 [lindex $refs $j 1]]
6634 } else {
6635 set cmp -1
6637 } else {
6638 set cmp 1
6640 switch -- $cmp {
6641 -1 {
6642 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6643 incr i
6646 incr i
6647 incr j
6650 set l [expr {$j + 1}]
6651 $showrefstop.list image create $l.0 -align baseline \
6652 -image reficon-[lindex $refs $j 1] -padx 2
6653 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6654 incr j
6658 set reflist $refs
6659 # delete last newline
6660 $showrefstop.list delete end-2c end-1c
6661 $showrefstop.list conf -state disabled
6664 # Stuff for finding nearby tags
6665 proc getallcommits {} {
6666 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6667 global idheads idtags idotherrefs allparents tagobjid
6669 if {![info exists allcommits]} {
6670 set nextarc 0
6671 set allcommits 0
6672 set seeds {}
6673 set allcwait 0
6674 set cachedarcs 0
6675 set allccache [file join [gitdir] "gitk.cache"]
6676 if {![catch {
6677 set f [open $allccache r]
6678 set allcwait 1
6679 getcache $f
6680 }]} return
6683 if {$allcwait} {
6684 return
6686 set cmd [list | git rev-list --parents]
6687 set allcupdate [expr {$seeds ne {}}]
6688 if {!$allcupdate} {
6689 set ids "--all"
6690 } else {
6691 set refs [concat [array names idheads] [array names idtags] \
6692 [array names idotherrefs]]
6693 set ids {}
6694 set tagobjs {}
6695 foreach name [array names tagobjid] {
6696 lappend tagobjs $tagobjid($name)
6698 foreach id [lsort -unique $refs] {
6699 if {![info exists allparents($id)] &&
6700 [lsearch -exact $tagobjs $id] < 0} {
6701 lappend ids $id
6704 if {$ids ne {}} {
6705 foreach id $seeds {
6706 lappend ids "^$id"
6710 if {$ids ne {}} {
6711 set fd [open [concat $cmd $ids] r]
6712 fconfigure $fd -blocking 0
6713 incr allcommits
6714 nowbusy allcommits
6715 filerun $fd [list getallclines $fd]
6716 } else {
6717 dispneartags 0
6721 # Since most commits have 1 parent and 1 child, we group strings of
6722 # such commits into "arcs" joining branch/merge points (BMPs), which
6723 # are commits that either don't have 1 parent or don't have 1 child.
6725 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6726 # arcout(id) - outgoing arcs for BMP
6727 # arcids(a) - list of IDs on arc including end but not start
6728 # arcstart(a) - BMP ID at start of arc
6729 # arcend(a) - BMP ID at end of arc
6730 # growing(a) - arc a is still growing
6731 # arctags(a) - IDs out of arcids (excluding end) that have tags
6732 # archeads(a) - IDs out of arcids (excluding end) that have heads
6733 # The start of an arc is at the descendent end, so "incoming" means
6734 # coming from descendents, and "outgoing" means going towards ancestors.
6736 proc getallclines {fd} {
6737 global allparents allchildren idtags idheads nextarc
6738 global arcnos arcids arctags arcout arcend arcstart archeads growing
6739 global seeds allcommits cachedarcs allcupdate
6741 set nid 0
6742 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6743 set id [lindex $line 0]
6744 if {[info exists allparents($id)]} {
6745 # seen it already
6746 continue
6748 set cachedarcs 0
6749 set olds [lrange $line 1 end]
6750 set allparents($id) $olds
6751 if {![info exists allchildren($id)]} {
6752 set allchildren($id) {}
6753 set arcnos($id) {}
6754 lappend seeds $id
6755 } else {
6756 set a $arcnos($id)
6757 if {[llength $olds] == 1 && [llength $a] == 1} {
6758 lappend arcids($a) $id
6759 if {[info exists idtags($id)]} {
6760 lappend arctags($a) $id
6762 if {[info exists idheads($id)]} {
6763 lappend archeads($a) $id
6765 if {[info exists allparents($olds)]} {
6766 # seen parent already
6767 if {![info exists arcout($olds)]} {
6768 splitarc $olds
6770 lappend arcids($a) $olds
6771 set arcend($a) $olds
6772 unset growing($a)
6774 lappend allchildren($olds) $id
6775 lappend arcnos($olds) $a
6776 continue
6779 foreach a $arcnos($id) {
6780 lappend arcids($a) $id
6781 set arcend($a) $id
6782 unset growing($a)
6785 set ao {}
6786 foreach p $olds {
6787 lappend allchildren($p) $id
6788 set a [incr nextarc]
6789 set arcstart($a) $id
6790 set archeads($a) {}
6791 set arctags($a) {}
6792 set archeads($a) {}
6793 set arcids($a) {}
6794 lappend ao $a
6795 set growing($a) 1
6796 if {[info exists allparents($p)]} {
6797 # seen it already, may need to make a new branch
6798 if {![info exists arcout($p)]} {
6799 splitarc $p
6801 lappend arcids($a) $p
6802 set arcend($a) $p
6803 unset growing($a)
6805 lappend arcnos($p) $a
6807 set arcout($id) $ao
6809 if {$nid > 0} {
6810 global cached_dheads cached_dtags cached_atags
6811 catch {unset cached_dheads}
6812 catch {unset cached_dtags}
6813 catch {unset cached_atags}
6815 if {![eof $fd]} {
6816 return [expr {$nid >= 1000? 2: 1}]
6818 set cacheok 1
6819 if {[catch {
6820 fconfigure $fd -blocking 1
6821 close $fd
6822 } err]} {
6823 # got an error reading the list of commits
6824 # if we were updating, try rereading the whole thing again
6825 if {$allcupdate} {
6826 incr allcommits -1
6827 dropcache $err
6828 return
6830 error_popup "[mc "Error reading commit topology information;\
6831 branch and preceding/following tag information\
6832 will be incomplete."]\n($err)"
6833 set cacheok 0
6835 if {[incr allcommits -1] == 0} {
6836 notbusy allcommits
6837 if {$cacheok} {
6838 run savecache
6841 dispneartags 0
6842 return 0
6845 proc recalcarc {a} {
6846 global arctags archeads arcids idtags idheads
6848 set at {}
6849 set ah {}
6850 foreach id [lrange $arcids($a) 0 end-1] {
6851 if {[info exists idtags($id)]} {
6852 lappend at $id
6854 if {[info exists idheads($id)]} {
6855 lappend ah $id
6858 set arctags($a) $at
6859 set archeads($a) $ah
6862 proc splitarc {p} {
6863 global arcnos arcids nextarc arctags archeads idtags idheads
6864 global arcstart arcend arcout allparents growing
6866 set a $arcnos($p)
6867 if {[llength $a] != 1} {
6868 puts "oops splitarc called but [llength $a] arcs already"
6869 return
6871 set a [lindex $a 0]
6872 set i [lsearch -exact $arcids($a) $p]
6873 if {$i < 0} {
6874 puts "oops splitarc $p not in arc $a"
6875 return
6877 set na [incr nextarc]
6878 if {[info exists arcend($a)]} {
6879 set arcend($na) $arcend($a)
6880 } else {
6881 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6882 set j [lsearch -exact $arcnos($l) $a]
6883 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6885 set tail [lrange $arcids($a) [expr {$i+1}] end]
6886 set arcids($a) [lrange $arcids($a) 0 $i]
6887 set arcend($a) $p
6888 set arcstart($na) $p
6889 set arcout($p) $na
6890 set arcids($na) $tail
6891 if {[info exists growing($a)]} {
6892 set growing($na) 1
6893 unset growing($a)
6896 foreach id $tail {
6897 if {[llength $arcnos($id)] == 1} {
6898 set arcnos($id) $na
6899 } else {
6900 set j [lsearch -exact $arcnos($id) $a]
6901 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6905 # reconstruct tags and heads lists
6906 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6907 recalcarc $a
6908 recalcarc $na
6909 } else {
6910 set arctags($na) {}
6911 set archeads($na) {}
6915 # Update things for a new commit added that is a child of one
6916 # existing commit. Used when cherry-picking.
6917 proc addnewchild {id p} {
6918 global allparents allchildren idtags nextarc
6919 global arcnos arcids arctags arcout arcend arcstart archeads growing
6920 global seeds allcommits
6922 if {![info exists allcommits] || ![info exists arcnos($p)]} return
6923 set allparents($id) [list $p]
6924 set allchildren($id) {}
6925 set arcnos($id) {}
6926 lappend seeds $id
6927 lappend allchildren($p) $id
6928 set a [incr nextarc]
6929 set arcstart($a) $id
6930 set archeads($a) {}
6931 set arctags($a) {}
6932 set arcids($a) [list $p]
6933 set arcend($a) $p
6934 if {![info exists arcout($p)]} {
6935 splitarc $p
6937 lappend arcnos($p) $a
6938 set arcout($id) [list $a]
6941 # This implements a cache for the topology information.
6942 # The cache saves, for each arc, the start and end of the arc,
6943 # the ids on the arc, and the outgoing arcs from the end.
6944 proc readcache {f} {
6945 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6946 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6947 global allcwait
6949 set a $nextarc
6950 set lim $cachedarcs
6951 if {$lim - $a > 500} {
6952 set lim [expr {$a + 500}]
6954 if {[catch {
6955 if {$a == $lim} {
6956 # finish reading the cache and setting up arctags, etc.
6957 set line [gets $f]
6958 if {$line ne "1"} {error "bad final version"}
6959 close $f
6960 foreach id [array names idtags] {
6961 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6962 [llength $allparents($id)] == 1} {
6963 set a [lindex $arcnos($id) 0]
6964 if {$arctags($a) eq {}} {
6965 recalcarc $a
6969 foreach id [array names idheads] {
6970 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6971 [llength $allparents($id)] == 1} {
6972 set a [lindex $arcnos($id) 0]
6973 if {$archeads($a) eq {}} {
6974 recalcarc $a
6978 foreach id [lsort -unique $possible_seeds] {
6979 if {$arcnos($id) eq {}} {
6980 lappend seeds $id
6983 set allcwait 0
6984 } else {
6985 while {[incr a] <= $lim} {
6986 set line [gets $f]
6987 if {[llength $line] != 3} {error "bad line"}
6988 set s [lindex $line 0]
6989 set arcstart($a) $s
6990 lappend arcout($s) $a
6991 if {![info exists arcnos($s)]} {
6992 lappend possible_seeds $s
6993 set arcnos($s) {}
6995 set e [lindex $line 1]
6996 if {$e eq {}} {
6997 set growing($a) 1
6998 } else {
6999 set arcend($a) $e
7000 if {![info exists arcout($e)]} {
7001 set arcout($e) {}
7004 set arcids($a) [lindex $line 2]
7005 foreach id $arcids($a) {
7006 lappend allparents($s) $id
7007 set s $id
7008 lappend arcnos($id) $a
7010 if {![info exists allparents($s)]} {
7011 set allparents($s) {}
7013 set arctags($a) {}
7014 set archeads($a) {}
7016 set nextarc [expr {$a - 1}]
7018 } err]} {
7019 dropcache $err
7020 return 0
7022 if {!$allcwait} {
7023 getallcommits
7025 return $allcwait
7028 proc getcache {f} {
7029 global nextarc cachedarcs possible_seeds
7031 if {[catch {
7032 set line [gets $f]
7033 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7034 # make sure it's an integer
7035 set cachedarcs [expr {int([lindex $line 1])}]
7036 if {$cachedarcs < 0} {error "bad number of arcs"}
7037 set nextarc 0
7038 set possible_seeds {}
7039 run readcache $f
7040 } err]} {
7041 dropcache $err
7043 return 0
7046 proc dropcache {err} {
7047 global allcwait nextarc cachedarcs seeds
7049 #puts "dropping cache ($err)"
7050 foreach v {arcnos arcout arcids arcstart arcend growing \
7051 arctags archeads allparents allchildren} {
7052 global $v
7053 catch {unset $v}
7055 set allcwait 0
7056 set nextarc 0
7057 set cachedarcs 0
7058 set seeds {}
7059 getallcommits
7062 proc writecache {f} {
7063 global cachearc cachedarcs allccache
7064 global arcstart arcend arcnos arcids arcout
7066 set a $cachearc
7067 set lim $cachedarcs
7068 if {$lim - $a > 1000} {
7069 set lim [expr {$a + 1000}]
7071 if {[catch {
7072 while {[incr a] <= $lim} {
7073 if {[info exists arcend($a)]} {
7074 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7075 } else {
7076 puts $f [list $arcstart($a) {} $arcids($a)]
7079 } err]} {
7080 catch {close $f}
7081 catch {file delete $allccache}
7082 #puts "writing cache failed ($err)"
7083 return 0
7085 set cachearc [expr {$a - 1}]
7086 if {$a > $cachedarcs} {
7087 puts $f "1"
7088 close $f
7089 return 0
7091 return 1
7094 proc savecache {} {
7095 global nextarc cachedarcs cachearc allccache
7097 if {$nextarc == $cachedarcs} return
7098 set cachearc 0
7099 set cachedarcs $nextarc
7100 catch {
7101 set f [open $allccache w]
7102 puts $f [list 1 $cachedarcs]
7103 run writecache $f
7107 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7108 # or 0 if neither is true.
7109 proc anc_or_desc {a b} {
7110 global arcout arcstart arcend arcnos cached_isanc
7112 if {$arcnos($a) eq $arcnos($b)} {
7113 # Both are on the same arc(s); either both are the same BMP,
7114 # or if one is not a BMP, the other is also not a BMP or is
7115 # the BMP at end of the arc (and it only has 1 incoming arc).
7116 # Or both can be BMPs with no incoming arcs.
7117 if {$a eq $b || $arcnos($a) eq {}} {
7118 return 0
7120 # assert {[llength $arcnos($a)] == 1}
7121 set arc [lindex $arcnos($a) 0]
7122 set i [lsearch -exact $arcids($arc) $a]
7123 set j [lsearch -exact $arcids($arc) $b]
7124 if {$i < 0 || $i > $j} {
7125 return 1
7126 } else {
7127 return -1
7131 if {![info exists arcout($a)]} {
7132 set arc [lindex $arcnos($a) 0]
7133 if {[info exists arcend($arc)]} {
7134 set aend $arcend($arc)
7135 } else {
7136 set aend {}
7138 set a $arcstart($arc)
7139 } else {
7140 set aend $a
7142 if {![info exists arcout($b)]} {
7143 set arc [lindex $arcnos($b) 0]
7144 if {[info exists arcend($arc)]} {
7145 set bend $arcend($arc)
7146 } else {
7147 set bend {}
7149 set b $arcstart($arc)
7150 } else {
7151 set bend $b
7153 if {$a eq $bend} {
7154 return 1
7156 if {$b eq $aend} {
7157 return -1
7159 if {[info exists cached_isanc($a,$bend)]} {
7160 if {$cached_isanc($a,$bend)} {
7161 return 1
7164 if {[info exists cached_isanc($b,$aend)]} {
7165 if {$cached_isanc($b,$aend)} {
7166 return -1
7168 if {[info exists cached_isanc($a,$bend)]} {
7169 return 0
7173 set todo [list $a $b]
7174 set anc($a) a
7175 set anc($b) b
7176 for {set i 0} {$i < [llength $todo]} {incr i} {
7177 set x [lindex $todo $i]
7178 if {$anc($x) eq {}} {
7179 continue
7181 foreach arc $arcnos($x) {
7182 set xd $arcstart($arc)
7183 if {$xd eq $bend} {
7184 set cached_isanc($a,$bend) 1
7185 set cached_isanc($b,$aend) 0
7186 return 1
7187 } elseif {$xd eq $aend} {
7188 set cached_isanc($b,$aend) 1
7189 set cached_isanc($a,$bend) 0
7190 return -1
7192 if {![info exists anc($xd)]} {
7193 set anc($xd) $anc($x)
7194 lappend todo $xd
7195 } elseif {$anc($xd) ne $anc($x)} {
7196 set anc($xd) {}
7200 set cached_isanc($a,$bend) 0
7201 set cached_isanc($b,$aend) 0
7202 return 0
7205 # This identifies whether $desc has an ancestor that is
7206 # a growing tip of the graph and which is not an ancestor of $anc
7207 # and returns 0 if so and 1 if not.
7208 # If we subsequently discover a tag on such a growing tip, and that
7209 # turns out to be a descendent of $anc (which it could, since we
7210 # don't necessarily see children before parents), then $desc
7211 # isn't a good choice to display as a descendent tag of
7212 # $anc (since it is the descendent of another tag which is
7213 # a descendent of $anc). Similarly, $anc isn't a good choice to
7214 # display as a ancestor tag of $desc.
7216 proc is_certain {desc anc} {
7217 global arcnos arcout arcstart arcend growing problems
7219 set certain {}
7220 if {[llength $arcnos($anc)] == 1} {
7221 # tags on the same arc are certain
7222 if {$arcnos($desc) eq $arcnos($anc)} {
7223 return 1
7225 if {![info exists arcout($anc)]} {
7226 # if $anc is partway along an arc, use the start of the arc instead
7227 set a [lindex $arcnos($anc) 0]
7228 set anc $arcstart($a)
7231 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7232 set x $desc
7233 } else {
7234 set a [lindex $arcnos($desc) 0]
7235 set x $arcend($a)
7237 if {$x == $anc} {
7238 return 1
7240 set anclist [list $x]
7241 set dl($x) 1
7242 set nnh 1
7243 set ngrowanc 0
7244 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7245 set x [lindex $anclist $i]
7246 if {$dl($x)} {
7247 incr nnh -1
7249 set done($x) 1
7250 foreach a $arcout($x) {
7251 if {[info exists growing($a)]} {
7252 if {![info exists growanc($x)] && $dl($x)} {
7253 set growanc($x) 1
7254 incr ngrowanc
7256 } else {
7257 set y $arcend($a)
7258 if {[info exists dl($y)]} {
7259 if {$dl($y)} {
7260 if {!$dl($x)} {
7261 set dl($y) 0
7262 if {![info exists done($y)]} {
7263 incr nnh -1
7265 if {[info exists growanc($x)]} {
7266 incr ngrowanc -1
7268 set xl [list $y]
7269 for {set k 0} {$k < [llength $xl]} {incr k} {
7270 set z [lindex $xl $k]
7271 foreach c $arcout($z) {
7272 if {[info exists arcend($c)]} {
7273 set v $arcend($c)
7274 if {[info exists dl($v)] && $dl($v)} {
7275 set dl($v) 0
7276 if {![info exists done($v)]} {
7277 incr nnh -1
7279 if {[info exists growanc($v)]} {
7280 incr ngrowanc -1
7282 lappend xl $v
7289 } elseif {$y eq $anc || !$dl($x)} {
7290 set dl($y) 0
7291 lappend anclist $y
7292 } else {
7293 set dl($y) 1
7294 lappend anclist $y
7295 incr nnh
7300 foreach x [array names growanc] {
7301 if {$dl($x)} {
7302 return 0
7304 return 0
7306 return 1
7309 proc validate_arctags {a} {
7310 global arctags idtags
7312 set i -1
7313 set na $arctags($a)
7314 foreach id $arctags($a) {
7315 incr i
7316 if {![info exists idtags($id)]} {
7317 set na [lreplace $na $i $i]
7318 incr i -1
7321 set arctags($a) $na
7324 proc validate_archeads {a} {
7325 global archeads idheads
7327 set i -1
7328 set na $archeads($a)
7329 foreach id $archeads($a) {
7330 incr i
7331 if {![info exists idheads($id)]} {
7332 set na [lreplace $na $i $i]
7333 incr i -1
7336 set archeads($a) $na
7339 # Return the list of IDs that have tags that are descendents of id,
7340 # ignoring IDs that are descendents of IDs already reported.
7341 proc desctags {id} {
7342 global arcnos arcstart arcids arctags idtags allparents
7343 global growing cached_dtags
7345 if {![info exists allparents($id)]} {
7346 return {}
7348 set t1 [clock clicks -milliseconds]
7349 set argid $id
7350 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7351 # part-way along an arc; check that arc first
7352 set a [lindex $arcnos($id) 0]
7353 if {$arctags($a) ne {}} {
7354 validate_arctags $a
7355 set i [lsearch -exact $arcids($a) $id]
7356 set tid {}
7357 foreach t $arctags($a) {
7358 set j [lsearch -exact $arcids($a) $t]
7359 if {$j >= $i} break
7360 set tid $t
7362 if {$tid ne {}} {
7363 return $tid
7366 set id $arcstart($a)
7367 if {[info exists idtags($id)]} {
7368 return $id
7371 if {[info exists cached_dtags($id)]} {
7372 return $cached_dtags($id)
7375 set origid $id
7376 set todo [list $id]
7377 set queued($id) 1
7378 set nc 1
7379 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7380 set id [lindex $todo $i]
7381 set done($id) 1
7382 set ta [info exists hastaggedancestor($id)]
7383 if {!$ta} {
7384 incr nc -1
7386 # ignore tags on starting node
7387 if {!$ta && $i > 0} {
7388 if {[info exists idtags($id)]} {
7389 set tagloc($id) $id
7390 set ta 1
7391 } elseif {[info exists cached_dtags($id)]} {
7392 set tagloc($id) $cached_dtags($id)
7393 set ta 1
7396 foreach a $arcnos($id) {
7397 set d $arcstart($a)
7398 if {!$ta && $arctags($a) ne {}} {
7399 validate_arctags $a
7400 if {$arctags($a) ne {}} {
7401 lappend tagloc($id) [lindex $arctags($a) end]
7404 if {$ta || $arctags($a) ne {}} {
7405 set tomark [list $d]
7406 for {set j 0} {$j < [llength $tomark]} {incr j} {
7407 set dd [lindex $tomark $j]
7408 if {![info exists hastaggedancestor($dd)]} {
7409 if {[info exists done($dd)]} {
7410 foreach b $arcnos($dd) {
7411 lappend tomark $arcstart($b)
7413 if {[info exists tagloc($dd)]} {
7414 unset tagloc($dd)
7416 } elseif {[info exists queued($dd)]} {
7417 incr nc -1
7419 set hastaggedancestor($dd) 1
7423 if {![info exists queued($d)]} {
7424 lappend todo $d
7425 set queued($d) 1
7426 if {![info exists hastaggedancestor($d)]} {
7427 incr nc
7432 set tags {}
7433 foreach id [array names tagloc] {
7434 if {![info exists hastaggedancestor($id)]} {
7435 foreach t $tagloc($id) {
7436 if {[lsearch -exact $tags $t] < 0} {
7437 lappend tags $t
7442 set t2 [clock clicks -milliseconds]
7443 set loopix $i
7445 # remove tags that are descendents of other tags
7446 for {set i 0} {$i < [llength $tags]} {incr i} {
7447 set a [lindex $tags $i]
7448 for {set j 0} {$j < $i} {incr j} {
7449 set b [lindex $tags $j]
7450 set r [anc_or_desc $a $b]
7451 if {$r == 1} {
7452 set tags [lreplace $tags $j $j]
7453 incr j -1
7454 incr i -1
7455 } elseif {$r == -1} {
7456 set tags [lreplace $tags $i $i]
7457 incr i -1
7458 break
7463 if {[array names growing] ne {}} {
7464 # graph isn't finished, need to check if any tag could get
7465 # eclipsed by another tag coming later. Simply ignore any
7466 # tags that could later get eclipsed.
7467 set ctags {}
7468 foreach t $tags {
7469 if {[is_certain $t $origid]} {
7470 lappend ctags $t
7473 if {$tags eq $ctags} {
7474 set cached_dtags($origid) $tags
7475 } else {
7476 set tags $ctags
7478 } else {
7479 set cached_dtags($origid) $tags
7481 set t3 [clock clicks -milliseconds]
7482 if {0 && $t3 - $t1 >= 100} {
7483 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7484 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7486 return $tags
7489 proc anctags {id} {
7490 global arcnos arcids arcout arcend arctags idtags allparents
7491 global growing cached_atags
7493 if {![info exists allparents($id)]} {
7494 return {}
7496 set t1 [clock clicks -milliseconds]
7497 set argid $id
7498 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7499 # part-way along an arc; check that arc first
7500 set a [lindex $arcnos($id) 0]
7501 if {$arctags($a) ne {}} {
7502 validate_arctags $a
7503 set i [lsearch -exact $arcids($a) $id]
7504 foreach t $arctags($a) {
7505 set j [lsearch -exact $arcids($a) $t]
7506 if {$j > $i} {
7507 return $t
7511 if {![info exists arcend($a)]} {
7512 return {}
7514 set id $arcend($a)
7515 if {[info exists idtags($id)]} {
7516 return $id
7519 if {[info exists cached_atags($id)]} {
7520 return $cached_atags($id)
7523 set origid $id
7524 set todo [list $id]
7525 set queued($id) 1
7526 set taglist {}
7527 set nc 1
7528 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7529 set id [lindex $todo $i]
7530 set done($id) 1
7531 set td [info exists hastaggeddescendent($id)]
7532 if {!$td} {
7533 incr nc -1
7535 # ignore tags on starting node
7536 if {!$td && $i > 0} {
7537 if {[info exists idtags($id)]} {
7538 set tagloc($id) $id
7539 set td 1
7540 } elseif {[info exists cached_atags($id)]} {
7541 set tagloc($id) $cached_atags($id)
7542 set td 1
7545 foreach a $arcout($id) {
7546 if {!$td && $arctags($a) ne {}} {
7547 validate_arctags $a
7548 if {$arctags($a) ne {}} {
7549 lappend tagloc($id) [lindex $arctags($a) 0]
7552 if {![info exists arcend($a)]} continue
7553 set d $arcend($a)
7554 if {$td || $arctags($a) ne {}} {
7555 set tomark [list $d]
7556 for {set j 0} {$j < [llength $tomark]} {incr j} {
7557 set dd [lindex $tomark $j]
7558 if {![info exists hastaggeddescendent($dd)]} {
7559 if {[info exists done($dd)]} {
7560 foreach b $arcout($dd) {
7561 if {[info exists arcend($b)]} {
7562 lappend tomark $arcend($b)
7565 if {[info exists tagloc($dd)]} {
7566 unset tagloc($dd)
7568 } elseif {[info exists queued($dd)]} {
7569 incr nc -1
7571 set hastaggeddescendent($dd) 1
7575 if {![info exists queued($d)]} {
7576 lappend todo $d
7577 set queued($d) 1
7578 if {![info exists hastaggeddescendent($d)]} {
7579 incr nc
7584 set t2 [clock clicks -milliseconds]
7585 set loopix $i
7586 set tags {}
7587 foreach id [array names tagloc] {
7588 if {![info exists hastaggeddescendent($id)]} {
7589 foreach t $tagloc($id) {
7590 if {[lsearch -exact $tags $t] < 0} {
7591 lappend tags $t
7597 # remove tags that are ancestors of other tags
7598 for {set i 0} {$i < [llength $tags]} {incr i} {
7599 set a [lindex $tags $i]
7600 for {set j 0} {$j < $i} {incr j} {
7601 set b [lindex $tags $j]
7602 set r [anc_or_desc $a $b]
7603 if {$r == -1} {
7604 set tags [lreplace $tags $j $j]
7605 incr j -1
7606 incr i -1
7607 } elseif {$r == 1} {
7608 set tags [lreplace $tags $i $i]
7609 incr i -1
7610 break
7615 if {[array names growing] ne {}} {
7616 # graph isn't finished, need to check if any tag could get
7617 # eclipsed by another tag coming later. Simply ignore any
7618 # tags that could later get eclipsed.
7619 set ctags {}
7620 foreach t $tags {
7621 if {[is_certain $origid $t]} {
7622 lappend ctags $t
7625 if {$tags eq $ctags} {
7626 set cached_atags($origid) $tags
7627 } else {
7628 set tags $ctags
7630 } else {
7631 set cached_atags($origid) $tags
7633 set t3 [clock clicks -milliseconds]
7634 if {0 && $t3 - $t1 >= 100} {
7635 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7636 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7638 return $tags
7641 # Return the list of IDs that have heads that are descendents of id,
7642 # including id itself if it has a head.
7643 proc descheads {id} {
7644 global arcnos arcstart arcids archeads idheads cached_dheads
7645 global allparents
7647 if {![info exists allparents($id)]} {
7648 return {}
7650 set aret {}
7651 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7652 # part-way along an arc; check it first
7653 set a [lindex $arcnos($id) 0]
7654 if {$archeads($a) ne {}} {
7655 validate_archeads $a
7656 set i [lsearch -exact $arcids($a) $id]
7657 foreach t $archeads($a) {
7658 set j [lsearch -exact $arcids($a) $t]
7659 if {$j > $i} break
7660 lappend aret $t
7663 set id $arcstart($a)
7665 set origid $id
7666 set todo [list $id]
7667 set seen($id) 1
7668 set ret {}
7669 for {set i 0} {$i < [llength $todo]} {incr i} {
7670 set id [lindex $todo $i]
7671 if {[info exists cached_dheads($id)]} {
7672 set ret [concat $ret $cached_dheads($id)]
7673 } else {
7674 if {[info exists idheads($id)]} {
7675 lappend ret $id
7677 foreach a $arcnos($id) {
7678 if {$archeads($a) ne {}} {
7679 validate_archeads $a
7680 if {$archeads($a) ne {}} {
7681 set ret [concat $ret $archeads($a)]
7684 set d $arcstart($a)
7685 if {![info exists seen($d)]} {
7686 lappend todo $d
7687 set seen($d) 1
7692 set ret [lsort -unique $ret]
7693 set cached_dheads($origid) $ret
7694 return [concat $ret $aret]
7697 proc addedtag {id} {
7698 global arcnos arcout cached_dtags cached_atags
7700 if {![info exists arcnos($id)]} return
7701 if {![info exists arcout($id)]} {
7702 recalcarc [lindex $arcnos($id) 0]
7704 catch {unset cached_dtags}
7705 catch {unset cached_atags}
7708 proc addedhead {hid head} {
7709 global arcnos arcout cached_dheads
7711 if {![info exists arcnos($hid)]} return
7712 if {![info exists arcout($hid)]} {
7713 recalcarc [lindex $arcnos($hid) 0]
7715 catch {unset cached_dheads}
7718 proc removedhead {hid head} {
7719 global cached_dheads
7721 catch {unset cached_dheads}
7724 proc movedhead {hid head} {
7725 global arcnos arcout cached_dheads
7727 if {![info exists arcnos($hid)]} return
7728 if {![info exists arcout($hid)]} {
7729 recalcarc [lindex $arcnos($hid) 0]
7731 catch {unset cached_dheads}
7734 proc changedrefs {} {
7735 global cached_dheads cached_dtags cached_atags
7736 global arctags archeads arcnos arcout idheads idtags
7738 foreach id [concat [array names idheads] [array names idtags]] {
7739 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7740 set a [lindex $arcnos($id) 0]
7741 if {![info exists donearc($a)]} {
7742 recalcarc $a
7743 set donearc($a) 1
7747 catch {unset cached_dtags}
7748 catch {unset cached_atags}
7749 catch {unset cached_dheads}
7752 proc rereadrefs {} {
7753 global idtags idheads idotherrefs mainhead
7755 set refids [concat [array names idtags] \
7756 [array names idheads] [array names idotherrefs]]
7757 foreach id $refids {
7758 if {![info exists ref($id)]} {
7759 set ref($id) [listrefs $id]
7762 set oldmainhead $mainhead
7763 readrefs
7764 changedrefs
7765 set refids [lsort -unique [concat $refids [array names idtags] \
7766 [array names idheads] [array names idotherrefs]]]
7767 foreach id $refids {
7768 set v [listrefs $id]
7769 if {![info exists ref($id)] || $ref($id) != $v ||
7770 ($id eq $oldmainhead && $id ne $mainhead) ||
7771 ($id eq $mainhead && $id ne $oldmainhead)} {
7772 redrawtags $id
7775 run refill_reflist
7778 proc listrefs {id} {
7779 global idtags idheads idotherrefs
7781 set x {}
7782 if {[info exists idtags($id)]} {
7783 set x $idtags($id)
7785 set y {}
7786 if {[info exists idheads($id)]} {
7787 set y $idheads($id)
7789 set z {}
7790 if {[info exists idotherrefs($id)]} {
7791 set z $idotherrefs($id)
7793 return [list $x $y $z]
7796 proc showtag {tag isnew} {
7797 global ctext tagcontents tagids linknum tagobjid
7799 if {$isnew} {
7800 addtohistory [list showtag $tag 0]
7802 $ctext conf -state normal
7803 clear_ctext
7804 settabs 0
7805 set linknum 0
7806 if {![info exists tagcontents($tag)]} {
7807 catch {
7808 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7811 if {[info exists tagcontents($tag)]} {
7812 set text $tagcontents($tag)
7813 } else {
7814 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
7816 appendwithlinks $text {}
7817 $ctext conf -state disabled
7818 init_flist {}
7821 proc doquit {} {
7822 global stopped
7823 set stopped 100
7824 savestuff .
7825 destroy .
7828 proc mkfontdisp {font top which} {
7829 global fontattr fontpref $font
7831 set fontpref($font) [set $font]
7832 button $top.${font}but -text $which -font optionfont \
7833 -command [list choosefont $font $which]
7834 label $top.$font -relief flat -font $font \
7835 -text $fontattr($font,family) -justify left
7836 grid x $top.${font}but $top.$font -sticky w
7839 proc choosefont {font which} {
7840 global fontparam fontlist fonttop fontattr
7842 set fontparam(which) $which
7843 set fontparam(font) $font
7844 set fontparam(family) [font actual $font -family]
7845 set fontparam(size) $fontattr($font,size)
7846 set fontparam(weight) $fontattr($font,weight)
7847 set fontparam(slant) $fontattr($font,slant)
7848 set top .gitkfont
7849 set fonttop $top
7850 if {![winfo exists $top]} {
7851 font create sample
7852 eval font config sample [font actual $font]
7853 toplevel $top
7854 wm title $top [mc "Gitk font chooser"]
7855 label $top.l -textvariable fontparam(which)
7856 pack $top.l -side top
7857 set fontlist [lsort [font families]]
7858 frame $top.f
7859 listbox $top.f.fam -listvariable fontlist \
7860 -yscrollcommand [list $top.f.sb set]
7861 bind $top.f.fam <<ListboxSelect>> selfontfam
7862 scrollbar $top.f.sb -command [list $top.f.fam yview]
7863 pack $top.f.sb -side right -fill y
7864 pack $top.f.fam -side left -fill both -expand 1
7865 pack $top.f -side top -fill both -expand 1
7866 frame $top.g
7867 spinbox $top.g.size -from 4 -to 40 -width 4 \
7868 -textvariable fontparam(size) \
7869 -validatecommand {string is integer -strict %s}
7870 checkbutton $top.g.bold -padx 5 \
7871 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7872 -variable fontparam(weight) -onvalue bold -offvalue normal
7873 checkbutton $top.g.ital -padx 5 \
7874 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7875 -variable fontparam(slant) -onvalue italic -offvalue roman
7876 pack $top.g.size $top.g.bold $top.g.ital -side left
7877 pack $top.g -side top
7878 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7879 -background white
7880 $top.c create text 100 25 -anchor center -text $which -font sample \
7881 -fill black -tags text
7882 bind $top.c <Configure> [list centertext $top.c]
7883 pack $top.c -side top -fill x
7884 frame $top.buts
7885 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7886 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7887 grid $top.buts.ok $top.buts.can
7888 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7889 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7890 pack $top.buts -side bottom -fill x
7891 trace add variable fontparam write chg_fontparam
7892 } else {
7893 raise $top
7894 $top.c itemconf text -text $which
7896 set i [lsearch -exact $fontlist $fontparam(family)]
7897 if {$i >= 0} {
7898 $top.f.fam selection set $i
7899 $top.f.fam see $i
7903 proc centertext {w} {
7904 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7907 proc fontok {} {
7908 global fontparam fontpref prefstop
7910 set f $fontparam(font)
7911 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7912 if {$fontparam(weight) eq "bold"} {
7913 lappend fontpref($f) "bold"
7915 if {$fontparam(slant) eq "italic"} {
7916 lappend fontpref($f) "italic"
7918 set w $prefstop.$f
7919 $w conf -text $fontparam(family) -font $fontpref($f)
7921 fontcan
7924 proc fontcan {} {
7925 global fonttop fontparam
7927 if {[info exists fonttop]} {
7928 catch {destroy $fonttop}
7929 catch {font delete sample}
7930 unset fonttop
7931 unset fontparam
7935 proc selfontfam {} {
7936 global fonttop fontparam
7938 set i [$fonttop.f.fam curselection]
7939 if {$i ne {}} {
7940 set fontparam(family) [$fonttop.f.fam get $i]
7944 proc chg_fontparam {v sub op} {
7945 global fontparam
7947 font config sample -$sub $fontparam($sub)
7950 proc doprefs {} {
7951 global maxwidth maxgraphpct
7952 global oldprefs prefstop showneartags showlocalchanges
7953 global bgcolor fgcolor ctext diffcolors selectbgcolor
7954 global tabstop limitdiffs
7956 set top .gitkprefs
7957 set prefstop $top
7958 if {[winfo exists $top]} {
7959 raise $top
7960 return
7962 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7963 limitdiffs tabstop} {
7964 set oldprefs($v) [set $v]
7966 toplevel $top
7967 wm title $top [mc "Gitk preferences"]
7968 label $top.ldisp -text [mc "Commit list display options"]
7969 grid $top.ldisp - -sticky w -pady 10
7970 label $top.spacer -text " "
7971 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7972 -font optionfont
7973 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7974 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7975 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7976 -font optionfont
7977 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7978 grid x $top.maxpctl $top.maxpct -sticky w
7979 frame $top.showlocal
7980 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7981 checkbutton $top.showlocal.b -variable showlocalchanges
7982 pack $top.showlocal.b $top.showlocal.l -side left
7983 grid x $top.showlocal -sticky w
7985 label $top.ddisp -text [mc "Diff display options"]
7986 grid $top.ddisp - -sticky w -pady 10
7987 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7988 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7989 grid x $top.tabstopl $top.tabstop -sticky w
7990 frame $top.ntag
7991 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7992 checkbutton $top.ntag.b -variable showneartags
7993 pack $top.ntag.b $top.ntag.l -side left
7994 grid x $top.ntag -sticky w
7995 frame $top.ldiff
7996 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7997 checkbutton $top.ldiff.b -variable limitdiffs
7998 pack $top.ldiff.b $top.ldiff.l -side left
7999 grid x $top.ldiff -sticky w
8001 label $top.cdisp -text [mc "Colors: press to choose"]
8002 grid $top.cdisp - -sticky w -pady 10
8003 label $top.bg -padx 40 -relief sunk -background $bgcolor
8004 button $top.bgbut -text [mc "Background"] -font optionfont \
8005 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8006 grid x $top.bgbut $top.bg -sticky w
8007 label $top.fg -padx 40 -relief sunk -background $fgcolor
8008 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8009 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8010 grid x $top.fgbut $top.fg -sticky w
8011 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8012 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8013 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8014 [list $ctext tag conf d0 -foreground]]
8015 grid x $top.diffoldbut $top.diffold -sticky w
8016 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8017 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8018 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8019 [list $ctext tag conf d1 -foreground]]
8020 grid x $top.diffnewbut $top.diffnew -sticky w
8021 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8022 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8023 -command [list choosecolor diffcolors 2 $top.hunksep \
8024 "diff hunk header" \
8025 [list $ctext tag conf hunksep -foreground]]
8026 grid x $top.hunksepbut $top.hunksep -sticky w
8027 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8028 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8029 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8030 grid x $top.selbgbut $top.selbgsep -sticky w
8032 label $top.cfont -text [mc "Fonts: press to choose"]
8033 grid $top.cfont - -sticky w -pady 10
8034 mkfontdisp mainfont $top [mc "Main font"]
8035 mkfontdisp textfont $top [mc "Diff display font"]
8036 mkfontdisp uifont $top [mc "User interface font"]
8038 frame $top.buts
8039 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8040 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8041 grid $top.buts.ok $top.buts.can
8042 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8043 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8044 grid $top.buts - - -pady 10 -sticky ew
8045 bind $top <Visibility> "focus $top.buts.ok"
8048 proc choosecolor {v vi w x cmd} {
8049 global $v
8051 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8052 -title [mc "Gitk: choose color for %s" $x]]
8053 if {$c eq {}} return
8054 $w conf -background $c
8055 lset $v $vi $c
8056 eval $cmd $c
8059 proc setselbg {c} {
8060 global bglist cflist
8061 foreach w $bglist {
8062 $w configure -selectbackground $c
8064 $cflist tag configure highlight \
8065 -background [$cflist cget -selectbackground]
8066 allcanvs itemconf secsel -fill $c
8069 proc setbg {c} {
8070 global bglist
8072 foreach w $bglist {
8073 $w conf -background $c
8077 proc setfg {c} {
8078 global fglist canv
8080 foreach w $fglist {
8081 $w conf -foreground $c
8083 allcanvs itemconf text -fill $c
8084 $canv itemconf circle -outline $c
8087 proc prefscan {} {
8088 global oldprefs prefstop
8090 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8091 limitdiffs tabstop} {
8092 global $v
8093 set $v $oldprefs($v)
8095 catch {destroy $prefstop}
8096 unset prefstop
8097 fontcan
8100 proc prefsok {} {
8101 global maxwidth maxgraphpct
8102 global oldprefs prefstop showneartags showlocalchanges
8103 global fontpref mainfont textfont uifont
8104 global limitdiffs treediffs
8106 catch {destroy $prefstop}
8107 unset prefstop
8108 fontcan
8109 set fontchanged 0
8110 if {$mainfont ne $fontpref(mainfont)} {
8111 set mainfont $fontpref(mainfont)
8112 parsefont mainfont $mainfont
8113 eval font configure mainfont [fontflags mainfont]
8114 eval font configure mainfontbold [fontflags mainfont 1]
8115 setcoords
8116 set fontchanged 1
8118 if {$textfont ne $fontpref(textfont)} {
8119 set textfont $fontpref(textfont)
8120 parsefont textfont $textfont
8121 eval font configure textfont [fontflags textfont]
8122 eval font configure textfontbold [fontflags textfont 1]
8124 if {$uifont ne $fontpref(uifont)} {
8125 set uifont $fontpref(uifont)
8126 parsefont uifont $uifont
8127 eval font configure uifont [fontflags uifont]
8129 settabs
8130 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8131 if {$showlocalchanges} {
8132 doshowlocalchanges
8133 } else {
8134 dohidelocalchanges
8137 if {$limitdiffs != $oldprefs(limitdiffs)} {
8138 # treediffs elements are limited by path
8139 catch {unset treediffs}
8141 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8142 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8143 redisplay
8144 } elseif {$showneartags != $oldprefs(showneartags) ||
8145 $limitdiffs != $oldprefs(limitdiffs)} {
8146 reselectline
8150 proc formatdate {d} {
8151 global datetimeformat
8152 if {$d ne {}} {
8153 set d [clock format $d -format $datetimeformat]
8155 return $d
8158 # This list of encoding names and aliases is distilled from
8159 # http://www.iana.org/assignments/character-sets.
8160 # Not all of them are supported by Tcl.
8161 set encoding_aliases {
8162 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8163 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8164 { ISO-10646-UTF-1 csISO10646UTF1 }
8165 { ISO_646.basic:1983 ref csISO646basic1983 }
8166 { INVARIANT csINVARIANT }
8167 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8168 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8169 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8170 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8171 { NATS-DANO iso-ir-9-1 csNATSDANO }
8172 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8173 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8174 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8175 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8176 { ISO-2022-KR csISO2022KR }
8177 { EUC-KR csEUCKR }
8178 { ISO-2022-JP csISO2022JP }
8179 { ISO-2022-JP-2 csISO2022JP2 }
8180 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8181 csISO13JISC6220jp }
8182 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8183 { IT iso-ir-15 ISO646-IT csISO15Italian }
8184 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8185 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8186 { greek7-old iso-ir-18 csISO18Greek7Old }
8187 { latin-greek iso-ir-19 csISO19LatinGreek }
8188 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8189 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8190 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8191 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8192 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8193 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8194 { INIS iso-ir-49 csISO49INIS }
8195 { INIS-8 iso-ir-50 csISO50INIS8 }
8196 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8197 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8198 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8199 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8200 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8201 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8202 csISO60Norwegian1 }
8203 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8204 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8205 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8206 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8207 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8208 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8209 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8210 { greek7 iso-ir-88 csISO88Greek7 }
8211 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8212 { iso-ir-90 csISO90 }
8213 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8214 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8215 csISO92JISC62991984b }
8216 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8217 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8218 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8219 csISO95JIS62291984handadd }
8220 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8221 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8222 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8223 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8224 CP819 csISOLatin1 }
8225 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8226 { T.61-7bit iso-ir-102 csISO102T617bit }
8227 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8228 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8229 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8230 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8231 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8232 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8233 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8234 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8235 arabic csISOLatinArabic }
8236 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8237 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8238 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8239 greek greek8 csISOLatinGreek }
8240 { T.101-G2 iso-ir-128 csISO128T101G2 }
8241 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8242 csISOLatinHebrew }
8243 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8244 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8245 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8246 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8247 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8248 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8249 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8250 csISOLatinCyrillic }
8251 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8252 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8253 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8254 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8255 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8256 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8257 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8258 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8259 { ISO_10367-box iso-ir-155 csISO10367Box }
8260 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8261 { latin-lap lap iso-ir-158 csISO158Lap }
8262 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8263 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8264 { us-dk csUSDK }
8265 { dk-us csDKUS }
8266 { JIS_X0201 X0201 csHalfWidthKatakana }
8267 { KSC5636 ISO646-KR csKSC5636 }
8268 { ISO-10646-UCS-2 csUnicode }
8269 { ISO-10646-UCS-4 csUCS4 }
8270 { DEC-MCS dec csDECMCS }
8271 { hp-roman8 roman8 r8 csHPRoman8 }
8272 { macintosh mac csMacintosh }
8273 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8274 csIBM037 }
8275 { IBM038 EBCDIC-INT cp038 csIBM038 }
8276 { IBM273 CP273 csIBM273 }
8277 { IBM274 EBCDIC-BE CP274 csIBM274 }
8278 { IBM275 EBCDIC-BR cp275 csIBM275 }
8279 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8280 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8281 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8282 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8283 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8284 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8285 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8286 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8287 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8288 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8289 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8290 { IBM437 cp437 437 csPC8CodePage437 }
8291 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8292 { IBM775 cp775 csPC775Baltic }
8293 { IBM850 cp850 850 csPC850Multilingual }
8294 { IBM851 cp851 851 csIBM851 }
8295 { IBM852 cp852 852 csPCp852 }
8296 { IBM855 cp855 855 csIBM855 }
8297 { IBM857 cp857 857 csIBM857 }
8298 { IBM860 cp860 860 csIBM860 }
8299 { IBM861 cp861 861 cp-is csIBM861 }
8300 { IBM862 cp862 862 csPC862LatinHebrew }
8301 { IBM863 cp863 863 csIBM863 }
8302 { IBM864 cp864 csIBM864 }
8303 { IBM865 cp865 865 csIBM865 }
8304 { IBM866 cp866 866 csIBM866 }
8305 { IBM868 CP868 cp-ar csIBM868 }
8306 { IBM869 cp869 869 cp-gr csIBM869 }
8307 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8308 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8309 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8310 { IBM891 cp891 csIBM891 }
8311 { IBM903 cp903 csIBM903 }
8312 { IBM904 cp904 904 csIBBM904 }
8313 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8314 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8315 { IBM1026 CP1026 csIBM1026 }
8316 { EBCDIC-AT-DE csIBMEBCDICATDE }
8317 { EBCDIC-AT-DE-A csEBCDICATDEA }
8318 { EBCDIC-CA-FR csEBCDICCAFR }
8319 { EBCDIC-DK-NO csEBCDICDKNO }
8320 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8321 { EBCDIC-FI-SE csEBCDICFISE }
8322 { EBCDIC-FI-SE-A csEBCDICFISEA }
8323 { EBCDIC-FR csEBCDICFR }
8324 { EBCDIC-IT csEBCDICIT }
8325 { EBCDIC-PT csEBCDICPT }
8326 { EBCDIC-ES csEBCDICES }
8327 { EBCDIC-ES-A csEBCDICESA }
8328 { EBCDIC-ES-S csEBCDICESS }
8329 { EBCDIC-UK csEBCDICUK }
8330 { EBCDIC-US csEBCDICUS }
8331 { UNKNOWN-8BIT csUnknown8BiT }
8332 { MNEMONIC csMnemonic }
8333 { MNEM csMnem }
8334 { VISCII csVISCII }
8335 { VIQR csVIQR }
8336 { KOI8-R csKOI8R }
8337 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8338 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8339 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8340 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8341 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8342 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8343 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8344 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8345 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8346 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8347 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8348 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8349 { IBM1047 IBM-1047 }
8350 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8351 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8352 { UNICODE-1-1 csUnicode11 }
8353 { CESU-8 csCESU-8 }
8354 { BOCU-1 csBOCU-1 }
8355 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8356 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8357 l8 }
8358 { ISO-8859-15 ISO_8859-15 Latin-9 }
8359 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8360 { GBK CP936 MS936 windows-936 }
8361 { JIS_Encoding csJISEncoding }
8362 { Shift_JIS MS_Kanji csShiftJIS }
8363 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8364 EUC-JP }
8365 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8366 { ISO-10646-UCS-Basic csUnicodeASCII }
8367 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8368 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8369 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8370 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8371 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8372 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8373 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8374 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8375 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8376 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8377 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8378 { Ventura-US csVenturaUS }
8379 { Ventura-International csVenturaInternational }
8380 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8381 { PC8-Turkish csPC8Turkish }
8382 { IBM-Symbols csIBMSymbols }
8383 { IBM-Thai csIBMThai }
8384 { HP-Legal csHPLegal }
8385 { HP-Pi-font csHPPiFont }
8386 { HP-Math8 csHPMath8 }
8387 { Adobe-Symbol-Encoding csHPPSMath }
8388 { HP-DeskTop csHPDesktop }
8389 { Ventura-Math csVenturaMath }
8390 { Microsoft-Publishing csMicrosoftPublishing }
8391 { Windows-31J csWindows31J }
8392 { GB2312 csGB2312 }
8393 { Big5 csBig5 }
8396 proc tcl_encoding {enc} {
8397 global encoding_aliases
8398 set names [encoding names]
8399 set lcnames [string tolower $names]
8400 set enc [string tolower $enc]
8401 set i [lsearch -exact $lcnames $enc]
8402 if {$i < 0} {
8403 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8404 if {[regsub {^iso[-_]} $enc iso encx]} {
8405 set i [lsearch -exact $lcnames $encx]
8408 if {$i < 0} {
8409 foreach l $encoding_aliases {
8410 set ll [string tolower $l]
8411 if {[lsearch -exact $ll $enc] < 0} continue
8412 # look through the aliases for one that tcl knows about
8413 foreach e $ll {
8414 set i [lsearch -exact $lcnames $e]
8415 if {$i < 0} {
8416 if {[regsub {^iso[-_]} $e iso ex]} {
8417 set i [lsearch -exact $lcnames $ex]
8420 if {$i >= 0} break
8422 break
8425 if {$i >= 0} {
8426 return [lindex $names $i]
8428 return {}
8431 # First check that Tcl/Tk is recent enough
8432 if {[catch {package require Tk 8.4} err]} {
8433 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8434 Gitk requires at least Tcl/Tk 8.4."]
8435 exit 1
8438 # defaults...
8439 set datemode 0
8440 set wrcomcmd "git diff-tree --stdin -p --pretty"
8442 set gitencoding {}
8443 catch {
8444 set gitencoding [exec git config --get i18n.commitencoding]
8446 if {$gitencoding == ""} {
8447 set gitencoding "utf-8"
8449 set tclencoding [tcl_encoding $gitencoding]
8450 if {$tclencoding == {}} {
8451 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8454 set mainfont {Helvetica 9}
8455 set textfont {Courier 9}
8456 set uifont {Helvetica 9 bold}
8457 set tabstop 8
8458 set findmergefiles 0
8459 set maxgraphpct 50
8460 set maxwidth 16
8461 set revlistorder 0
8462 set fastdate 0
8463 set uparrowlen 5
8464 set downarrowlen 5
8465 set mingaplen 100
8466 set cmitmode "patch"
8467 set wrapcomment "none"
8468 set showneartags 1
8469 set maxrefs 20
8470 set maxlinelen 200
8471 set showlocalchanges 1
8472 set limitdiffs 1
8473 set datetimeformat "%Y-%m-%d %H:%M:%S"
8475 set colors {green red blue magenta darkgrey brown orange}
8476 set bgcolor white
8477 set fgcolor black
8478 set diffcolors {red "#00a000" blue}
8479 set diffcontext 3
8480 set ignorespace 0
8481 set selectbgcolor gray85
8483 ## For msgcat loading, first locate the installation location.
8484 if { [info exists ::env(GITK_MSGSDIR)] } {
8485 ## Msgsdir was manually set in the environment.
8486 set gitk_msgsdir $::env(GITK_MSGSDIR)
8487 } else {
8488 ## Let's guess the prefix from argv0.
8489 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8490 set gitk_libdir [file join $gitk_prefix share gitk lib]
8491 set gitk_msgsdir [file join $gitk_libdir msgs]
8492 unset gitk_prefix
8495 ## Internationalization (i18n) through msgcat and gettext. See
8496 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8497 package require msgcat
8498 namespace import ::msgcat::mc
8499 ## And eventually load the actual message catalog
8500 ::msgcat::mcload $gitk_msgsdir
8502 catch {source ~/.gitk}
8504 font create optionfont -family sans-serif -size -12
8506 parsefont mainfont $mainfont
8507 eval font create mainfont [fontflags mainfont]
8508 eval font create mainfontbold [fontflags mainfont 1]
8510 parsefont textfont $textfont
8511 eval font create textfont [fontflags textfont]
8512 eval font create textfontbold [fontflags textfont 1]
8514 parsefont uifont $uifont
8515 eval font create uifont [fontflags uifont]
8517 setoptions
8519 # check that we can find a .git directory somewhere...
8520 if {[catch {set gitdir [gitdir]}]} {
8521 show_error {} . [mc "Cannot find a git repository here."]
8522 exit 1
8524 if {![file isdirectory $gitdir]} {
8525 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8526 exit 1
8529 set mergeonly 0
8530 set revtreeargs {}
8531 set cmdline_files {}
8532 set i 0
8533 foreach arg $argv {
8534 switch -- $arg {
8535 "" { }
8536 "-d" { set datemode 1 }
8537 "--merge" {
8538 set mergeonly 1
8539 lappend revtreeargs $arg
8541 "--" {
8542 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8543 break
8545 default {
8546 lappend revtreeargs $arg
8549 incr i
8552 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8553 # no -- on command line, but some arguments (other than -d)
8554 if {[catch {
8555 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8556 set cmdline_files [split $f "\n"]
8557 set n [llength $cmdline_files]
8558 set revtreeargs [lrange $revtreeargs 0 end-$n]
8559 # Unfortunately git rev-parse doesn't produce an error when
8560 # something is both a revision and a filename. To be consistent
8561 # with git log and git rev-list, check revtreeargs for filenames.
8562 foreach arg $revtreeargs {
8563 if {[file exists $arg]} {
8564 show_error {} . [mc "Ambiguous argument '%s': both revision\
8565 and filename" $arg]
8566 exit 1
8569 } err]} {
8570 # unfortunately we get both stdout and stderr in $err,
8571 # so look for "fatal:".
8572 set i [string first "fatal:" $err]
8573 if {$i > 0} {
8574 set err [string range $err [expr {$i + 6}] end]
8576 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8577 exit 1
8581 if {$mergeonly} {
8582 # find the list of unmerged files
8583 set mlist {}
8584 set nr_unmerged 0
8585 if {[catch {
8586 set fd [open "| git ls-files -u" r]
8587 } err]} {
8588 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8589 exit 1
8591 while {[gets $fd line] >= 0} {
8592 set i [string first "\t" $line]
8593 if {$i < 0} continue
8594 set fname [string range $line [expr {$i+1}] end]
8595 if {[lsearch -exact $mlist $fname] >= 0} continue
8596 incr nr_unmerged
8597 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8598 lappend mlist $fname
8601 catch {close $fd}
8602 if {$mlist eq {}} {
8603 if {$nr_unmerged == 0} {
8604 show_error {} . [mc "No files selected: --merge specified but\
8605 no files are unmerged."]
8606 } else {
8607 show_error {} . [mc "No files selected: --merge specified but\
8608 no unmerged files are within file limit."]
8610 exit 1
8612 set cmdline_files $mlist
8615 set nullid "0000000000000000000000000000000000000000"
8616 set nullid2 "0000000000000000000000000000000000000001"
8618 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8620 set runq {}
8621 set history {}
8622 set historyindex 0
8623 set fh_serial 0
8624 set nhl_names {}
8625 set highlight_paths {}
8626 set findpattern {}
8627 set searchdirn -forwards
8628 set boldrows {}
8629 set boldnamerows {}
8630 set diffelide {0 0}
8631 set markingmatches 0
8632 set linkentercount 0
8633 set need_redisplay 0
8634 set nrows_drawn 0
8635 set firsttabstop 0
8637 set nextviewnum 1
8638 set curview 0
8639 set selectedview 0
8640 set selectedhlview [mc "None"]
8641 set highlight_related [mc "None"]
8642 set highlight_files {}
8643 set viewfiles(0) {}
8644 set viewperm(0) 0
8645 set viewargs(0) {}
8647 set cmdlineok 0
8648 set stopped 0
8649 set stuffsaved 0
8650 set patchnum 0
8651 set localirow -1
8652 set localfrow -1
8653 set lserial 0
8654 setcoords
8655 makewindow
8656 # wait for the window to become visible
8657 tkwait visibility .
8658 wm title . "[file tail $argv0]: [file tail [pwd]]"
8659 readrefs
8661 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8662 # create a view for the files/dirs specified on the command line
8663 set curview 1
8664 set selectedview 1
8665 set nextviewnum 2
8666 set viewname(1) [mc "Command line"]
8667 set viewfiles(1) $cmdline_files
8668 set viewargs(1) $revtreeargs
8669 set viewperm(1) 0
8670 addviewmenu 1
8671 .bar.view entryconf [mc "Edit view..."] -state normal
8672 .bar.view entryconf [mc "Delete view"] -state normal
8675 if {[info exists permviews]} {
8676 foreach v $permviews {
8677 set n $nextviewnum
8678 incr nextviewnum
8679 set viewname($n) [lindex $v 0]
8680 set viewfiles($n) [lindex $v 1]
8681 set viewargs($n) [lindex $v 2]
8682 set viewperm($n) 1
8683 addviewmenu $n
8686 getcommits