Use the available vsnprintf replacement instead of rolling our own.
[git/platforms/storm.git] / gitk-git / gitk
blobc4c4be6efbf557509f2c3342f52920f26e508673
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 position if known
934 if {[info exists geometry(main)]} {
935 wm geometry . "$geometry(main)"
938 if {[tk windowingsystem] eq {aqua}} {
939 set M1B M1
940 } else {
941 set M1B Control
944 bind .pwbottom <Configure> {resizecdetpanes %W %w}
945 pack .ctop -fill both -expand 1
946 bindall <1> {selcanvline %W %x %y}
947 #bindall <B1-Motion> {selcanvline %W %x %y}
948 if {[tk windowingsystem] == "win32"} {
949 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
950 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
951 } else {
952 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
953 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
954 if {[tk windowingsystem] eq "aqua"} {
955 bindall <MouseWheel> {
956 set delta [expr {- (%D)}]
957 allcanvs yview scroll $delta units
961 bindall <2> "canvscan mark %W %x %y"
962 bindall <B2-Motion> "canvscan dragto %W %x %y"
963 bindkey <Home> selfirstline
964 bindkey <End> sellastline
965 bind . <Key-Up> "selnextline -1"
966 bind . <Key-Down> "selnextline 1"
967 bind . <Shift-Key-Up> "dofind -1 0"
968 bind . <Shift-Key-Down> "dofind 1 0"
969 bindkey <Key-Right> "goforw"
970 bindkey <Key-Left> "goback"
971 bind . <Key-Prior> "selnextpage -1"
972 bind . <Key-Next> "selnextpage 1"
973 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
974 bind . <$M1B-End> "allcanvs yview moveto 1.0"
975 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
976 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
977 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
978 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
979 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
980 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
981 bindkey <Key-space> "$ctext yview scroll 1 pages"
982 bindkey p "selnextline -1"
983 bindkey n "selnextline 1"
984 bindkey z "goback"
985 bindkey x "goforw"
986 bindkey i "selnextline -1"
987 bindkey k "selnextline 1"
988 bindkey j "goback"
989 bindkey l "goforw"
990 bindkey b "$ctext yview scroll -1 pages"
991 bindkey d "$ctext yview scroll 18 units"
992 bindkey u "$ctext yview scroll -18 units"
993 bindkey / {dofind 1 1}
994 bindkey <Key-Return> {dofind 1 1}
995 bindkey ? {dofind -1 1}
996 bindkey f nextfile
997 bindkey <F5> updatecommits
998 bind . <$M1B-q> doquit
999 bind . <$M1B-f> {dofind 1 1}
1000 bind . <$M1B-g> {dofind 1 0}
1001 bind . <$M1B-r> dosearchback
1002 bind . <$M1B-s> dosearch
1003 bind . <$M1B-equal> {incrfont 1}
1004 bind . <$M1B-plus> {incrfont 1}
1005 bind . <$M1B-KP_Add> {incrfont 1}
1006 bind . <$M1B-minus> {incrfont -1}
1007 bind . <$M1B-KP_Subtract> {incrfont -1}
1008 wm protocol . WM_DELETE_WINDOW doquit
1009 bind . <Button-1> "click %W"
1010 bind $fstring <Key-Return> {dofind 1 1}
1011 bind $sha1entry <Key-Return> gotocommit
1012 bind $sha1entry <<PasteSelection>> clearsha1
1013 bind $cflist <1> {sel_flist %W %x %y; break}
1014 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1015 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1016 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1018 set maincursor [. cget -cursor]
1019 set textcursor [$ctext cget -cursor]
1020 set curtextcursor $textcursor
1022 set rowctxmenu .rowctxmenu
1023 menu $rowctxmenu -tearoff 0
1024 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1025 -command {diffvssel 0}
1026 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1027 -command {diffvssel 1}
1028 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1029 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1030 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1031 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1032 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1033 -command cherrypick
1034 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1035 -command resethead
1037 set fakerowmenu .fakerowmenu
1038 menu $fakerowmenu -tearoff 0
1039 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1040 -command {diffvssel 0}
1041 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1042 -command {diffvssel 1}
1043 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1044 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1045 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1046 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1048 set headctxmenu .headctxmenu
1049 menu $headctxmenu -tearoff 0
1050 $headctxmenu add command -label [mc "Check out this branch"] \
1051 -command cobranch
1052 $headctxmenu add command -label [mc "Remove this branch"] \
1053 -command rmbranch
1055 global flist_menu
1056 set flist_menu .flistctxmenu
1057 menu $flist_menu -tearoff 0
1058 $flist_menu add command -label [mc "Highlight this too"] \
1059 -command {flist_hl 0}
1060 $flist_menu add command -label [mc "Highlight this only"] \
1061 -command {flist_hl 1}
1064 # Windows sends all mouse wheel events to the current focused window, not
1065 # the one where the mouse hovers, so bind those events here and redirect
1066 # to the correct window
1067 proc windows_mousewheel_redirector {W X Y D} {
1068 global canv canv2 canv3
1069 set w [winfo containing -displayof $W $X $Y]
1070 if {$w ne ""} {
1071 set u [expr {$D < 0 ? 5 : -5}]
1072 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1073 allcanvs yview scroll $u units
1074 } else {
1075 catch {
1076 $w yview scroll $u units
1082 # mouse-2 makes all windows scan vertically, but only the one
1083 # the cursor is in scans horizontally
1084 proc canvscan {op w x y} {
1085 global canv canv2 canv3
1086 foreach c [list $canv $canv2 $canv3] {
1087 if {$c == $w} {
1088 $c scan $op $x $y
1089 } else {
1090 $c scan $op 0 $y
1095 proc scrollcanv {cscroll f0 f1} {
1096 $cscroll set $f0 $f1
1097 drawfrac $f0 $f1
1098 flushhighlights
1101 # when we make a key binding for the toplevel, make sure
1102 # it doesn't get triggered when that key is pressed in the
1103 # find string entry widget.
1104 proc bindkey {ev script} {
1105 global entries
1106 bind . $ev $script
1107 set escript [bind Entry $ev]
1108 if {$escript == {}} {
1109 set escript [bind Entry <Key>]
1111 foreach e $entries {
1112 bind $e $ev "$escript; break"
1116 # set the focus back to the toplevel for any click outside
1117 # the entry widgets
1118 proc click {w} {
1119 global ctext entries
1120 foreach e [concat $entries $ctext] {
1121 if {$w == $e} return
1123 focus .
1126 # Adjust the progress bar for a change in requested extent or canvas size
1127 proc adjustprogress {} {
1128 global progresscanv progressitem progresscoords
1129 global fprogitem fprogcoord lastprogupdate progupdatepending
1130 global rprogitem rprogcoord
1132 set w [expr {[winfo width $progresscanv] - 4}]
1133 set x0 [expr {$w * [lindex $progresscoords 0]}]
1134 set x1 [expr {$w * [lindex $progresscoords 1]}]
1135 set h [winfo height $progresscanv]
1136 $progresscanv coords $progressitem $x0 0 $x1 $h
1137 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1138 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1139 set now [clock clicks -milliseconds]
1140 if {$now >= $lastprogupdate + 100} {
1141 set progupdatepending 0
1142 update
1143 } elseif {!$progupdatepending} {
1144 set progupdatepending 1
1145 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1149 proc doprogupdate {} {
1150 global lastprogupdate progupdatepending
1152 if {$progupdatepending} {
1153 set progupdatepending 0
1154 set lastprogupdate [clock clicks -milliseconds]
1155 update
1159 proc savestuff {w} {
1160 global canv canv2 canv3 mainfont textfont uifont tabstop
1161 global stuffsaved findmergefiles maxgraphpct
1162 global maxwidth showneartags showlocalchanges
1163 global viewname viewfiles viewargs viewperm nextviewnum
1164 global cmitmode wrapcomment datetimeformat limitdiffs
1165 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1167 if {$stuffsaved} return
1168 if {![winfo viewable .]} return
1169 catch {
1170 set f [open "~/.gitk-new" w]
1171 puts $f [list set mainfont $mainfont]
1172 puts $f [list set textfont $textfont]
1173 puts $f [list set uifont $uifont]
1174 puts $f [list set tabstop $tabstop]
1175 puts $f [list set findmergefiles $findmergefiles]
1176 puts $f [list set maxgraphpct $maxgraphpct]
1177 puts $f [list set maxwidth $maxwidth]
1178 puts $f [list set cmitmode $cmitmode]
1179 puts $f [list set wrapcomment $wrapcomment]
1180 puts $f [list set showneartags $showneartags]
1181 puts $f [list set showlocalchanges $showlocalchanges]
1182 puts $f [list set datetimeformat $datetimeformat]
1183 puts $f [list set limitdiffs $limitdiffs]
1184 puts $f [list set bgcolor $bgcolor]
1185 puts $f [list set fgcolor $fgcolor]
1186 puts $f [list set colors $colors]
1187 puts $f [list set diffcolors $diffcolors]
1188 puts $f [list set diffcontext $diffcontext]
1189 puts $f [list set selectbgcolor $selectbgcolor]
1191 puts $f "set geometry(main) [wm geometry .]"
1192 puts $f "set geometry(topwidth) [winfo width .tf]"
1193 puts $f "set geometry(topheight) [winfo height .tf]"
1194 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1195 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1196 puts $f "set geometry(botwidth) [winfo width .bleft]"
1197 puts $f "set geometry(botheight) [winfo height .bleft]"
1199 puts -nonewline $f "set permviews {"
1200 for {set v 0} {$v < $nextviewnum} {incr v} {
1201 if {$viewperm($v)} {
1202 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1205 puts $f "}"
1206 close $f
1207 catch {file delete "~/.gitk"}
1208 file rename -force "~/.gitk-new" "~/.gitk"
1210 set stuffsaved 1
1213 proc resizeclistpanes {win w} {
1214 global oldwidth
1215 if {[info exists oldwidth($win)]} {
1216 set s0 [$win sash coord 0]
1217 set s1 [$win sash coord 1]
1218 if {$w < 60} {
1219 set sash0 [expr {int($w/2 - 2)}]
1220 set sash1 [expr {int($w*5/6 - 2)}]
1221 } else {
1222 set factor [expr {1.0 * $w / $oldwidth($win)}]
1223 set sash0 [expr {int($factor * [lindex $s0 0])}]
1224 set sash1 [expr {int($factor * [lindex $s1 0])}]
1225 if {$sash0 < 30} {
1226 set sash0 30
1228 if {$sash1 < $sash0 + 20} {
1229 set sash1 [expr {$sash0 + 20}]
1231 if {$sash1 > $w - 10} {
1232 set sash1 [expr {$w - 10}]
1233 if {$sash0 > $sash1 - 20} {
1234 set sash0 [expr {$sash1 - 20}]
1238 $win sash place 0 $sash0 [lindex $s0 1]
1239 $win sash place 1 $sash1 [lindex $s1 1]
1241 set oldwidth($win) $w
1244 proc resizecdetpanes {win w} {
1245 global oldwidth
1246 if {[info exists oldwidth($win)]} {
1247 set s0 [$win sash coord 0]
1248 if {$w < 60} {
1249 set sash0 [expr {int($w*3/4 - 2)}]
1250 } else {
1251 set factor [expr {1.0 * $w / $oldwidth($win)}]
1252 set sash0 [expr {int($factor * [lindex $s0 0])}]
1253 if {$sash0 < 45} {
1254 set sash0 45
1256 if {$sash0 > $w - 15} {
1257 set sash0 [expr {$w - 15}]
1260 $win sash place 0 $sash0 [lindex $s0 1]
1262 set oldwidth($win) $w
1265 proc allcanvs args {
1266 global canv canv2 canv3
1267 eval $canv $args
1268 eval $canv2 $args
1269 eval $canv3 $args
1272 proc bindall {event action} {
1273 global canv canv2 canv3
1274 bind $canv $event $action
1275 bind $canv2 $event $action
1276 bind $canv3 $event $action
1279 proc about {} {
1280 global uifont
1281 set w .about
1282 if {[winfo exists $w]} {
1283 raise $w
1284 return
1286 toplevel $w
1287 wm title $w [mc "About gitk"]
1288 message $w.m -text [mc "
1289 Gitk - a commit viewer for git
1291 Copyright © 2005-2006 Paul Mackerras
1293 Use and redistribute under the terms of the GNU General Public License"] \
1294 -justify center -aspect 400 -border 2 -bg white -relief groove
1295 pack $w.m -side top -fill x -padx 2 -pady 2
1296 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1297 pack $w.ok -side bottom
1298 bind $w <Visibility> "focus $w.ok"
1299 bind $w <Key-Escape> "destroy $w"
1300 bind $w <Key-Return> "destroy $w"
1303 proc keys {} {
1304 set w .keys
1305 if {[winfo exists $w]} {
1306 raise $w
1307 return
1309 if {[tk windowingsystem] eq {aqua}} {
1310 set M1T Cmd
1311 } else {
1312 set M1T Ctrl
1314 toplevel $w
1315 wm title $w [mc "Gitk key bindings"]
1316 message $w.m -text "
1317 [mc "Gitk key bindings:"]
1319 [mc "<%s-Q> Quit" $M1T]
1320 [mc "<Home> Move to first commit"]
1321 [mc "<End> Move to last commit"]
1322 [mc "<Up>, p, i Move up one commit"]
1323 [mc "<Down>, n, k Move down one commit"]
1324 [mc "<Left>, z, j Go back in history list"]
1325 [mc "<Right>, x, l Go forward in history list"]
1326 [mc "<PageUp> Move up one page in commit list"]
1327 [mc "<PageDown> Move down one page in commit list"]
1328 [mc "<%s-Home> Scroll to top of commit list" $M1T]
1329 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
1330 [mc "<%s-Up> Scroll commit list up one line" $M1T]
1331 [mc "<%s-Down> Scroll commit list down one line" $M1T]
1332 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
1333 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
1334 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
1335 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
1336 [mc "<Delete>, b Scroll diff view up one page"]
1337 [mc "<Backspace> Scroll diff view up one page"]
1338 [mc "<Space> Scroll diff view down one page"]
1339 [mc "u Scroll diff view up 18 lines"]
1340 [mc "d Scroll diff view down 18 lines"]
1341 [mc "<%s-F> Find" $M1T]
1342 [mc "<%s-G> Move to next find hit" $M1T]
1343 [mc "<Return> Move to next find hit"]
1344 [mc "/ Move to next find hit, or redo find"]
1345 [mc "? Move to previous find hit"]
1346 [mc "f Scroll diff view to next file"]
1347 [mc "<%s-S> Search for next hit in diff view" $M1T]
1348 [mc "<%s-R> Search for previous hit in diff view" $M1T]
1349 [mc "<%s-KP+> Increase font size" $M1T]
1350 [mc "<%s-plus> Increase font size" $M1T]
1351 [mc "<%s-KP-> Decrease font size" $M1T]
1352 [mc "<%s-minus> Decrease font size" $M1T]
1353 [mc "<F5> Update"]
1355 -justify left -bg white -border 2 -relief groove
1356 pack $w.m -side top -fill both -padx 2 -pady 2
1357 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1358 pack $w.ok -side bottom
1359 bind $w <Visibility> "focus $w.ok"
1360 bind $w <Key-Escape> "destroy $w"
1361 bind $w <Key-Return> "destroy $w"
1364 # Procedures for manipulating the file list window at the
1365 # bottom right of the overall window.
1367 proc treeview {w l openlevs} {
1368 global treecontents treediropen treeheight treeparent treeindex
1370 set ix 0
1371 set treeindex() 0
1372 set lev 0
1373 set prefix {}
1374 set prefixend -1
1375 set prefendstack {}
1376 set htstack {}
1377 set ht 0
1378 set treecontents() {}
1379 $w conf -state normal
1380 foreach f $l {
1381 while {[string range $f 0 $prefixend] ne $prefix} {
1382 if {$lev <= $openlevs} {
1383 $w mark set e:$treeindex($prefix) "end -1c"
1384 $w mark gravity e:$treeindex($prefix) left
1386 set treeheight($prefix) $ht
1387 incr ht [lindex $htstack end]
1388 set htstack [lreplace $htstack end end]
1389 set prefixend [lindex $prefendstack end]
1390 set prefendstack [lreplace $prefendstack end end]
1391 set prefix [string range $prefix 0 $prefixend]
1392 incr lev -1
1394 set tail [string range $f [expr {$prefixend+1}] end]
1395 while {[set slash [string first "/" $tail]] >= 0} {
1396 lappend htstack $ht
1397 set ht 0
1398 lappend prefendstack $prefixend
1399 incr prefixend [expr {$slash + 1}]
1400 set d [string range $tail 0 $slash]
1401 lappend treecontents($prefix) $d
1402 set oldprefix $prefix
1403 append prefix $d
1404 set treecontents($prefix) {}
1405 set treeindex($prefix) [incr ix]
1406 set treeparent($prefix) $oldprefix
1407 set tail [string range $tail [expr {$slash+1}] end]
1408 if {$lev <= $openlevs} {
1409 set ht 1
1410 set treediropen($prefix) [expr {$lev < $openlevs}]
1411 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1412 $w mark set d:$ix "end -1c"
1413 $w mark gravity d:$ix left
1414 set str "\n"
1415 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1416 $w insert end $str
1417 $w image create end -align center -image $bm -padx 1 \
1418 -name a:$ix
1419 $w insert end $d [highlight_tag $prefix]
1420 $w mark set s:$ix "end -1c"
1421 $w mark gravity s:$ix left
1423 incr lev
1425 if {$tail ne {}} {
1426 if {$lev <= $openlevs} {
1427 incr ht
1428 set str "\n"
1429 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1430 $w insert end $str
1431 $w insert end $tail [highlight_tag $f]
1433 lappend treecontents($prefix) $tail
1436 while {$htstack ne {}} {
1437 set treeheight($prefix) $ht
1438 incr ht [lindex $htstack end]
1439 set htstack [lreplace $htstack end end]
1440 set prefixend [lindex $prefendstack end]
1441 set prefendstack [lreplace $prefendstack end end]
1442 set prefix [string range $prefix 0 $prefixend]
1444 $w conf -state disabled
1447 proc linetoelt {l} {
1448 global treeheight treecontents
1450 set y 2
1451 set prefix {}
1452 while {1} {
1453 foreach e $treecontents($prefix) {
1454 if {$y == $l} {
1455 return "$prefix$e"
1457 set n 1
1458 if {[string index $e end] eq "/"} {
1459 set n $treeheight($prefix$e)
1460 if {$y + $n > $l} {
1461 append prefix $e
1462 incr y
1463 break
1466 incr y $n
1471 proc highlight_tree {y prefix} {
1472 global treeheight treecontents cflist
1474 foreach e $treecontents($prefix) {
1475 set path $prefix$e
1476 if {[highlight_tag $path] ne {}} {
1477 $cflist tag add bold $y.0 "$y.0 lineend"
1479 incr y
1480 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1481 set y [highlight_tree $y $path]
1484 return $y
1487 proc treeclosedir {w dir} {
1488 global treediropen treeheight treeparent treeindex
1490 set ix $treeindex($dir)
1491 $w conf -state normal
1492 $w delete s:$ix e:$ix
1493 set treediropen($dir) 0
1494 $w image configure a:$ix -image tri-rt
1495 $w conf -state disabled
1496 set n [expr {1 - $treeheight($dir)}]
1497 while {$dir ne {}} {
1498 incr treeheight($dir) $n
1499 set dir $treeparent($dir)
1503 proc treeopendir {w dir} {
1504 global treediropen treeheight treeparent treecontents treeindex
1506 set ix $treeindex($dir)
1507 $w conf -state normal
1508 $w image configure a:$ix -image tri-dn
1509 $w mark set e:$ix s:$ix
1510 $w mark gravity e:$ix right
1511 set lev 0
1512 set str "\n"
1513 set n [llength $treecontents($dir)]
1514 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1515 incr lev
1516 append str "\t"
1517 incr treeheight($x) $n
1519 foreach e $treecontents($dir) {
1520 set de $dir$e
1521 if {[string index $e end] eq "/"} {
1522 set iy $treeindex($de)
1523 $w mark set d:$iy e:$ix
1524 $w mark gravity d:$iy left
1525 $w insert e:$ix $str
1526 set treediropen($de) 0
1527 $w image create e:$ix -align center -image tri-rt -padx 1 \
1528 -name a:$iy
1529 $w insert e:$ix $e [highlight_tag $de]
1530 $w mark set s:$iy e:$ix
1531 $w mark gravity s:$iy left
1532 set treeheight($de) 1
1533 } else {
1534 $w insert e:$ix $str
1535 $w insert e:$ix $e [highlight_tag $de]
1538 $w mark gravity e:$ix left
1539 $w conf -state disabled
1540 set treediropen($dir) 1
1541 set top [lindex [split [$w index @0,0] .] 0]
1542 set ht [$w cget -height]
1543 set l [lindex [split [$w index s:$ix] .] 0]
1544 if {$l < $top} {
1545 $w yview $l.0
1546 } elseif {$l + $n + 1 > $top + $ht} {
1547 set top [expr {$l + $n + 2 - $ht}]
1548 if {$l < $top} {
1549 set top $l
1551 $w yview $top.0
1555 proc treeclick {w x y} {
1556 global treediropen cmitmode ctext cflist cflist_top
1558 if {$cmitmode ne "tree"} return
1559 if {![info exists cflist_top]} return
1560 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1561 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1562 $cflist tag add highlight $l.0 "$l.0 lineend"
1563 set cflist_top $l
1564 if {$l == 1} {
1565 $ctext yview 1.0
1566 return
1568 set e [linetoelt $l]
1569 if {[string index $e end] ne "/"} {
1570 showfile $e
1571 } elseif {$treediropen($e)} {
1572 treeclosedir $w $e
1573 } else {
1574 treeopendir $w $e
1578 proc setfilelist {id} {
1579 global treefilelist cflist
1581 treeview $cflist $treefilelist($id) 0
1584 image create bitmap tri-rt -background black -foreground blue -data {
1585 #define tri-rt_width 13
1586 #define tri-rt_height 13
1587 static unsigned char tri-rt_bits[] = {
1588 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1589 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1590 0x00, 0x00};
1591 } -maskdata {
1592 #define tri-rt-mask_width 13
1593 #define tri-rt-mask_height 13
1594 static unsigned char tri-rt-mask_bits[] = {
1595 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1596 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1597 0x08, 0x00};
1599 image create bitmap tri-dn -background black -foreground blue -data {
1600 #define tri-dn_width 13
1601 #define tri-dn_height 13
1602 static unsigned char tri-dn_bits[] = {
1603 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1604 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1605 0x00, 0x00};
1606 } -maskdata {
1607 #define tri-dn-mask_width 13
1608 #define tri-dn-mask_height 13
1609 static unsigned char tri-dn-mask_bits[] = {
1610 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1611 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1612 0x00, 0x00};
1615 image create bitmap reficon-T -background black -foreground yellow -data {
1616 #define tagicon_width 13
1617 #define tagicon_height 9
1618 static unsigned char tagicon_bits[] = {
1619 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1620 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1621 } -maskdata {
1622 #define tagicon-mask_width 13
1623 #define tagicon-mask_height 9
1624 static unsigned char tagicon-mask_bits[] = {
1625 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1626 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1628 set rectdata {
1629 #define headicon_width 13
1630 #define headicon_height 9
1631 static unsigned char headicon_bits[] = {
1632 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1633 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1635 set rectmask {
1636 #define headicon-mask_width 13
1637 #define headicon-mask_height 9
1638 static unsigned char headicon-mask_bits[] = {
1639 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1640 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1642 image create bitmap reficon-H -background black -foreground green \
1643 -data $rectdata -maskdata $rectmask
1644 image create bitmap reficon-o -background black -foreground "#ddddff" \
1645 -data $rectdata -maskdata $rectmask
1647 proc init_flist {first} {
1648 global cflist cflist_top selectedline difffilestart
1650 $cflist conf -state normal
1651 $cflist delete 0.0 end
1652 if {$first ne {}} {
1653 $cflist insert end $first
1654 set cflist_top 1
1655 $cflist tag add highlight 1.0 "1.0 lineend"
1656 } else {
1657 catch {unset cflist_top}
1659 $cflist conf -state disabled
1660 set difffilestart {}
1663 proc highlight_tag {f} {
1664 global highlight_paths
1666 foreach p $highlight_paths {
1667 if {[string match $p $f]} {
1668 return "bold"
1671 return {}
1674 proc highlight_filelist {} {
1675 global cmitmode cflist
1677 $cflist conf -state normal
1678 if {$cmitmode ne "tree"} {
1679 set end [lindex [split [$cflist index end] .] 0]
1680 for {set l 2} {$l < $end} {incr l} {
1681 set line [$cflist get $l.0 "$l.0 lineend"]
1682 if {[highlight_tag $line] ne {}} {
1683 $cflist tag add bold $l.0 "$l.0 lineend"
1686 } else {
1687 highlight_tree 2 {}
1689 $cflist conf -state disabled
1692 proc unhighlight_filelist {} {
1693 global cflist
1695 $cflist conf -state normal
1696 $cflist tag remove bold 1.0 end
1697 $cflist conf -state disabled
1700 proc add_flist {fl} {
1701 global cflist
1703 $cflist conf -state normal
1704 foreach f $fl {
1705 $cflist insert end "\n"
1706 $cflist insert end $f [highlight_tag $f]
1708 $cflist conf -state disabled
1711 proc sel_flist {w x y} {
1712 global ctext difffilestart cflist cflist_top cmitmode
1714 if {$cmitmode eq "tree"} return
1715 if {![info exists cflist_top]} return
1716 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1717 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1718 $cflist tag add highlight $l.0 "$l.0 lineend"
1719 set cflist_top $l
1720 if {$l == 1} {
1721 $ctext yview 1.0
1722 } else {
1723 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1727 proc pop_flist_menu {w X Y x y} {
1728 global ctext cflist cmitmode flist_menu flist_menu_file
1729 global treediffs diffids
1731 stopfinding
1732 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1733 if {$l <= 1} return
1734 if {$cmitmode eq "tree"} {
1735 set e [linetoelt $l]
1736 if {[string index $e end] eq "/"} return
1737 } else {
1738 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1740 set flist_menu_file $e
1741 tk_popup $flist_menu $X $Y
1744 proc flist_hl {only} {
1745 global flist_menu_file findstring gdttype
1747 set x [shellquote $flist_menu_file]
1748 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1749 set findstring $x
1750 } else {
1751 append findstring " " $x
1753 set gdttype [mc "touching paths:"]
1756 # Functions for adding and removing shell-type quoting
1758 proc shellquote {str} {
1759 if {![string match "*\['\"\\ \t]*" $str]} {
1760 return $str
1762 if {![string match "*\['\"\\]*" $str]} {
1763 return "\"$str\""
1765 if {![string match "*'*" $str]} {
1766 return "'$str'"
1768 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1771 proc shellarglist {l} {
1772 set str {}
1773 foreach a $l {
1774 if {$str ne {}} {
1775 append str " "
1777 append str [shellquote $a]
1779 return $str
1782 proc shelldequote {str} {
1783 set ret {}
1784 set used -1
1785 while {1} {
1786 incr used
1787 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1788 append ret [string range $str $used end]
1789 set used [string length $str]
1790 break
1792 set first [lindex $first 0]
1793 set ch [string index $str $first]
1794 if {$first > $used} {
1795 append ret [string range $str $used [expr {$first - 1}]]
1796 set used $first
1798 if {$ch eq " " || $ch eq "\t"} break
1799 incr used
1800 if {$ch eq "'"} {
1801 set first [string first "'" $str $used]
1802 if {$first < 0} {
1803 error "unmatched single-quote"
1805 append ret [string range $str $used [expr {$first - 1}]]
1806 set used $first
1807 continue
1809 if {$ch eq "\\"} {
1810 if {$used >= [string length $str]} {
1811 error "trailing backslash"
1813 append ret [string index $str $used]
1814 continue
1816 # here ch == "\""
1817 while {1} {
1818 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1819 error "unmatched double-quote"
1821 set first [lindex $first 0]
1822 set ch [string index $str $first]
1823 if {$first > $used} {
1824 append ret [string range $str $used [expr {$first - 1}]]
1825 set used $first
1827 if {$ch eq "\""} break
1828 incr used
1829 append ret [string index $str $used]
1830 incr used
1833 return [list $used $ret]
1836 proc shellsplit {str} {
1837 set l {}
1838 while {1} {
1839 set str [string trimleft $str]
1840 if {$str eq {}} break
1841 set dq [shelldequote $str]
1842 set n [lindex $dq 0]
1843 set word [lindex $dq 1]
1844 set str [string range $str $n end]
1845 lappend l $word
1847 return $l
1850 # Code to implement multiple views
1852 proc newview {ishighlight} {
1853 global nextviewnum newviewname newviewperm newishighlight
1854 global newviewargs revtreeargs
1856 set newishighlight $ishighlight
1857 set top .gitkview
1858 if {[winfo exists $top]} {
1859 raise $top
1860 return
1862 set newviewname($nextviewnum) "View $nextviewnum"
1863 set newviewperm($nextviewnum) 0
1864 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1865 vieweditor $top $nextviewnum [mc "Gitk view definition"]
1868 proc editview {} {
1869 global curview
1870 global viewname viewperm newviewname newviewperm
1871 global viewargs newviewargs
1873 set top .gitkvedit-$curview
1874 if {[winfo exists $top]} {
1875 raise $top
1876 return
1878 set newviewname($curview) $viewname($curview)
1879 set newviewperm($curview) $viewperm($curview)
1880 set newviewargs($curview) [shellarglist $viewargs($curview)]
1881 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1884 proc vieweditor {top n title} {
1885 global newviewname newviewperm viewfiles bgcolor
1887 toplevel $top
1888 wm title $top $title
1889 label $top.nl -text [mc "Name"]
1890 entry $top.name -width 20 -textvariable newviewname($n)
1891 grid $top.nl $top.name -sticky w -pady 5
1892 checkbutton $top.perm -text [mc "Remember this view"] \
1893 -variable newviewperm($n)
1894 grid $top.perm - -pady 5 -sticky w
1895 message $top.al -aspect 1000 \
1896 -text [mc "Commits to include (arguments to git rev-list):"]
1897 grid $top.al - -sticky w -pady 5
1898 entry $top.args -width 50 -textvariable newviewargs($n) \
1899 -background $bgcolor
1900 grid $top.args - -sticky ew -padx 5
1901 message $top.l -aspect 1000 \
1902 -text [mc "Enter files and directories to include, one per line:"]
1903 grid $top.l - -sticky w
1904 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1905 if {[info exists viewfiles($n)]} {
1906 foreach f $viewfiles($n) {
1907 $top.t insert end $f
1908 $top.t insert end "\n"
1910 $top.t delete {end - 1c} end
1911 $top.t mark set insert 0.0
1913 grid $top.t - -sticky ew -padx 5
1914 frame $top.buts
1915 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1916 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1917 grid $top.buts.ok $top.buts.can
1918 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1919 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1920 grid $top.buts - -pady 10 -sticky ew
1921 focus $top.t
1924 proc doviewmenu {m first cmd op argv} {
1925 set nmenu [$m index end]
1926 for {set i $first} {$i <= $nmenu} {incr i} {
1927 if {[$m entrycget $i -command] eq $cmd} {
1928 eval $m $op $i $argv
1929 break
1934 proc allviewmenus {n op args} {
1935 # global viewhlmenu
1937 doviewmenu .bar.view 5 [list showview $n] $op $args
1938 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1941 proc newviewok {top n} {
1942 global nextviewnum newviewperm newviewname newishighlight
1943 global viewname viewfiles viewperm selectedview curview
1944 global viewargs newviewargs viewhlmenu
1946 if {[catch {
1947 set newargs [shellsplit $newviewargs($n)]
1948 } err]} {
1949 error_popup "[mc "Error in commit selection arguments:"] $err"
1950 wm raise $top
1951 focus $top
1952 return
1954 set files {}
1955 foreach f [split [$top.t get 0.0 end] "\n"] {
1956 set ft [string trim $f]
1957 if {$ft ne {}} {
1958 lappend files $ft
1961 if {![info exists viewfiles($n)]} {
1962 # creating a new view
1963 incr nextviewnum
1964 set viewname($n) $newviewname($n)
1965 set viewperm($n) $newviewperm($n)
1966 set viewfiles($n) $files
1967 set viewargs($n) $newargs
1968 addviewmenu $n
1969 if {!$newishighlight} {
1970 run showview $n
1971 } else {
1972 run addvhighlight $n
1974 } else {
1975 # editing an existing view
1976 set viewperm($n) $newviewperm($n)
1977 if {$newviewname($n) ne $viewname($n)} {
1978 set viewname($n) $newviewname($n)
1979 doviewmenu .bar.view 5 [list showview $n] \
1980 entryconf [list -label $viewname($n)]
1981 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1982 # entryconf [list -label $viewname($n) -value $viewname($n)]
1984 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1985 set viewfiles($n) $files
1986 set viewargs($n) $newargs
1987 if {$curview == $n} {
1988 run updatecommits
1992 catch {destroy $top}
1995 proc delview {} {
1996 global curview viewdata viewperm hlview selectedhlview
1998 if {$curview == 0} return
1999 if {[info exists hlview] && $hlview == $curview} {
2000 set selectedhlview [mc "None"]
2001 unset hlview
2003 allviewmenus $curview delete
2004 set viewdata($curview) {}
2005 set viewperm($curview) 0
2006 showview 0
2009 proc addviewmenu {n} {
2010 global viewname viewhlmenu
2012 .bar.view add radiobutton -label $viewname($n) \
2013 -command [list showview $n] -variable selectedview -value $n
2014 #$viewhlmenu add radiobutton -label $viewname($n) \
2015 # -command [list addvhighlight $n] -variable selectedhlview
2018 proc flatten {var} {
2019 global $var
2021 set ret {}
2022 foreach i [array names $var] {
2023 lappend ret $i [set $var\($i\)]
2025 return $ret
2028 proc unflatten {var l} {
2029 global $var
2031 catch {unset $var}
2032 foreach {i v} $l {
2033 set $var\($i\) $v
2037 proc showview {n} {
2038 global curview viewdata viewfiles
2039 global displayorder parentlist rowidlist rowisopt rowfinal
2040 global colormap rowtextx commitrow nextcolor canvxmax
2041 global numcommits commitlisted
2042 global selectedline currentid canv canvy0
2043 global treediffs
2044 global pending_select phase
2045 global commitidx
2046 global commfd
2047 global selectedview selectfirst
2048 global vparentlist vdisporder vcmitlisted
2049 global hlview selectedhlview commitinterest
2051 if {$n == $curview} return
2052 set selid {}
2053 if {[info exists selectedline]} {
2054 set selid $currentid
2055 set y [yc $selectedline]
2056 set ymax [lindex [$canv cget -scrollregion] 3]
2057 set span [$canv yview]
2058 set ytop [expr {[lindex $span 0] * $ymax}]
2059 set ybot [expr {[lindex $span 1] * $ymax}]
2060 if {$ytop < $y && $y < $ybot} {
2061 set yscreen [expr {$y - $ytop}]
2062 } else {
2063 set yscreen [expr {($ybot - $ytop) / 2}]
2065 } elseif {[info exists pending_select]} {
2066 set selid $pending_select
2067 unset pending_select
2069 unselectline
2070 normalline
2071 if {$curview >= 0} {
2072 set vparentlist($curview) $parentlist
2073 set vdisporder($curview) $displayorder
2074 set vcmitlisted($curview) $commitlisted
2075 if {$phase ne {} ||
2076 ![info exists viewdata($curview)] ||
2077 [lindex $viewdata($curview) 0] ne {}} {
2078 set viewdata($curview) \
2079 [list $phase $rowidlist $rowisopt $rowfinal]
2082 catch {unset treediffs}
2083 clear_display
2084 if {[info exists hlview] && $hlview == $n} {
2085 unset hlview
2086 set selectedhlview [mc "None"]
2088 catch {unset commitinterest}
2090 set curview $n
2091 set selectedview $n
2092 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2093 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2095 run refill_reflist
2096 if {![info exists viewdata($n)]} {
2097 if {$selid ne {}} {
2098 set pending_select $selid
2100 getcommits
2101 return
2104 set v $viewdata($n)
2105 set phase [lindex $v 0]
2106 set displayorder $vdisporder($n)
2107 set parentlist $vparentlist($n)
2108 set commitlisted $vcmitlisted($n)
2109 set rowidlist [lindex $v 1]
2110 set rowisopt [lindex $v 2]
2111 set rowfinal [lindex $v 3]
2112 set numcommits $commitidx($n)
2114 catch {unset colormap}
2115 catch {unset rowtextx}
2116 set nextcolor 0
2117 set canvxmax [$canv cget -width]
2118 set curview $n
2119 set row 0
2120 setcanvscroll
2121 set yf 0
2122 set row {}
2123 set selectfirst 0
2124 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2125 set row $commitrow($n,$selid)
2126 # try to get the selected row in the same position on the screen
2127 set ymax [lindex [$canv cget -scrollregion] 3]
2128 set ytop [expr {[yc $row] - $yscreen}]
2129 if {$ytop < 0} {
2130 set ytop 0
2132 set yf [expr {$ytop * 1.0 / $ymax}]
2134 allcanvs yview moveto $yf
2135 drawvisible
2136 if {$row ne {}} {
2137 selectline $row 0
2138 } elseif {$selid ne {}} {
2139 set pending_select $selid
2140 } else {
2141 set row [first_real_row]
2142 if {$row < $numcommits} {
2143 selectline $row 0
2144 } else {
2145 set selectfirst 1
2148 if {$phase ne {}} {
2149 if {$phase eq "getcommits"} {
2150 show_status [mc "Reading commits..."]
2152 run chewcommits $n
2153 } elseif {$numcommits == 0} {
2154 show_status [mc "No commits selected"]
2158 # Stuff relating to the highlighting facility
2160 proc ishighlighted {row} {
2161 global vhighlights fhighlights nhighlights rhighlights
2163 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2164 return $nhighlights($row)
2166 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2167 return $vhighlights($row)
2169 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2170 return $fhighlights($row)
2172 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2173 return $rhighlights($row)
2175 return 0
2178 proc bolden {row font} {
2179 global canv linehtag selectedline boldrows
2181 lappend boldrows $row
2182 $canv itemconf $linehtag($row) -font $font
2183 if {[info exists selectedline] && $row == $selectedline} {
2184 $canv delete secsel
2185 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2186 -outline {{}} -tags secsel \
2187 -fill [$canv cget -selectbackground]]
2188 $canv lower $t
2192 proc bolden_name {row font} {
2193 global canv2 linentag selectedline boldnamerows
2195 lappend boldnamerows $row
2196 $canv2 itemconf $linentag($row) -font $font
2197 if {[info exists selectedline] && $row == $selectedline} {
2198 $canv2 delete secsel
2199 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2200 -outline {{}} -tags secsel \
2201 -fill [$canv2 cget -selectbackground]]
2202 $canv2 lower $t
2206 proc unbolden {} {
2207 global boldrows
2209 set stillbold {}
2210 foreach row $boldrows {
2211 if {![ishighlighted $row]} {
2212 bolden $row mainfont
2213 } else {
2214 lappend stillbold $row
2217 set boldrows $stillbold
2220 proc addvhighlight {n} {
2221 global hlview curview viewdata vhl_done vhighlights commitidx
2223 if {[info exists hlview]} {
2224 delvhighlight
2226 set hlview $n
2227 if {$n != $curview && ![info exists viewdata($n)]} {
2228 set viewdata($n) [list getcommits {{}} 0 0 0]
2229 set vparentlist($n) {}
2230 set vdisporder($n) {}
2231 set vcmitlisted($n) {}
2232 start_rev_list $n
2234 set vhl_done $commitidx($hlview)
2235 if {$vhl_done > 0} {
2236 drawvisible
2240 proc delvhighlight {} {
2241 global hlview vhighlights
2243 if {![info exists hlview]} return
2244 unset hlview
2245 catch {unset vhighlights}
2246 unbolden
2249 proc vhighlightmore {} {
2250 global hlview vhl_done commitidx vhighlights
2251 global displayorder vdisporder curview
2253 set max $commitidx($hlview)
2254 if {$hlview == $curview} {
2255 set disp $displayorder
2256 } else {
2257 set disp $vdisporder($hlview)
2259 set vr [visiblerows]
2260 set r0 [lindex $vr 0]
2261 set r1 [lindex $vr 1]
2262 for {set i $vhl_done} {$i < $max} {incr i} {
2263 set id [lindex $disp $i]
2264 if {[info exists commitrow($curview,$id)]} {
2265 set row $commitrow($curview,$id)
2266 if {$r0 <= $row && $row <= $r1} {
2267 if {![highlighted $row]} {
2268 bolden $row mainfontbold
2270 set vhighlights($row) 1
2274 set vhl_done $max
2277 proc askvhighlight {row id} {
2278 global hlview vhighlights commitrow iddrawn
2280 if {[info exists commitrow($hlview,$id)]} {
2281 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2282 bolden $row mainfontbold
2284 set vhighlights($row) 1
2285 } else {
2286 set vhighlights($row) 0
2290 proc hfiles_change {} {
2291 global highlight_files filehighlight fhighlights fh_serial
2292 global highlight_paths gdttype
2294 if {[info exists filehighlight]} {
2295 # delete previous highlights
2296 catch {close $filehighlight}
2297 unset filehighlight
2298 catch {unset fhighlights}
2299 unbolden
2300 unhighlight_filelist
2302 set highlight_paths {}
2303 after cancel do_file_hl $fh_serial
2304 incr fh_serial
2305 if {$highlight_files ne {}} {
2306 after 300 do_file_hl $fh_serial
2310 proc gdttype_change {name ix op} {
2311 global gdttype highlight_files findstring findpattern
2313 stopfinding
2314 if {$findstring ne {}} {
2315 if {$gdttype eq [mc "containing:"]} {
2316 if {$highlight_files ne {}} {
2317 set highlight_files {}
2318 hfiles_change
2320 findcom_change
2321 } else {
2322 if {$findpattern ne {}} {
2323 set findpattern {}
2324 findcom_change
2326 set highlight_files $findstring
2327 hfiles_change
2329 drawvisible
2331 # enable/disable findtype/findloc menus too
2334 proc find_change {name ix op} {
2335 global gdttype findstring highlight_files
2337 stopfinding
2338 if {$gdttype eq [mc "containing:"]} {
2339 findcom_change
2340 } else {
2341 if {$highlight_files ne $findstring} {
2342 set highlight_files $findstring
2343 hfiles_change
2346 drawvisible
2349 proc findcom_change args {
2350 global nhighlights boldnamerows
2351 global findpattern findtype findstring gdttype
2353 stopfinding
2354 # delete previous highlights, if any
2355 foreach row $boldnamerows {
2356 bolden_name $row mainfont
2358 set boldnamerows {}
2359 catch {unset nhighlights}
2360 unbolden
2361 unmarkmatches
2362 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2363 set findpattern {}
2364 } elseif {$findtype eq [mc "Regexp"]} {
2365 set findpattern $findstring
2366 } else {
2367 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2368 $findstring]
2369 set findpattern "*$e*"
2373 proc makepatterns {l} {
2374 set ret {}
2375 foreach e $l {
2376 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2377 if {[string index $ee end] eq "/"} {
2378 lappend ret "$ee*"
2379 } else {
2380 lappend ret $ee
2381 lappend ret "$ee/*"
2384 return $ret
2387 proc do_file_hl {serial} {
2388 global highlight_files filehighlight highlight_paths gdttype fhl_list
2390 if {$gdttype eq [mc "touching paths:"]} {
2391 if {[catch {set paths [shellsplit $highlight_files]}]} return
2392 set highlight_paths [makepatterns $paths]
2393 highlight_filelist
2394 set gdtargs [concat -- $paths]
2395 } elseif {$gdttype eq [mc "adding/removing string:"]} {
2396 set gdtargs [list "-S$highlight_files"]
2397 } else {
2398 # must be "containing:", i.e. we're searching commit info
2399 return
2401 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2402 set filehighlight [open $cmd r+]
2403 fconfigure $filehighlight -blocking 0
2404 filerun $filehighlight readfhighlight
2405 set fhl_list {}
2406 drawvisible
2407 flushhighlights
2410 proc flushhighlights {} {
2411 global filehighlight fhl_list
2413 if {[info exists filehighlight]} {
2414 lappend fhl_list {}
2415 puts $filehighlight ""
2416 flush $filehighlight
2420 proc askfilehighlight {row id} {
2421 global filehighlight fhighlights fhl_list
2423 lappend fhl_list $id
2424 set fhighlights($row) -1
2425 puts $filehighlight $id
2428 proc readfhighlight {} {
2429 global filehighlight fhighlights commitrow curview iddrawn
2430 global fhl_list find_dirn
2432 if {![info exists filehighlight]} {
2433 return 0
2435 set nr 0
2436 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2437 set line [string trim $line]
2438 set i [lsearch -exact $fhl_list $line]
2439 if {$i < 0} continue
2440 for {set j 0} {$j < $i} {incr j} {
2441 set id [lindex $fhl_list $j]
2442 if {[info exists commitrow($curview,$id)]} {
2443 set fhighlights($commitrow($curview,$id)) 0
2446 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2447 if {$line eq {}} continue
2448 if {![info exists commitrow($curview,$line)]} continue
2449 set row $commitrow($curview,$line)
2450 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2451 bolden $row mainfontbold
2453 set fhighlights($row) 1
2455 if {[eof $filehighlight]} {
2456 # strange...
2457 puts "oops, git diff-tree died"
2458 catch {close $filehighlight}
2459 unset filehighlight
2460 return 0
2462 if {[info exists find_dirn]} {
2463 run findmore
2465 return 1
2468 proc doesmatch {f} {
2469 global findtype findpattern
2471 if {$findtype eq [mc "Regexp"]} {
2472 return [regexp $findpattern $f]
2473 } elseif {$findtype eq [mc "IgnCase"]} {
2474 return [string match -nocase $findpattern $f]
2475 } else {
2476 return [string match $findpattern $f]
2480 proc askfindhighlight {row id} {
2481 global nhighlights commitinfo iddrawn
2482 global findloc
2483 global markingmatches
2485 if {![info exists commitinfo($id)]} {
2486 getcommit $id
2488 set info $commitinfo($id)
2489 set isbold 0
2490 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2491 foreach f $info ty $fldtypes {
2492 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2493 [doesmatch $f]} {
2494 if {$ty eq [mc "Author"]} {
2495 set isbold 2
2496 break
2498 set isbold 1
2501 if {$isbold && [info exists iddrawn($id)]} {
2502 if {![ishighlighted $row]} {
2503 bolden $row mainfontbold
2504 if {$isbold > 1} {
2505 bolden_name $row mainfontbold
2508 if {$markingmatches} {
2509 markrowmatches $row $id
2512 set nhighlights($row) $isbold
2515 proc markrowmatches {row id} {
2516 global canv canv2 linehtag linentag commitinfo findloc
2518 set headline [lindex $commitinfo($id) 0]
2519 set author [lindex $commitinfo($id) 1]
2520 $canv delete match$row
2521 $canv2 delete match$row
2522 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2523 set m [findmatches $headline]
2524 if {$m ne {}} {
2525 markmatches $canv $row $headline $linehtag($row) $m \
2526 [$canv itemcget $linehtag($row) -font] $row
2529 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2530 set m [findmatches $author]
2531 if {$m ne {}} {
2532 markmatches $canv2 $row $author $linentag($row) $m \
2533 [$canv2 itemcget $linentag($row) -font] $row
2538 proc vrel_change {name ix op} {
2539 global highlight_related
2541 rhighlight_none
2542 if {$highlight_related ne [mc "None"]} {
2543 run drawvisible
2547 # prepare for testing whether commits are descendents or ancestors of a
2548 proc rhighlight_sel {a} {
2549 global descendent desc_todo ancestor anc_todo
2550 global highlight_related rhighlights
2552 catch {unset descendent}
2553 set desc_todo [list $a]
2554 catch {unset ancestor}
2555 set anc_todo [list $a]
2556 if {$highlight_related ne [mc "None"]} {
2557 rhighlight_none
2558 run drawvisible
2562 proc rhighlight_none {} {
2563 global rhighlights
2565 catch {unset rhighlights}
2566 unbolden
2569 proc is_descendent {a} {
2570 global curview children commitrow descendent desc_todo
2572 set v $curview
2573 set la $commitrow($v,$a)
2574 set todo $desc_todo
2575 set leftover {}
2576 set done 0
2577 for {set i 0} {$i < [llength $todo]} {incr i} {
2578 set do [lindex $todo $i]
2579 if {$commitrow($v,$do) < $la} {
2580 lappend leftover $do
2581 continue
2583 foreach nk $children($v,$do) {
2584 if {![info exists descendent($nk)]} {
2585 set descendent($nk) 1
2586 lappend todo $nk
2587 if {$nk eq $a} {
2588 set done 1
2592 if {$done} {
2593 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2594 return
2597 set descendent($a) 0
2598 set desc_todo $leftover
2601 proc is_ancestor {a} {
2602 global curview parentlist commitrow ancestor anc_todo
2604 set v $curview
2605 set la $commitrow($v,$a)
2606 set todo $anc_todo
2607 set leftover {}
2608 set done 0
2609 for {set i 0} {$i < [llength $todo]} {incr i} {
2610 set do [lindex $todo $i]
2611 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2612 lappend leftover $do
2613 continue
2615 foreach np [lindex $parentlist $commitrow($v,$do)] {
2616 if {![info exists ancestor($np)]} {
2617 set ancestor($np) 1
2618 lappend todo $np
2619 if {$np eq $a} {
2620 set done 1
2624 if {$done} {
2625 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2626 return
2629 set ancestor($a) 0
2630 set anc_todo $leftover
2633 proc askrelhighlight {row id} {
2634 global descendent highlight_related iddrawn rhighlights
2635 global selectedline ancestor
2637 if {![info exists selectedline]} return
2638 set isbold 0
2639 if {$highlight_related eq [mc "Descendant"] ||
2640 $highlight_related eq [mc "Not descendant"]} {
2641 if {![info exists descendent($id)]} {
2642 is_descendent $id
2644 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2645 set isbold 1
2647 } elseif {$highlight_related eq [mc "Ancestor"] ||
2648 $highlight_related eq [mc "Not ancestor"]} {
2649 if {![info exists ancestor($id)]} {
2650 is_ancestor $id
2652 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2653 set isbold 1
2656 if {[info exists iddrawn($id)]} {
2657 if {$isbold && ![ishighlighted $row]} {
2658 bolden $row mainfontbold
2661 set rhighlights($row) $isbold
2664 # Graph layout functions
2666 proc shortids {ids} {
2667 set res {}
2668 foreach id $ids {
2669 if {[llength $id] > 1} {
2670 lappend res [shortids $id]
2671 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2672 lappend res [string range $id 0 7]
2673 } else {
2674 lappend res $id
2677 return $res
2680 proc ntimes {n o} {
2681 set ret {}
2682 set o [list $o]
2683 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2684 if {($n & $mask) != 0} {
2685 set ret [concat $ret $o]
2687 set o [concat $o $o]
2689 return $ret
2692 # Work out where id should go in idlist so that order-token
2693 # values increase from left to right
2694 proc idcol {idlist id {i 0}} {
2695 global ordertok curview
2697 set t $ordertok($curview,$id)
2698 if {$i >= [llength $idlist] ||
2699 $t < $ordertok($curview,[lindex $idlist $i])} {
2700 if {$i > [llength $idlist]} {
2701 set i [llength $idlist]
2703 while {[incr i -1] >= 0 &&
2704 $t < $ordertok($curview,[lindex $idlist $i])} {}
2705 incr i
2706 } else {
2707 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2708 while {[incr i] < [llength $idlist] &&
2709 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2712 return $i
2715 proc initlayout {} {
2716 global rowidlist rowisopt rowfinal displayorder commitlisted
2717 global numcommits canvxmax canv
2718 global nextcolor
2719 global parentlist
2720 global colormap rowtextx
2721 global selectfirst
2723 set numcommits 0
2724 set displayorder {}
2725 set commitlisted {}
2726 set parentlist {}
2727 set nextcolor 0
2728 set rowidlist {}
2729 set rowisopt {}
2730 set rowfinal {}
2731 set canvxmax [$canv cget -width]
2732 catch {unset colormap}
2733 catch {unset rowtextx}
2734 set selectfirst 1
2737 proc setcanvscroll {} {
2738 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2740 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2741 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2742 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2743 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2746 proc visiblerows {} {
2747 global canv numcommits linespc
2749 set ymax [lindex [$canv cget -scrollregion] 3]
2750 if {$ymax eq {} || $ymax == 0} return
2751 set f [$canv yview]
2752 set y0 [expr {int([lindex $f 0] * $ymax)}]
2753 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2754 if {$r0 < 0} {
2755 set r0 0
2757 set y1 [expr {int([lindex $f 1] * $ymax)}]
2758 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2759 if {$r1 >= $numcommits} {
2760 set r1 [expr {$numcommits - 1}]
2762 return [list $r0 $r1]
2765 proc layoutmore {} {
2766 global commitidx viewcomplete numcommits
2767 global uparrowlen downarrowlen mingaplen curview
2769 set show $commitidx($curview)
2770 if {$show > $numcommits || $viewcomplete($curview)} {
2771 showstuff $show $viewcomplete($curview)
2775 proc showstuff {canshow last} {
2776 global numcommits commitrow pending_select selectedline curview
2777 global mainheadid displayorder selectfirst
2778 global lastscrollset commitinterest
2780 if {$numcommits == 0} {
2781 global phase
2782 set phase "incrdraw"
2783 allcanvs delete all
2785 set r0 $numcommits
2786 set prev $numcommits
2787 set numcommits $canshow
2788 set t [clock clicks -milliseconds]
2789 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2790 set lastscrollset $t
2791 setcanvscroll
2793 set rows [visiblerows]
2794 set r1 [lindex $rows 1]
2795 if {$r1 >= $canshow} {
2796 set r1 [expr {$canshow - 1}]
2798 if {$r0 <= $r1} {
2799 drawcommits $r0 $r1
2801 if {[info exists pending_select] &&
2802 [info exists commitrow($curview,$pending_select)] &&
2803 $commitrow($curview,$pending_select) < $numcommits} {
2804 selectline $commitrow($curview,$pending_select) 1
2806 if {$selectfirst} {
2807 if {[info exists selectedline] || [info exists pending_select]} {
2808 set selectfirst 0
2809 } else {
2810 set l [first_real_row]
2811 selectline $l 1
2812 set selectfirst 0
2817 proc doshowlocalchanges {} {
2818 global curview mainheadid phase commitrow
2820 if {[info exists commitrow($curview,$mainheadid)] &&
2821 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2822 dodiffindex
2823 } elseif {$phase ne {}} {
2824 lappend commitinterest($mainheadid) {}
2828 proc dohidelocalchanges {} {
2829 global localfrow localirow lserial
2831 if {$localfrow >= 0} {
2832 removerow $localfrow
2833 set localfrow -1
2834 if {$localirow > 0} {
2835 incr localirow -1
2838 if {$localirow >= 0} {
2839 removerow $localirow
2840 set localirow -1
2842 incr lserial
2845 # spawn off a process to do git diff-index --cached HEAD
2846 proc dodiffindex {} {
2847 global localirow localfrow lserial showlocalchanges
2849 if {!$showlocalchanges} return
2850 incr lserial
2851 set localfrow -1
2852 set localirow -1
2853 set fd [open "|git diff-index --cached HEAD" r]
2854 fconfigure $fd -blocking 0
2855 filerun $fd [list readdiffindex $fd $lserial]
2858 proc readdiffindex {fd serial} {
2859 global localirow commitrow mainheadid nullid2 curview
2860 global commitinfo commitdata lserial
2862 set isdiff 1
2863 if {[gets $fd line] < 0} {
2864 if {![eof $fd]} {
2865 return 1
2867 set isdiff 0
2869 # we only need to see one line and we don't really care what it says...
2870 close $fd
2872 # now see if there are any local changes not checked in to the index
2873 if {$serial == $lserial} {
2874 set fd [open "|git diff-files" r]
2875 fconfigure $fd -blocking 0
2876 filerun $fd [list readdifffiles $fd $serial]
2879 if {$isdiff && $serial == $lserial && $localirow == -1} {
2880 # add the line for the changes in the index to the graph
2881 set localirow $commitrow($curview,$mainheadid)
2882 set hl [mc "Local changes checked in to index but not committed"]
2883 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2884 set commitdata($nullid2) "\n $hl\n"
2885 insertrow $localirow $nullid2
2887 return 0
2890 proc readdifffiles {fd serial} {
2891 global localirow localfrow commitrow mainheadid nullid curview
2892 global commitinfo commitdata lserial
2894 set isdiff 1
2895 if {[gets $fd line] < 0} {
2896 if {![eof $fd]} {
2897 return 1
2899 set isdiff 0
2901 # we only need to see one line and we don't really care what it says...
2902 close $fd
2904 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2905 # add the line for the local diff to the graph
2906 if {$localirow >= 0} {
2907 set localfrow $localirow
2908 incr localirow
2909 } else {
2910 set localfrow $commitrow($curview,$mainheadid)
2912 set hl [mc "Local uncommitted changes, not checked in to index"]
2913 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2914 set commitdata($nullid) "\n $hl\n"
2915 insertrow $localfrow $nullid
2917 return 0
2920 proc nextuse {id row} {
2921 global commitrow curview children
2923 if {[info exists children($curview,$id)]} {
2924 foreach kid $children($curview,$id) {
2925 if {![info exists commitrow($curview,$kid)]} {
2926 return -1
2928 if {$commitrow($curview,$kid) > $row} {
2929 return $commitrow($curview,$kid)
2933 if {[info exists commitrow($curview,$id)]} {
2934 return $commitrow($curview,$id)
2936 return -1
2939 proc prevuse {id row} {
2940 global commitrow curview children
2942 set ret -1
2943 if {[info exists children($curview,$id)]} {
2944 foreach kid $children($curview,$id) {
2945 if {![info exists commitrow($curview,$kid)]} break
2946 if {$commitrow($curview,$kid) < $row} {
2947 set ret $commitrow($curview,$kid)
2951 return $ret
2954 proc make_idlist {row} {
2955 global displayorder parentlist uparrowlen downarrowlen mingaplen
2956 global commitidx curview ordertok children commitrow
2958 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2959 if {$r < 0} {
2960 set r 0
2962 set ra [expr {$row - $downarrowlen}]
2963 if {$ra < 0} {
2964 set ra 0
2966 set rb [expr {$row + $uparrowlen}]
2967 if {$rb > $commitidx($curview)} {
2968 set rb $commitidx($curview)
2970 set ids {}
2971 for {} {$r < $ra} {incr r} {
2972 set nextid [lindex $displayorder [expr {$r + 1}]]
2973 foreach p [lindex $parentlist $r] {
2974 if {$p eq $nextid} continue
2975 set rn [nextuse $p $r]
2976 if {$rn >= $row &&
2977 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2978 lappend ids [list $ordertok($curview,$p) $p]
2982 for {} {$r < $row} {incr r} {
2983 set nextid [lindex $displayorder [expr {$r + 1}]]
2984 foreach p [lindex $parentlist $r] {
2985 if {$p eq $nextid} continue
2986 set rn [nextuse $p $r]
2987 if {$rn < 0 || $rn >= $row} {
2988 lappend ids [list $ordertok($curview,$p) $p]
2992 set id [lindex $displayorder $row]
2993 lappend ids [list $ordertok($curview,$id) $id]
2994 while {$r < $rb} {
2995 foreach p [lindex $parentlist $r] {
2996 set firstkid [lindex $children($curview,$p) 0]
2997 if {$commitrow($curview,$firstkid) < $row} {
2998 lappend ids [list $ordertok($curview,$p) $p]
3001 incr r
3002 set id [lindex $displayorder $r]
3003 if {$id ne {}} {
3004 set firstkid [lindex $children($curview,$id) 0]
3005 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3006 lappend ids [list $ordertok($curview,$id) $id]
3010 set idlist {}
3011 foreach idx [lsort -unique $ids] {
3012 lappend idlist [lindex $idx 1]
3014 return $idlist
3017 proc rowsequal {a b} {
3018 while {[set i [lsearch -exact $a {}]] >= 0} {
3019 set a [lreplace $a $i $i]
3021 while {[set i [lsearch -exact $b {}]] >= 0} {
3022 set b [lreplace $b $i $i]
3024 return [expr {$a eq $b}]
3027 proc makeupline {id row rend col} {
3028 global rowidlist uparrowlen downarrowlen mingaplen
3030 for {set r $rend} {1} {set r $rstart} {
3031 set rstart [prevuse $id $r]
3032 if {$rstart < 0} return
3033 if {$rstart < $row} break
3035 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3036 set rstart [expr {$rend - $uparrowlen - 1}]
3038 for {set r $rstart} {[incr r] <= $row} {} {
3039 set idlist [lindex $rowidlist $r]
3040 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3041 set col [idcol $idlist $id $col]
3042 lset rowidlist $r [linsert $idlist $col $id]
3043 changedrow $r
3048 proc layoutrows {row endrow} {
3049 global rowidlist rowisopt rowfinal displayorder
3050 global uparrowlen downarrowlen maxwidth mingaplen
3051 global children parentlist
3052 global commitidx viewcomplete curview commitrow
3054 set idlist {}
3055 if {$row > 0} {
3056 set rm1 [expr {$row - 1}]
3057 foreach id [lindex $rowidlist $rm1] {
3058 if {$id ne {}} {
3059 lappend idlist $id
3062 set final [lindex $rowfinal $rm1]
3064 for {} {$row < $endrow} {incr row} {
3065 set rm1 [expr {$row - 1}]
3066 if {$rm1 < 0 || $idlist eq {}} {
3067 set idlist [make_idlist $row]
3068 set final 1
3069 } else {
3070 set id [lindex $displayorder $rm1]
3071 set col [lsearch -exact $idlist $id]
3072 set idlist [lreplace $idlist $col $col]
3073 foreach p [lindex $parentlist $rm1] {
3074 if {[lsearch -exact $idlist $p] < 0} {
3075 set col [idcol $idlist $p $col]
3076 set idlist [linsert $idlist $col $p]
3077 # if not the first child, we have to insert a line going up
3078 if {$id ne [lindex $children($curview,$p) 0]} {
3079 makeupline $p $rm1 $row $col
3083 set id [lindex $displayorder $row]
3084 if {$row > $downarrowlen} {
3085 set termrow [expr {$row - $downarrowlen - 1}]
3086 foreach p [lindex $parentlist $termrow] {
3087 set i [lsearch -exact $idlist $p]
3088 if {$i < 0} continue
3089 set nr [nextuse $p $termrow]
3090 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3091 set idlist [lreplace $idlist $i $i]
3095 set col [lsearch -exact $idlist $id]
3096 if {$col < 0} {
3097 set col [idcol $idlist $id]
3098 set idlist [linsert $idlist $col $id]
3099 if {$children($curview,$id) ne {}} {
3100 makeupline $id $rm1 $row $col
3103 set r [expr {$row + $uparrowlen - 1}]
3104 if {$r < $commitidx($curview)} {
3105 set x $col
3106 foreach p [lindex $parentlist $r] {
3107 if {[lsearch -exact $idlist $p] >= 0} continue
3108 set fk [lindex $children($curview,$p) 0]
3109 if {$commitrow($curview,$fk) < $row} {
3110 set x [idcol $idlist $p $x]
3111 set idlist [linsert $idlist $x $p]
3114 if {[incr r] < $commitidx($curview)} {
3115 set p [lindex $displayorder $r]
3116 if {[lsearch -exact $idlist $p] < 0} {
3117 set fk [lindex $children($curview,$p) 0]
3118 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3119 set x [idcol $idlist $p $x]
3120 set idlist [linsert $idlist $x $p]
3126 if {$final && !$viewcomplete($curview) &&
3127 $row + $uparrowlen + $mingaplen + $downarrowlen
3128 >= $commitidx($curview)} {
3129 set final 0
3131 set l [llength $rowidlist]
3132 if {$row == $l} {
3133 lappend rowidlist $idlist
3134 lappend rowisopt 0
3135 lappend rowfinal $final
3136 } elseif {$row < $l} {
3137 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3138 lset rowidlist $row $idlist
3139 changedrow $row
3141 lset rowfinal $row $final
3142 } else {
3143 set pad [ntimes [expr {$row - $l}] {}]
3144 set rowidlist [concat $rowidlist $pad]
3145 lappend rowidlist $idlist
3146 set rowfinal [concat $rowfinal $pad]
3147 lappend rowfinal $final
3148 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3151 return $row
3154 proc changedrow {row} {
3155 global displayorder iddrawn rowisopt need_redisplay
3157 set l [llength $rowisopt]
3158 if {$row < $l} {
3159 lset rowisopt $row 0
3160 if {$row + 1 < $l} {
3161 lset rowisopt [expr {$row + 1}] 0
3162 if {$row + 2 < $l} {
3163 lset rowisopt [expr {$row + 2}] 0
3167 set id [lindex $displayorder $row]
3168 if {[info exists iddrawn($id)]} {
3169 set need_redisplay 1
3173 proc insert_pad {row col npad} {
3174 global rowidlist
3176 set pad [ntimes $npad {}]
3177 set idlist [lindex $rowidlist $row]
3178 set bef [lrange $idlist 0 [expr {$col - 1}]]
3179 set aft [lrange $idlist $col end]
3180 set i [lsearch -exact $aft {}]
3181 if {$i > 0} {
3182 set aft [lreplace $aft $i $i]
3184 lset rowidlist $row [concat $bef $pad $aft]
3185 changedrow $row
3188 proc optimize_rows {row col endrow} {
3189 global rowidlist rowisopt displayorder curview children
3191 if {$row < 1} {
3192 set row 1
3194 for {} {$row < $endrow} {incr row; set col 0} {
3195 if {[lindex $rowisopt $row]} continue
3196 set haspad 0
3197 set y0 [expr {$row - 1}]
3198 set ym [expr {$row - 2}]
3199 set idlist [lindex $rowidlist $row]
3200 set previdlist [lindex $rowidlist $y0]
3201 if {$idlist eq {} || $previdlist eq {}} continue
3202 if {$ym >= 0} {
3203 set pprevidlist [lindex $rowidlist $ym]
3204 if {$pprevidlist eq {}} continue
3205 } else {
3206 set pprevidlist {}
3208 set x0 -1
3209 set xm -1
3210 for {} {$col < [llength $idlist]} {incr col} {
3211 set id [lindex $idlist $col]
3212 if {[lindex $previdlist $col] eq $id} continue
3213 if {$id eq {}} {
3214 set haspad 1
3215 continue
3217 set x0 [lsearch -exact $previdlist $id]
3218 if {$x0 < 0} continue
3219 set z [expr {$x0 - $col}]
3220 set isarrow 0
3221 set z0 {}
3222 if {$ym >= 0} {
3223 set xm [lsearch -exact $pprevidlist $id]
3224 if {$xm >= 0} {
3225 set z0 [expr {$xm - $x0}]
3228 if {$z0 eq {}} {
3229 # if row y0 is the first child of $id then it's not an arrow
3230 if {[lindex $children($curview,$id) 0] ne
3231 [lindex $displayorder $y0]} {
3232 set isarrow 1
3235 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3236 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3237 set isarrow 1
3239 # Looking at lines from this row to the previous row,
3240 # make them go straight up if they end in an arrow on
3241 # the previous row; otherwise make them go straight up
3242 # or at 45 degrees.
3243 if {$z < -1 || ($z < 0 && $isarrow)} {
3244 # Line currently goes left too much;
3245 # insert pads in the previous row, then optimize it
3246 set npad [expr {-1 - $z + $isarrow}]
3247 insert_pad $y0 $x0 $npad
3248 if {$y0 > 0} {
3249 optimize_rows $y0 $x0 $row
3251 set previdlist [lindex $rowidlist $y0]
3252 set x0 [lsearch -exact $previdlist $id]
3253 set z [expr {$x0 - $col}]
3254 if {$z0 ne {}} {
3255 set pprevidlist [lindex $rowidlist $ym]
3256 set xm [lsearch -exact $pprevidlist $id]
3257 set z0 [expr {$xm - $x0}]
3259 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3260 # Line currently goes right too much;
3261 # insert pads in this line
3262 set npad [expr {$z - 1 + $isarrow}]
3263 insert_pad $row $col $npad
3264 set idlist [lindex $rowidlist $row]
3265 incr col $npad
3266 set z [expr {$x0 - $col}]
3267 set haspad 1
3269 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3270 # this line links to its first child on row $row-2
3271 set id [lindex $displayorder $ym]
3272 set xc [lsearch -exact $pprevidlist $id]
3273 if {$xc >= 0} {
3274 set z0 [expr {$xc - $x0}]
3277 # avoid lines jigging left then immediately right
3278 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3279 insert_pad $y0 $x0 1
3280 incr x0
3281 optimize_rows $y0 $x0 $row
3282 set previdlist [lindex $rowidlist $y0]
3285 if {!$haspad} {
3286 # Find the first column that doesn't have a line going right
3287 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3288 set id [lindex $idlist $col]
3289 if {$id eq {}} break
3290 set x0 [lsearch -exact $previdlist $id]
3291 if {$x0 < 0} {
3292 # check if this is the link to the first child
3293 set kid [lindex $displayorder $y0]
3294 if {[lindex $children($curview,$id) 0] eq $kid} {
3295 # it is, work out offset to child
3296 set x0 [lsearch -exact $previdlist $kid]
3299 if {$x0 <= $col} break
3301 # Insert a pad at that column as long as it has a line and
3302 # isn't the last column
3303 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3304 set idlist [linsert $idlist $col {}]
3305 lset rowidlist $row $idlist
3306 changedrow $row
3312 proc xc {row col} {
3313 global canvx0 linespc
3314 return [expr {$canvx0 + $col * $linespc}]
3317 proc yc {row} {
3318 global canvy0 linespc
3319 return [expr {$canvy0 + $row * $linespc}]
3322 proc linewidth {id} {
3323 global thickerline lthickness
3325 set wid $lthickness
3326 if {[info exists thickerline] && $id eq $thickerline} {
3327 set wid [expr {2 * $lthickness}]
3329 return $wid
3332 proc rowranges {id} {
3333 global commitrow curview children uparrowlen downarrowlen
3334 global rowidlist
3336 set kids $children($curview,$id)
3337 if {$kids eq {}} {
3338 return {}
3340 set ret {}
3341 lappend kids $id
3342 foreach child $kids {
3343 if {![info exists commitrow($curview,$child)]} break
3344 set row $commitrow($curview,$child)
3345 if {![info exists prev]} {
3346 lappend ret [expr {$row + 1}]
3347 } else {
3348 if {$row <= $prevrow} {
3349 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3351 # see if the line extends the whole way from prevrow to row
3352 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3353 [lsearch -exact [lindex $rowidlist \
3354 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3355 # it doesn't, see where it ends
3356 set r [expr {$prevrow + $downarrowlen}]
3357 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3358 while {[incr r -1] > $prevrow &&
3359 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3360 } else {
3361 while {[incr r] <= $row &&
3362 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3363 incr r -1
3365 lappend ret $r
3366 # see where it starts up again
3367 set r [expr {$row - $uparrowlen}]
3368 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3369 while {[incr r] < $row &&
3370 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3371 } else {
3372 while {[incr r -1] >= $prevrow &&
3373 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3374 incr r
3376 lappend ret $r
3379 if {$child eq $id} {
3380 lappend ret $row
3382 set prev $id
3383 set prevrow $row
3385 return $ret
3388 proc drawlineseg {id row endrow arrowlow} {
3389 global rowidlist displayorder iddrawn linesegs
3390 global canv colormap linespc curview maxlinelen parentlist
3392 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3393 set le [expr {$row + 1}]
3394 set arrowhigh 1
3395 while {1} {
3396 set c [lsearch -exact [lindex $rowidlist $le] $id]
3397 if {$c < 0} {
3398 incr le -1
3399 break
3401 lappend cols $c
3402 set x [lindex $displayorder $le]
3403 if {$x eq $id} {
3404 set arrowhigh 0
3405 break
3407 if {[info exists iddrawn($x)] || $le == $endrow} {
3408 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3409 if {$c >= 0} {
3410 lappend cols $c
3411 set arrowhigh 0
3413 break
3415 incr le
3417 if {$le <= $row} {
3418 return $row
3421 set lines {}
3422 set i 0
3423 set joinhigh 0
3424 if {[info exists linesegs($id)]} {
3425 set lines $linesegs($id)
3426 foreach li $lines {
3427 set r0 [lindex $li 0]
3428 if {$r0 > $row} {
3429 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3430 set joinhigh 1
3432 break
3434 incr i
3437 set joinlow 0
3438 if {$i > 0} {
3439 set li [lindex $lines [expr {$i-1}]]
3440 set r1 [lindex $li 1]
3441 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3442 set joinlow 1
3446 set x [lindex $cols [expr {$le - $row}]]
3447 set xp [lindex $cols [expr {$le - 1 - $row}]]
3448 set dir [expr {$xp - $x}]
3449 if {$joinhigh} {
3450 set ith [lindex $lines $i 2]
3451 set coords [$canv coords $ith]
3452 set ah [$canv itemcget $ith -arrow]
3453 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3454 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3455 if {$x2 ne {} && $x - $x2 == $dir} {
3456 set coords [lrange $coords 0 end-2]
3458 } else {
3459 set coords [list [xc $le $x] [yc $le]]
3461 if {$joinlow} {
3462 set itl [lindex $lines [expr {$i-1}] 2]
3463 set al [$canv itemcget $itl -arrow]
3464 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3465 } elseif {$arrowlow} {
3466 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3467 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3468 set arrowlow 0
3471 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3472 for {set y $le} {[incr y -1] > $row} {} {
3473 set x $xp
3474 set xp [lindex $cols [expr {$y - 1 - $row}]]
3475 set ndir [expr {$xp - $x}]
3476 if {$dir != $ndir || $xp < 0} {
3477 lappend coords [xc $y $x] [yc $y]
3479 set dir $ndir
3481 if {!$joinlow} {
3482 if {$xp < 0} {
3483 # join parent line to first child
3484 set ch [lindex $displayorder $row]
3485 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3486 if {$xc < 0} {
3487 puts "oops: drawlineseg: child $ch not on row $row"
3488 } elseif {$xc != $x} {
3489 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3490 set d [expr {int(0.5 * $linespc)}]
3491 set x1 [xc $row $x]
3492 if {$xc < $x} {
3493 set x2 [expr {$x1 - $d}]
3494 } else {
3495 set x2 [expr {$x1 + $d}]
3497 set y2 [yc $row]
3498 set y1 [expr {$y2 + $d}]
3499 lappend coords $x1 $y1 $x2 $y2
3500 } elseif {$xc < $x - 1} {
3501 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3502 } elseif {$xc > $x + 1} {
3503 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3505 set x $xc
3507 lappend coords [xc $row $x] [yc $row]
3508 } else {
3509 set xn [xc $row $xp]
3510 set yn [yc $row]
3511 lappend coords $xn $yn
3513 if {!$joinhigh} {
3514 assigncolor $id
3515 set t [$canv create line $coords -width [linewidth $id] \
3516 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3517 $canv lower $t
3518 bindline $t $id
3519 set lines [linsert $lines $i [list $row $le $t]]
3520 } else {
3521 $canv coords $ith $coords
3522 if {$arrow ne $ah} {
3523 $canv itemconf $ith -arrow $arrow
3525 lset lines $i 0 $row
3527 } else {
3528 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3529 set ndir [expr {$xo - $xp}]
3530 set clow [$canv coords $itl]
3531 if {$dir == $ndir} {
3532 set clow [lrange $clow 2 end]
3534 set coords [concat $coords $clow]
3535 if {!$joinhigh} {
3536 lset lines [expr {$i-1}] 1 $le
3537 } else {
3538 # coalesce two pieces
3539 $canv delete $ith
3540 set b [lindex $lines [expr {$i-1}] 0]
3541 set e [lindex $lines $i 1]
3542 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3544 $canv coords $itl $coords
3545 if {$arrow ne $al} {
3546 $canv itemconf $itl -arrow $arrow
3550 set linesegs($id) $lines
3551 return $le
3554 proc drawparentlinks {id row} {
3555 global rowidlist canv colormap curview parentlist
3556 global idpos linespc
3558 set rowids [lindex $rowidlist $row]
3559 set col [lsearch -exact $rowids $id]
3560 if {$col < 0} return
3561 set olds [lindex $parentlist $row]
3562 set row2 [expr {$row + 1}]
3563 set x [xc $row $col]
3564 set y [yc $row]
3565 set y2 [yc $row2]
3566 set d [expr {int(0.5 * $linespc)}]
3567 set ymid [expr {$y + $d}]
3568 set ids [lindex $rowidlist $row2]
3569 # rmx = right-most X coord used
3570 set rmx 0
3571 foreach p $olds {
3572 set i [lsearch -exact $ids $p]
3573 if {$i < 0} {
3574 puts "oops, parent $p of $id not in list"
3575 continue
3577 set x2 [xc $row2 $i]
3578 if {$x2 > $rmx} {
3579 set rmx $x2
3581 set j [lsearch -exact $rowids $p]
3582 if {$j < 0} {
3583 # drawlineseg will do this one for us
3584 continue
3586 assigncolor $p
3587 # should handle duplicated parents here...
3588 set coords [list $x $y]
3589 if {$i != $col} {
3590 # if attaching to a vertical segment, draw a smaller
3591 # slant for visual distinctness
3592 if {$i == $j} {
3593 if {$i < $col} {
3594 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3595 } else {
3596 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3598 } elseif {$i < $col && $i < $j} {
3599 # segment slants towards us already
3600 lappend coords [xc $row $j] $y
3601 } else {
3602 if {$i < $col - 1} {
3603 lappend coords [expr {$x2 + $linespc}] $y
3604 } elseif {$i > $col + 1} {
3605 lappend coords [expr {$x2 - $linespc}] $y
3607 lappend coords $x2 $y2
3609 } else {
3610 lappend coords $x2 $y2
3612 set t [$canv create line $coords -width [linewidth $p] \
3613 -fill $colormap($p) -tags lines.$p]
3614 $canv lower $t
3615 bindline $t $p
3617 if {$rmx > [lindex $idpos($id) 1]} {
3618 lset idpos($id) 1 $rmx
3619 redrawtags $id
3623 proc drawlines {id} {
3624 global canv
3626 $canv itemconf lines.$id -width [linewidth $id]
3629 proc drawcmittext {id row col} {
3630 global linespc canv canv2 canv3 canvy0 fgcolor curview
3631 global commitlisted commitinfo rowidlist parentlist
3632 global rowtextx idpos idtags idheads idotherrefs
3633 global linehtag linentag linedtag selectedline
3634 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3636 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3637 set listed [lindex $commitlisted $row]
3638 if {$id eq $nullid} {
3639 set ofill red
3640 } elseif {$id eq $nullid2} {
3641 set ofill green
3642 } else {
3643 set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
3645 set x [xc $row $col]
3646 set y [yc $row]
3647 set orad [expr {$linespc / 3}]
3648 if {$listed <= 2} {
3649 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3650 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3651 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3652 } elseif {$listed == 3} {
3653 # triangle pointing left for left-side commits
3654 set t [$canv create polygon \
3655 [expr {$x - $orad}] $y \
3656 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3657 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3658 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3659 } else {
3660 # triangle pointing right for right-side commits
3661 set t [$canv create polygon \
3662 [expr {$x + $orad - 1}] $y \
3663 [expr {$x - $orad}] [expr {$y - $orad}] \
3664 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3665 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3667 $canv raise $t
3668 $canv bind $t <1> {selcanvline {} %x %y}
3669 set rmx [llength [lindex $rowidlist $row]]
3670 set olds [lindex $parentlist $row]
3671 if {$olds ne {}} {
3672 set nextids [lindex $rowidlist [expr {$row + 1}]]
3673 foreach p $olds {
3674 set i [lsearch -exact $nextids $p]
3675 if {$i > $rmx} {
3676 set rmx $i
3680 set xt [xc $row $rmx]
3681 set rowtextx($row) $xt
3682 set idpos($id) [list $x $xt $y]
3683 if {[info exists idtags($id)] || [info exists idheads($id)]
3684 || [info exists idotherrefs($id)]} {
3685 set xt [drawtags $id $x $xt $y]
3687 set headline [lindex $commitinfo($id) 0]
3688 set name [lindex $commitinfo($id) 1]
3689 set date [lindex $commitinfo($id) 2]
3690 set date [formatdate $date]
3691 set font mainfont
3692 set nfont mainfont
3693 set isbold [ishighlighted $row]
3694 if {$isbold > 0} {
3695 lappend boldrows $row
3696 set font mainfontbold
3697 if {$isbold > 1} {
3698 lappend boldnamerows $row
3699 set nfont mainfontbold
3702 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3703 -text $headline -font $font -tags text]
3704 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3705 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3706 -text $name -font $nfont -tags text]
3707 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3708 -text $date -font mainfont -tags text]
3709 if {[info exists selectedline] && $selectedline == $row} {
3710 make_secsel $row
3712 set xr [expr {$xt + [font measure $font $headline]}]
3713 if {$xr > $canvxmax} {
3714 set canvxmax $xr
3715 setcanvscroll
3719 proc drawcmitrow {row} {
3720 global displayorder rowidlist nrows_drawn
3721 global iddrawn markingmatches
3722 global commitinfo parentlist numcommits
3723 global filehighlight fhighlights findpattern nhighlights
3724 global hlview vhighlights
3725 global highlight_related rhighlights
3727 if {$row >= $numcommits} return
3729 set id [lindex $displayorder $row]
3730 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3731 askvhighlight $row $id
3733 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3734 askfilehighlight $row $id
3736 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3737 askfindhighlight $row $id
3739 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3740 askrelhighlight $row $id
3742 if {![info exists iddrawn($id)]} {
3743 set col [lsearch -exact [lindex $rowidlist $row] $id]
3744 if {$col < 0} {
3745 puts "oops, row $row id $id not in list"
3746 return
3748 if {![info exists commitinfo($id)]} {
3749 getcommit $id
3751 assigncolor $id
3752 drawcmittext $id $row $col
3753 set iddrawn($id) 1
3754 incr nrows_drawn
3756 if {$markingmatches} {
3757 markrowmatches $row $id
3761 proc drawcommits {row {endrow {}}} {
3762 global numcommits iddrawn displayorder curview need_redisplay
3763 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3765 if {$row < 0} {
3766 set row 0
3768 if {$endrow eq {}} {
3769 set endrow $row
3771 if {$endrow >= $numcommits} {
3772 set endrow [expr {$numcommits - 1}]
3775 set rl1 [expr {$row - $downarrowlen - 3}]
3776 if {$rl1 < 0} {
3777 set rl1 0
3779 set ro1 [expr {$row - 3}]
3780 if {$ro1 < 0} {
3781 set ro1 0
3783 set r2 [expr {$endrow + $uparrowlen + 3}]
3784 if {$r2 > $numcommits} {
3785 set r2 $numcommits
3787 for {set r $rl1} {$r < $r2} {incr r} {
3788 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3789 if {$rl1 < $r} {
3790 layoutrows $rl1 $r
3792 set rl1 [expr {$r + 1}]
3795 if {$rl1 < $r} {
3796 layoutrows $rl1 $r
3798 optimize_rows $ro1 0 $r2
3799 if {$need_redisplay || $nrows_drawn > 2000} {
3800 clear_display
3801 drawvisible
3804 # make the lines join to already-drawn rows either side
3805 set r [expr {$row - 1}]
3806 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3807 set r $row
3809 set er [expr {$endrow + 1}]
3810 if {$er >= $numcommits ||
3811 ![info exists iddrawn([lindex $displayorder $er])]} {
3812 set er $endrow
3814 for {} {$r <= $er} {incr r} {
3815 set id [lindex $displayorder $r]
3816 set wasdrawn [info exists iddrawn($id)]
3817 drawcmitrow $r
3818 if {$r == $er} break
3819 set nextid [lindex $displayorder [expr {$r + 1}]]
3820 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3821 drawparentlinks $id $r
3823 set rowids [lindex $rowidlist $r]
3824 foreach lid $rowids {
3825 if {$lid eq {}} continue
3826 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3827 if {$lid eq $id} {
3828 # see if this is the first child of any of its parents
3829 foreach p [lindex $parentlist $r] {
3830 if {[lsearch -exact $rowids $p] < 0} {
3831 # make this line extend up to the child
3832 set lineend($p) [drawlineseg $p $r $er 0]
3835 } else {
3836 set lineend($lid) [drawlineseg $lid $r $er 1]
3842 proc drawfrac {f0 f1} {
3843 global canv linespc
3845 set ymax [lindex [$canv cget -scrollregion] 3]
3846 if {$ymax eq {} || $ymax == 0} return
3847 set y0 [expr {int($f0 * $ymax)}]
3848 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3849 set y1 [expr {int($f1 * $ymax)}]
3850 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3851 drawcommits $row $endrow
3854 proc drawvisible {} {
3855 global canv
3856 eval drawfrac [$canv yview]
3859 proc clear_display {} {
3860 global iddrawn linesegs need_redisplay nrows_drawn
3861 global vhighlights fhighlights nhighlights rhighlights
3863 allcanvs delete all
3864 catch {unset iddrawn}
3865 catch {unset linesegs}
3866 catch {unset vhighlights}
3867 catch {unset fhighlights}
3868 catch {unset nhighlights}
3869 catch {unset rhighlights}
3870 set need_redisplay 0
3871 set nrows_drawn 0
3874 proc findcrossings {id} {
3875 global rowidlist parentlist numcommits displayorder
3877 set cross {}
3878 set ccross {}
3879 foreach {s e} [rowranges $id] {
3880 if {$e >= $numcommits} {
3881 set e [expr {$numcommits - 1}]
3883 if {$e <= $s} continue
3884 for {set row $e} {[incr row -1] >= $s} {} {
3885 set x [lsearch -exact [lindex $rowidlist $row] $id]
3886 if {$x < 0} break
3887 set olds [lindex $parentlist $row]
3888 set kid [lindex $displayorder $row]
3889 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3890 if {$kidx < 0} continue
3891 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3892 foreach p $olds {
3893 set px [lsearch -exact $nextrow $p]
3894 if {$px < 0} continue
3895 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3896 if {[lsearch -exact $ccross $p] >= 0} continue
3897 if {$x == $px + ($kidx < $px? -1: 1)} {
3898 lappend ccross $p
3899 } elseif {[lsearch -exact $cross $p] < 0} {
3900 lappend cross $p
3906 return [concat $ccross {{}} $cross]
3909 proc assigncolor {id} {
3910 global colormap colors nextcolor
3911 global commitrow parentlist children children curview
3913 if {[info exists colormap($id)]} return
3914 set ncolors [llength $colors]
3915 if {[info exists children($curview,$id)]} {
3916 set kids $children($curview,$id)
3917 } else {
3918 set kids {}
3920 if {[llength $kids] == 1} {
3921 set child [lindex $kids 0]
3922 if {[info exists colormap($child)]
3923 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3924 set colormap($id) $colormap($child)
3925 return
3928 set badcolors {}
3929 set origbad {}
3930 foreach x [findcrossings $id] {
3931 if {$x eq {}} {
3932 # delimiter between corner crossings and other crossings
3933 if {[llength $badcolors] >= $ncolors - 1} break
3934 set origbad $badcolors
3936 if {[info exists colormap($x)]
3937 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3938 lappend badcolors $colormap($x)
3941 if {[llength $badcolors] >= $ncolors} {
3942 set badcolors $origbad
3944 set origbad $badcolors
3945 if {[llength $badcolors] < $ncolors - 1} {
3946 foreach child $kids {
3947 if {[info exists colormap($child)]
3948 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3949 lappend badcolors $colormap($child)
3951 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3952 if {[info exists colormap($p)]
3953 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3954 lappend badcolors $colormap($p)
3958 if {[llength $badcolors] >= $ncolors} {
3959 set badcolors $origbad
3962 for {set i 0} {$i <= $ncolors} {incr i} {
3963 set c [lindex $colors $nextcolor]
3964 if {[incr nextcolor] >= $ncolors} {
3965 set nextcolor 0
3967 if {[lsearch -exact $badcolors $c]} break
3969 set colormap($id) $c
3972 proc bindline {t id} {
3973 global canv
3975 $canv bind $t <Enter> "lineenter %x %y $id"
3976 $canv bind $t <Motion> "linemotion %x %y $id"
3977 $canv bind $t <Leave> "lineleave $id"
3978 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3981 proc drawtags {id x xt y1} {
3982 global idtags idheads idotherrefs mainhead
3983 global linespc lthickness
3984 global canv commitrow rowtextx curview fgcolor bgcolor
3986 set marks {}
3987 set ntags 0
3988 set nheads 0
3989 if {[info exists idtags($id)]} {
3990 set marks $idtags($id)
3991 set ntags [llength $marks]
3993 if {[info exists idheads($id)]} {
3994 set marks [concat $marks $idheads($id)]
3995 set nheads [llength $idheads($id)]
3997 if {[info exists idotherrefs($id)]} {
3998 set marks [concat $marks $idotherrefs($id)]
4000 if {$marks eq {}} {
4001 return $xt
4004 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4005 set yt [expr {$y1 - 0.5 * $linespc}]
4006 set yb [expr {$yt + $linespc - 1}]
4007 set xvals {}
4008 set wvals {}
4009 set i -1
4010 foreach tag $marks {
4011 incr i
4012 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4013 set wid [font measure mainfontbold $tag]
4014 } else {
4015 set wid [font measure mainfont $tag]
4017 lappend xvals $xt
4018 lappend wvals $wid
4019 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4021 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4022 -width $lthickness -fill black -tags tag.$id]
4023 $canv lower $t
4024 foreach tag $marks x $xvals wid $wvals {
4025 set xl [expr {$x + $delta}]
4026 set xr [expr {$x + $delta + $wid + $lthickness}]
4027 set font mainfont
4028 if {[incr ntags -1] >= 0} {
4029 # draw a tag
4030 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4031 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4032 -width 1 -outline black -fill yellow -tags tag.$id]
4033 $canv bind $t <1> [list showtag $tag 1]
4034 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4035 } else {
4036 # draw a head or other ref
4037 if {[incr nheads -1] >= 0} {
4038 set col green
4039 if {$tag eq $mainhead} {
4040 set font mainfontbold
4042 } else {
4043 set col "#ddddff"
4045 set xl [expr {$xl - $delta/2}]
4046 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4047 -width 1 -outline black -fill $col -tags tag.$id
4048 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4049 set rwid [font measure mainfont $remoteprefix]
4050 set xi [expr {$x + 1}]
4051 set yti [expr {$yt + 1}]
4052 set xri [expr {$x + $rwid}]
4053 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4054 -width 0 -fill "#ffddaa" -tags tag.$id
4057 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4058 -font $font -tags [list tag.$id text]]
4059 if {$ntags >= 0} {
4060 $canv bind $t <1> [list showtag $tag 1]
4061 } elseif {$nheads >= 0} {
4062 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4065 return $xt
4068 proc xcoord {i level ln} {
4069 global canvx0 xspc1 xspc2
4071 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4072 if {$i > 0 && $i == $level} {
4073 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4074 } elseif {$i > $level} {
4075 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4077 return $x
4080 proc show_status {msg} {
4081 global canv fgcolor
4083 clear_display
4084 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4085 -tags text -fill $fgcolor
4088 # Insert a new commit as the child of the commit on row $row.
4089 # The new commit will be displayed on row $row and the commits
4090 # on that row and below will move down one row.
4091 proc insertrow {row newcmit} {
4092 global displayorder parentlist commitlisted children
4093 global commitrow curview rowidlist rowisopt rowfinal numcommits
4094 global numcommits
4095 global selectedline commitidx ordertok
4097 if {$row >= $numcommits} {
4098 puts "oops, inserting new row $row but only have $numcommits rows"
4099 return
4101 set p [lindex $displayorder $row]
4102 set displayorder [linsert $displayorder $row $newcmit]
4103 set parentlist [linsert $parentlist $row $p]
4104 set kids $children($curview,$p)
4105 lappend kids $newcmit
4106 set children($curview,$p) $kids
4107 set children($curview,$newcmit) {}
4108 set commitlisted [linsert $commitlisted $row 1]
4109 set l [llength $displayorder]
4110 for {set r $row} {$r < $l} {incr r} {
4111 set id [lindex $displayorder $r]
4112 set commitrow($curview,$id) $r
4114 incr commitidx($curview)
4115 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4117 if {$row < [llength $rowidlist]} {
4118 set idlist [lindex $rowidlist $row]
4119 if {$idlist ne {}} {
4120 if {[llength $kids] == 1} {
4121 set col [lsearch -exact $idlist $p]
4122 lset idlist $col $newcmit
4123 } else {
4124 set col [llength $idlist]
4125 lappend idlist $newcmit
4128 set rowidlist [linsert $rowidlist $row $idlist]
4129 set rowisopt [linsert $rowisopt $row 0]
4130 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4133 incr numcommits
4135 if {[info exists selectedline] && $selectedline >= $row} {
4136 incr selectedline
4138 redisplay
4141 # Remove a commit that was inserted with insertrow on row $row.
4142 proc removerow {row} {
4143 global displayorder parentlist commitlisted children
4144 global commitrow curview rowidlist rowisopt rowfinal numcommits
4145 global numcommits
4146 global linesegends selectedline commitidx
4148 if {$row >= $numcommits} {
4149 puts "oops, removing row $row but only have $numcommits rows"
4150 return
4152 set rp1 [expr {$row + 1}]
4153 set id [lindex $displayorder $row]
4154 set p [lindex $parentlist $row]
4155 set displayorder [lreplace $displayorder $row $row]
4156 set parentlist [lreplace $parentlist $row $row]
4157 set commitlisted [lreplace $commitlisted $row $row]
4158 set kids $children($curview,$p)
4159 set i [lsearch -exact $kids $id]
4160 if {$i >= 0} {
4161 set kids [lreplace $kids $i $i]
4162 set children($curview,$p) $kids
4164 set l [llength $displayorder]
4165 for {set r $row} {$r < $l} {incr r} {
4166 set id [lindex $displayorder $r]
4167 set commitrow($curview,$id) $r
4169 incr commitidx($curview) -1
4171 if {$row < [llength $rowidlist]} {
4172 set rowidlist [lreplace $rowidlist $row $row]
4173 set rowisopt [lreplace $rowisopt $row $row]
4174 set rowfinal [lreplace $rowfinal $row $row]
4177 incr numcommits -1
4179 if {[info exists selectedline] && $selectedline > $row} {
4180 incr selectedline -1
4182 redisplay
4185 # Don't change the text pane cursor if it is currently the hand cursor,
4186 # showing that we are over a sha1 ID link.
4187 proc settextcursor {c} {
4188 global ctext curtextcursor
4190 if {[$ctext cget -cursor] == $curtextcursor} {
4191 $ctext config -cursor $c
4193 set curtextcursor $c
4196 proc nowbusy {what {name {}}} {
4197 global isbusy busyname statusw
4199 if {[array names isbusy] eq {}} {
4200 . config -cursor watch
4201 settextcursor watch
4203 set isbusy($what) 1
4204 set busyname($what) $name
4205 if {$name ne {}} {
4206 $statusw conf -text $name
4210 proc notbusy {what} {
4211 global isbusy maincursor textcursor busyname statusw
4213 catch {
4214 unset isbusy($what)
4215 if {$busyname($what) ne {} &&
4216 [$statusw cget -text] eq $busyname($what)} {
4217 $statusw conf -text {}
4220 if {[array names isbusy] eq {}} {
4221 . config -cursor $maincursor
4222 settextcursor $textcursor
4226 proc findmatches {f} {
4227 global findtype findstring
4228 if {$findtype == [mc "Regexp"]} {
4229 set matches [regexp -indices -all -inline $findstring $f]
4230 } else {
4231 set fs $findstring
4232 if {$findtype == [mc "IgnCase"]} {
4233 set f [string tolower $f]
4234 set fs [string tolower $fs]
4236 set matches {}
4237 set i 0
4238 set l [string length $fs]
4239 while {[set j [string first $fs $f $i]] >= 0} {
4240 lappend matches [list $j [expr {$j+$l-1}]]
4241 set i [expr {$j + $l}]
4244 return $matches
4247 proc dofind {{dirn 1} {wrap 1}} {
4248 global findstring findstartline findcurline selectedline numcommits
4249 global gdttype filehighlight fh_serial find_dirn findallowwrap
4251 if {[info exists find_dirn]} {
4252 if {$find_dirn == $dirn} return
4253 stopfinding
4255 focus .
4256 if {$findstring eq {} || $numcommits == 0} return
4257 if {![info exists selectedline]} {
4258 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4259 } else {
4260 set findstartline $selectedline
4262 set findcurline $findstartline
4263 nowbusy finding [mc "Searching"]
4264 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4265 after cancel do_file_hl $fh_serial
4266 do_file_hl $fh_serial
4268 set find_dirn $dirn
4269 set findallowwrap $wrap
4270 run findmore
4273 proc stopfinding {} {
4274 global find_dirn findcurline fprogcoord
4276 if {[info exists find_dirn]} {
4277 unset find_dirn
4278 unset findcurline
4279 notbusy finding
4280 set fprogcoord 0
4281 adjustprogress
4285 proc findmore {} {
4286 global commitdata commitinfo numcommits findpattern findloc
4287 global findstartline findcurline displayorder
4288 global find_dirn gdttype fhighlights fprogcoord
4289 global findallowwrap
4291 if {![info exists find_dirn]} {
4292 return 0
4294 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4295 set l $findcurline
4296 set moretodo 0
4297 if {$find_dirn > 0} {
4298 incr l
4299 if {$l >= $numcommits} {
4300 set l 0
4302 if {$l <= $findstartline} {
4303 set lim [expr {$findstartline + 1}]
4304 } else {
4305 set lim $numcommits
4306 set moretodo $findallowwrap
4308 } else {
4309 if {$l == 0} {
4310 set l $numcommits
4312 incr l -1
4313 if {$l >= $findstartline} {
4314 set lim [expr {$findstartline - 1}]
4315 } else {
4316 set lim -1
4317 set moretodo $findallowwrap
4320 set n [expr {($lim - $l) * $find_dirn}]
4321 if {$n > 500} {
4322 set n 500
4323 set moretodo 1
4325 set found 0
4326 set domore 1
4327 if {$gdttype eq [mc "containing:"]} {
4328 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4329 set id [lindex $displayorder $l]
4330 # shouldn't happen unless git log doesn't give all the commits...
4331 if {![info exists commitdata($id)]} continue
4332 if {![doesmatch $commitdata($id)]} continue
4333 if {![info exists commitinfo($id)]} {
4334 getcommit $id
4336 set info $commitinfo($id)
4337 foreach f $info ty $fldtypes {
4338 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4339 [doesmatch $f]} {
4340 set found 1
4341 break
4344 if {$found} break
4346 } else {
4347 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4348 set id [lindex $displayorder $l]
4349 if {![info exists fhighlights($l)]} {
4350 askfilehighlight $l $id
4351 if {$domore} {
4352 set domore 0
4353 set findcurline [expr {$l - $find_dirn}]
4355 } elseif {$fhighlights($l)} {
4356 set found $domore
4357 break
4361 if {$found || ($domore && !$moretodo)} {
4362 unset findcurline
4363 unset find_dirn
4364 notbusy finding
4365 set fprogcoord 0
4366 adjustprogress
4367 if {$found} {
4368 findselectline $l
4369 } else {
4370 bell
4372 return 0
4374 if {!$domore} {
4375 flushhighlights
4376 } else {
4377 set findcurline [expr {$l - $find_dirn}]
4379 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4380 if {$n < 0} {
4381 incr n $numcommits
4383 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4384 adjustprogress
4385 return $domore
4388 proc findselectline {l} {
4389 global findloc commentend ctext findcurline markingmatches gdttype
4391 set markingmatches 1
4392 set findcurline $l
4393 selectline $l 1
4394 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4395 # highlight the matches in the comments
4396 set f [$ctext get 1.0 $commentend]
4397 set matches [findmatches $f]
4398 foreach match $matches {
4399 set start [lindex $match 0]
4400 set end [expr {[lindex $match 1] + 1}]
4401 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4404 drawvisible
4407 # mark the bits of a headline or author that match a find string
4408 proc markmatches {canv l str tag matches font row} {
4409 global selectedline
4411 set bbox [$canv bbox $tag]
4412 set x0 [lindex $bbox 0]
4413 set y0 [lindex $bbox 1]
4414 set y1 [lindex $bbox 3]
4415 foreach match $matches {
4416 set start [lindex $match 0]
4417 set end [lindex $match 1]
4418 if {$start > $end} continue
4419 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4420 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4421 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4422 [expr {$x0+$xlen+2}] $y1 \
4423 -outline {} -tags [list match$l matches] -fill yellow]
4424 $canv lower $t
4425 if {[info exists selectedline] && $row == $selectedline} {
4426 $canv raise $t secsel
4431 proc unmarkmatches {} {
4432 global markingmatches
4434 allcanvs delete matches
4435 set markingmatches 0
4436 stopfinding
4439 proc selcanvline {w x y} {
4440 global canv canvy0 ctext linespc
4441 global rowtextx
4442 set ymax [lindex [$canv cget -scrollregion] 3]
4443 if {$ymax == {}} return
4444 set yfrac [lindex [$canv yview] 0]
4445 set y [expr {$y + $yfrac * $ymax}]
4446 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4447 if {$l < 0} {
4448 set l 0
4450 if {$w eq $canv} {
4451 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4453 unmarkmatches
4454 selectline $l 1
4457 proc commit_descriptor {p} {
4458 global commitinfo
4459 if {![info exists commitinfo($p)]} {
4460 getcommit $p
4462 set l "..."
4463 if {[llength $commitinfo($p)] > 1} {
4464 set l [lindex $commitinfo($p) 0]
4466 return "$p ($l)\n"
4469 # append some text to the ctext widget, and make any SHA1 ID
4470 # that we know about be a clickable link.
4471 proc appendwithlinks {text tags} {
4472 global ctext commitrow linknum curview pendinglinks
4474 set start [$ctext index "end - 1c"]
4475 $ctext insert end $text $tags
4476 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4477 foreach l $links {
4478 set s [lindex $l 0]
4479 set e [lindex $l 1]
4480 set linkid [string range $text $s $e]
4481 incr e
4482 $ctext tag delete link$linknum
4483 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4484 setlink $linkid link$linknum
4485 incr linknum
4489 proc setlink {id lk} {
4490 global curview commitrow ctext pendinglinks commitinterest
4492 if {[info exists commitrow($curview,$id)]} {
4493 $ctext tag conf $lk -foreground blue -underline 1
4494 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4495 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4496 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4497 } else {
4498 lappend pendinglinks($id) $lk
4499 lappend commitinterest($id) {makelink %I}
4503 proc makelink {id} {
4504 global pendinglinks
4506 if {![info exists pendinglinks($id)]} return
4507 foreach lk $pendinglinks($id) {
4508 setlink $id $lk
4510 unset pendinglinks($id)
4513 proc linkcursor {w inc} {
4514 global linkentercount curtextcursor
4516 if {[incr linkentercount $inc] > 0} {
4517 $w configure -cursor hand2
4518 } else {
4519 $w configure -cursor $curtextcursor
4520 if {$linkentercount < 0} {
4521 set linkentercount 0
4526 proc viewnextline {dir} {
4527 global canv linespc
4529 $canv delete hover
4530 set ymax [lindex [$canv cget -scrollregion] 3]
4531 set wnow [$canv yview]
4532 set wtop [expr {[lindex $wnow 0] * $ymax}]
4533 set newtop [expr {$wtop + $dir * $linespc}]
4534 if {$newtop < 0} {
4535 set newtop 0
4536 } elseif {$newtop > $ymax} {
4537 set newtop $ymax
4539 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4542 # add a list of tag or branch names at position pos
4543 # returns the number of names inserted
4544 proc appendrefs {pos ids var} {
4545 global ctext commitrow linknum curview $var maxrefs
4547 if {[catch {$ctext index $pos}]} {
4548 return 0
4550 $ctext conf -state normal
4551 $ctext delete $pos "$pos lineend"
4552 set tags {}
4553 foreach id $ids {
4554 foreach tag [set $var\($id\)] {
4555 lappend tags [list $tag $id]
4558 if {[llength $tags] > $maxrefs} {
4559 $ctext insert $pos "many ([llength $tags])"
4560 } else {
4561 set tags [lsort -index 0 -decreasing $tags]
4562 set sep {}
4563 foreach ti $tags {
4564 set id [lindex $ti 1]
4565 set lk link$linknum
4566 incr linknum
4567 $ctext tag delete $lk
4568 $ctext insert $pos $sep
4569 $ctext insert $pos [lindex $ti 0] $lk
4570 setlink $id $lk
4571 set sep ", "
4574 $ctext conf -state disabled
4575 return [llength $tags]
4578 # called when we have finished computing the nearby tags
4579 proc dispneartags {delay} {
4580 global selectedline currentid showneartags tagphase
4582 if {![info exists selectedline] || !$showneartags} return
4583 after cancel dispnexttag
4584 if {$delay} {
4585 after 200 dispnexttag
4586 set tagphase -1
4587 } else {
4588 after idle dispnexttag
4589 set tagphase 0
4593 proc dispnexttag {} {
4594 global selectedline currentid showneartags tagphase ctext
4596 if {![info exists selectedline] || !$showneartags} return
4597 switch -- $tagphase {
4599 set dtags [desctags $currentid]
4600 if {$dtags ne {}} {
4601 appendrefs precedes $dtags idtags
4605 set atags [anctags $currentid]
4606 if {$atags ne {}} {
4607 appendrefs follows $atags idtags
4611 set dheads [descheads $currentid]
4612 if {$dheads ne {}} {
4613 if {[appendrefs branch $dheads idheads] > 1
4614 && [$ctext get "branch -3c"] eq "h"} {
4615 # turn "Branch" into "Branches"
4616 $ctext conf -state normal
4617 $ctext insert "branch -2c" "es"
4618 $ctext conf -state disabled
4623 if {[incr tagphase] <= 2} {
4624 after idle dispnexttag
4628 proc make_secsel {l} {
4629 global linehtag linentag linedtag canv canv2 canv3
4631 if {![info exists linehtag($l)]} return
4632 $canv delete secsel
4633 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4634 -tags secsel -fill [$canv cget -selectbackground]]
4635 $canv lower $t
4636 $canv2 delete secsel
4637 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4638 -tags secsel -fill [$canv2 cget -selectbackground]]
4639 $canv2 lower $t
4640 $canv3 delete secsel
4641 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4642 -tags secsel -fill [$canv3 cget -selectbackground]]
4643 $canv3 lower $t
4646 proc selectline {l isnew} {
4647 global canv ctext commitinfo selectedline
4648 global displayorder
4649 global canvy0 linespc parentlist children curview
4650 global currentid sha1entry
4651 global commentend idtags linknum
4652 global mergemax numcommits pending_select
4653 global cmitmode showneartags allcommits
4655 catch {unset pending_select}
4656 $canv delete hover
4657 normalline
4658 unsel_reflist
4659 stopfinding
4660 if {$l < 0 || $l >= $numcommits} return
4661 set y [expr {$canvy0 + $l * $linespc}]
4662 set ymax [lindex [$canv cget -scrollregion] 3]
4663 set ytop [expr {$y - $linespc - 1}]
4664 set ybot [expr {$y + $linespc + 1}]
4665 set wnow [$canv yview]
4666 set wtop [expr {[lindex $wnow 0] * $ymax}]
4667 set wbot [expr {[lindex $wnow 1] * $ymax}]
4668 set wh [expr {$wbot - $wtop}]
4669 set newtop $wtop
4670 if {$ytop < $wtop} {
4671 if {$ybot < $wtop} {
4672 set newtop [expr {$y - $wh / 2.0}]
4673 } else {
4674 set newtop $ytop
4675 if {$newtop > $wtop - $linespc} {
4676 set newtop [expr {$wtop - $linespc}]
4679 } elseif {$ybot > $wbot} {
4680 if {$ytop > $wbot} {
4681 set newtop [expr {$y - $wh / 2.0}]
4682 } else {
4683 set newtop [expr {$ybot - $wh}]
4684 if {$newtop < $wtop + $linespc} {
4685 set newtop [expr {$wtop + $linespc}]
4689 if {$newtop != $wtop} {
4690 if {$newtop < 0} {
4691 set newtop 0
4693 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4694 drawvisible
4697 make_secsel $l
4699 if {$isnew} {
4700 addtohistory [list selectline $l 0]
4703 set selectedline $l
4705 set id [lindex $displayorder $l]
4706 set currentid $id
4707 $sha1entry delete 0 end
4708 $sha1entry insert 0 $id
4709 $sha1entry selection from 0
4710 $sha1entry selection to end
4711 rhighlight_sel $id
4713 $ctext conf -state normal
4714 clear_ctext
4715 set linknum 0
4716 set info $commitinfo($id)
4717 set date [formatdate [lindex $info 2]]
4718 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
4719 set date [formatdate [lindex $info 4]]
4720 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
4721 if {[info exists idtags($id)]} {
4722 $ctext insert end [mc "Tags:"]
4723 foreach tag $idtags($id) {
4724 $ctext insert end " $tag"
4726 $ctext insert end "\n"
4729 set headers {}
4730 set olds [lindex $parentlist $l]
4731 if {[llength $olds] > 1} {
4732 set np 0
4733 foreach p $olds {
4734 if {$np >= $mergemax} {
4735 set tag mmax
4736 } else {
4737 set tag m$np
4739 $ctext insert end "[mc "Parent"]: " $tag
4740 appendwithlinks [commit_descriptor $p] {}
4741 incr np
4743 } else {
4744 foreach p $olds {
4745 append headers "[mc "Parent"]: [commit_descriptor $p]"
4749 foreach c $children($curview,$id) {
4750 append headers "[mc "Child"]: [commit_descriptor $c]"
4753 # make anything that looks like a SHA1 ID be a clickable link
4754 appendwithlinks $headers {}
4755 if {$showneartags} {
4756 if {![info exists allcommits]} {
4757 getallcommits
4759 $ctext insert end "[mc "Branch"]: "
4760 $ctext mark set branch "end -1c"
4761 $ctext mark gravity branch left
4762 $ctext insert end "\n[mc "Follows"]: "
4763 $ctext mark set follows "end -1c"
4764 $ctext mark gravity follows left
4765 $ctext insert end "\n[mc "Precedes"]: "
4766 $ctext mark set precedes "end -1c"
4767 $ctext mark gravity precedes left
4768 $ctext insert end "\n"
4769 dispneartags 1
4771 $ctext insert end "\n"
4772 set comment [lindex $info 5]
4773 if {[string first "\r" $comment] >= 0} {
4774 set comment [string map {"\r" "\n "} $comment]
4776 appendwithlinks $comment {comment}
4778 $ctext tag remove found 1.0 end
4779 $ctext conf -state disabled
4780 set commentend [$ctext index "end - 1c"]
4782 init_flist [mc "Comments"]
4783 if {$cmitmode eq "tree"} {
4784 gettree $id
4785 } elseif {[llength $olds] <= 1} {
4786 startdiff $id
4787 } else {
4788 mergediff $id $l
4792 proc selfirstline {} {
4793 unmarkmatches
4794 selectline 0 1
4797 proc sellastline {} {
4798 global numcommits
4799 unmarkmatches
4800 set l [expr {$numcommits - 1}]
4801 selectline $l 1
4804 proc selnextline {dir} {
4805 global selectedline
4806 focus .
4807 if {![info exists selectedline]} return
4808 set l [expr {$selectedline + $dir}]
4809 unmarkmatches
4810 selectline $l 1
4813 proc selnextpage {dir} {
4814 global canv linespc selectedline numcommits
4816 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4817 if {$lpp < 1} {
4818 set lpp 1
4820 allcanvs yview scroll [expr {$dir * $lpp}] units
4821 drawvisible
4822 if {![info exists selectedline]} return
4823 set l [expr {$selectedline + $dir * $lpp}]
4824 if {$l < 0} {
4825 set l 0
4826 } elseif {$l >= $numcommits} {
4827 set l [expr $numcommits - 1]
4829 unmarkmatches
4830 selectline $l 1
4833 proc unselectline {} {
4834 global selectedline currentid
4836 catch {unset selectedline}
4837 catch {unset currentid}
4838 allcanvs delete secsel
4839 rhighlight_none
4842 proc reselectline {} {
4843 global selectedline
4845 if {[info exists selectedline]} {
4846 selectline $selectedline 0
4850 proc addtohistory {cmd} {
4851 global history historyindex curview
4853 set elt [list $curview $cmd]
4854 if {$historyindex > 0
4855 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4856 return
4859 if {$historyindex < [llength $history]} {
4860 set history [lreplace $history $historyindex end $elt]
4861 } else {
4862 lappend history $elt
4864 incr historyindex
4865 if {$historyindex > 1} {
4866 .tf.bar.leftbut conf -state normal
4867 } else {
4868 .tf.bar.leftbut conf -state disabled
4870 .tf.bar.rightbut conf -state disabled
4873 proc godo {elt} {
4874 global curview
4876 set view [lindex $elt 0]
4877 set cmd [lindex $elt 1]
4878 if {$curview != $view} {
4879 showview $view
4881 eval $cmd
4884 proc goback {} {
4885 global history historyindex
4886 focus .
4888 if {$historyindex > 1} {
4889 incr historyindex -1
4890 godo [lindex $history [expr {$historyindex - 1}]]
4891 .tf.bar.rightbut conf -state normal
4893 if {$historyindex <= 1} {
4894 .tf.bar.leftbut conf -state disabled
4898 proc goforw {} {
4899 global history historyindex
4900 focus .
4902 if {$historyindex < [llength $history]} {
4903 set cmd [lindex $history $historyindex]
4904 incr historyindex
4905 godo $cmd
4906 .tf.bar.leftbut conf -state normal
4908 if {$historyindex >= [llength $history]} {
4909 .tf.bar.rightbut conf -state disabled
4913 proc gettree {id} {
4914 global treefilelist treeidlist diffids diffmergeid treepending
4915 global nullid nullid2
4917 set diffids $id
4918 catch {unset diffmergeid}
4919 if {![info exists treefilelist($id)]} {
4920 if {![info exists treepending]} {
4921 if {$id eq $nullid} {
4922 set cmd [list | git ls-files]
4923 } elseif {$id eq $nullid2} {
4924 set cmd [list | git ls-files --stage -t]
4925 } else {
4926 set cmd [list | git ls-tree -r $id]
4928 if {[catch {set gtf [open $cmd r]}]} {
4929 return
4931 set treepending $id
4932 set treefilelist($id) {}
4933 set treeidlist($id) {}
4934 fconfigure $gtf -blocking 0
4935 filerun $gtf [list gettreeline $gtf $id]
4937 } else {
4938 setfilelist $id
4942 proc gettreeline {gtf id} {
4943 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4945 set nl 0
4946 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4947 if {$diffids eq $nullid} {
4948 set fname $line
4949 } else {
4950 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4951 set i [string first "\t" $line]
4952 if {$i < 0} continue
4953 set sha1 [lindex $line 2]
4954 set fname [string range $line [expr {$i+1}] end]
4955 if {[string index $fname 0] eq "\""} {
4956 set fname [lindex $fname 0]
4958 lappend treeidlist($id) $sha1
4960 lappend treefilelist($id) $fname
4962 if {![eof $gtf]} {
4963 return [expr {$nl >= 1000? 2: 1}]
4965 close $gtf
4966 unset treepending
4967 if {$cmitmode ne "tree"} {
4968 if {![info exists diffmergeid]} {
4969 gettreediffs $diffids
4971 } elseif {$id ne $diffids} {
4972 gettree $diffids
4973 } else {
4974 setfilelist $id
4976 return 0
4979 proc showfile {f} {
4980 global treefilelist treeidlist diffids nullid nullid2
4981 global ctext commentend
4983 set i [lsearch -exact $treefilelist($diffids) $f]
4984 if {$i < 0} {
4985 puts "oops, $f not in list for id $diffids"
4986 return
4988 if {$diffids eq $nullid} {
4989 if {[catch {set bf [open $f r]} err]} {
4990 puts "oops, can't read $f: $err"
4991 return
4993 } else {
4994 set blob [lindex $treeidlist($diffids) $i]
4995 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4996 puts "oops, error reading blob $blob: $err"
4997 return
5000 fconfigure $bf -blocking 0
5001 filerun $bf [list getblobline $bf $diffids]
5002 $ctext config -state normal
5003 clear_ctext $commentend
5004 $ctext insert end "\n"
5005 $ctext insert end "$f\n" filesep
5006 $ctext config -state disabled
5007 $ctext yview $commentend
5008 settabs 0
5011 proc getblobline {bf id} {
5012 global diffids cmitmode ctext
5014 if {$id ne $diffids || $cmitmode ne "tree"} {
5015 catch {close $bf}
5016 return 0
5018 $ctext config -state normal
5019 set nl 0
5020 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5021 $ctext insert end "$line\n"
5023 if {[eof $bf]} {
5024 # delete last newline
5025 $ctext delete "end - 2c" "end - 1c"
5026 close $bf
5027 return 0
5029 $ctext config -state disabled
5030 return [expr {$nl >= 1000? 2: 1}]
5033 proc mergediff {id l} {
5034 global diffmergeid mdifffd
5035 global diffids
5036 global diffcontext
5037 global parentlist
5038 global limitdiffs viewfiles curview
5040 set diffmergeid $id
5041 set diffids $id
5042 # this doesn't seem to actually affect anything...
5043 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5044 if {$limitdiffs && $viewfiles($curview) ne {}} {
5045 set cmd [concat $cmd -- $viewfiles($curview)]
5047 if {[catch {set mdf [open $cmd r]} err]} {
5048 error_popup "[mc "Error getting merge diffs:"] $err"
5049 return
5051 fconfigure $mdf -blocking 0
5052 set mdifffd($id) $mdf
5053 set np [llength [lindex $parentlist $l]]
5054 settabs $np
5055 filerun $mdf [list getmergediffline $mdf $id $np]
5058 proc getmergediffline {mdf id np} {
5059 global diffmergeid ctext cflist mergemax
5060 global difffilestart mdifffd
5062 $ctext conf -state normal
5063 set nr 0
5064 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5065 if {![info exists diffmergeid] || $id != $diffmergeid
5066 || $mdf != $mdifffd($id)} {
5067 close $mdf
5068 return 0
5070 if {[regexp {^diff --cc (.*)} $line match fname]} {
5071 # start of a new file
5072 $ctext insert end "\n"
5073 set here [$ctext index "end - 1c"]
5074 lappend difffilestart $here
5075 add_flist [list $fname]
5076 set l [expr {(78 - [string length $fname]) / 2}]
5077 set pad [string range "----------------------------------------" 1 $l]
5078 $ctext insert end "$pad $fname $pad\n" filesep
5079 } elseif {[regexp {^@@} $line]} {
5080 $ctext insert end "$line\n" hunksep
5081 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5082 # do nothing
5083 } else {
5084 # parse the prefix - one ' ', '-' or '+' for each parent
5085 set spaces {}
5086 set minuses {}
5087 set pluses {}
5088 set isbad 0
5089 for {set j 0} {$j < $np} {incr j} {
5090 set c [string range $line $j $j]
5091 if {$c == " "} {
5092 lappend spaces $j
5093 } elseif {$c == "-"} {
5094 lappend minuses $j
5095 } elseif {$c == "+"} {
5096 lappend pluses $j
5097 } else {
5098 set isbad 1
5099 break
5102 set tags {}
5103 set num {}
5104 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5105 # line doesn't appear in result, parents in $minuses have the line
5106 set num [lindex $minuses 0]
5107 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5108 # line appears in result, parents in $pluses don't have the line
5109 lappend tags mresult
5110 set num [lindex $spaces 0]
5112 if {$num ne {}} {
5113 if {$num >= $mergemax} {
5114 set num "max"
5116 lappend tags m$num
5118 $ctext insert end "$line\n" $tags
5121 $ctext conf -state disabled
5122 if {[eof $mdf]} {
5123 close $mdf
5124 return 0
5126 return [expr {$nr >= 1000? 2: 1}]
5129 proc startdiff {ids} {
5130 global treediffs diffids treepending diffmergeid nullid nullid2
5132 settabs 1
5133 set diffids $ids
5134 catch {unset diffmergeid}
5135 if {![info exists treediffs($ids)] ||
5136 [lsearch -exact $ids $nullid] >= 0 ||
5137 [lsearch -exact $ids $nullid2] >= 0} {
5138 if {![info exists treepending]} {
5139 gettreediffs $ids
5141 } else {
5142 addtocflist $ids
5146 proc path_filter {filter name} {
5147 foreach p $filter {
5148 set l [string length $p]
5149 if {[string index $p end] eq "/"} {
5150 if {[string compare -length $l $p $name] == 0} {
5151 return 1
5153 } else {
5154 if {[string compare -length $l $p $name] == 0 &&
5155 ([string length $name] == $l ||
5156 [string index $name $l] eq "/")} {
5157 return 1
5161 return 0
5164 proc addtocflist {ids} {
5165 global treediffs
5167 add_flist $treediffs($ids)
5168 getblobdiffs $ids
5171 proc diffcmd {ids flags} {
5172 global nullid nullid2
5174 set i [lsearch -exact $ids $nullid]
5175 set j [lsearch -exact $ids $nullid2]
5176 if {$i >= 0} {
5177 if {[llength $ids] > 1 && $j < 0} {
5178 # comparing working directory with some specific revision
5179 set cmd [concat | git diff-index $flags]
5180 if {$i == 0} {
5181 lappend cmd -R [lindex $ids 1]
5182 } else {
5183 lappend cmd [lindex $ids 0]
5185 } else {
5186 # comparing working directory with index
5187 set cmd [concat | git diff-files $flags]
5188 if {$j == 1} {
5189 lappend cmd -R
5192 } elseif {$j >= 0} {
5193 set cmd [concat | git diff-index --cached $flags]
5194 if {[llength $ids] > 1} {
5195 # comparing index with specific revision
5196 if {$i == 0} {
5197 lappend cmd -R [lindex $ids 1]
5198 } else {
5199 lappend cmd [lindex $ids 0]
5201 } else {
5202 # comparing index with HEAD
5203 lappend cmd HEAD
5205 } else {
5206 set cmd [concat | git diff-tree -r $flags $ids]
5208 return $cmd
5211 proc gettreediffs {ids} {
5212 global treediff treepending
5214 set treepending $ids
5215 set treediff {}
5216 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5217 fconfigure $gdtf -blocking 0
5218 filerun $gdtf [list gettreediffline $gdtf $ids]
5221 proc gettreediffline {gdtf ids} {
5222 global treediff treediffs treepending diffids diffmergeid
5223 global cmitmode viewfiles curview limitdiffs
5225 set nr 0
5226 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5227 set i [string first "\t" $line]
5228 if {$i >= 0} {
5229 set file [string range $line [expr {$i+1}] end]
5230 if {[string index $file 0] eq "\""} {
5231 set file [lindex $file 0]
5233 lappend treediff $file
5236 if {![eof $gdtf]} {
5237 return [expr {$nr >= 1000? 2: 1}]
5239 close $gdtf
5240 if {$limitdiffs && $viewfiles($curview) ne {}} {
5241 set flist {}
5242 foreach f $treediff {
5243 if {[path_filter $viewfiles($curview) $f]} {
5244 lappend flist $f
5247 set treediffs($ids) $flist
5248 } else {
5249 set treediffs($ids) $treediff
5251 unset treepending
5252 if {$cmitmode eq "tree"} {
5253 gettree $diffids
5254 } elseif {$ids != $diffids} {
5255 if {![info exists diffmergeid]} {
5256 gettreediffs $diffids
5258 } else {
5259 addtocflist $ids
5261 return 0
5264 # empty string or positive integer
5265 proc diffcontextvalidate {v} {
5266 return [regexp {^(|[1-9][0-9]*)$} $v]
5269 proc diffcontextchange {n1 n2 op} {
5270 global diffcontextstring diffcontext
5272 if {[string is integer -strict $diffcontextstring]} {
5273 if {$diffcontextstring > 0} {
5274 set diffcontext $diffcontextstring
5275 reselectline
5280 proc changeignorespace {} {
5281 reselectline
5284 proc getblobdiffs {ids} {
5285 global blobdifffd diffids env
5286 global diffinhdr treediffs
5287 global diffcontext
5288 global ignorespace
5289 global limitdiffs viewfiles curview
5291 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5292 if {$ignorespace} {
5293 append cmd " -w"
5295 if {$limitdiffs && $viewfiles($curview) ne {}} {
5296 set cmd [concat $cmd -- $viewfiles($curview)]
5298 if {[catch {set bdf [open $cmd r]} err]} {
5299 puts "error getting diffs: $err"
5300 return
5302 set diffinhdr 0
5303 fconfigure $bdf -blocking 0
5304 set blobdifffd($ids) $bdf
5305 filerun $bdf [list getblobdiffline $bdf $diffids]
5308 proc setinlist {var i val} {
5309 global $var
5311 while {[llength [set $var]] < $i} {
5312 lappend $var {}
5314 if {[llength [set $var]] == $i} {
5315 lappend $var $val
5316 } else {
5317 lset $var $i $val
5321 proc makediffhdr {fname ids} {
5322 global ctext curdiffstart treediffs
5324 set i [lsearch -exact $treediffs($ids) $fname]
5325 if {$i >= 0} {
5326 setinlist difffilestart $i $curdiffstart
5328 set l [expr {(78 - [string length $fname]) / 2}]
5329 set pad [string range "----------------------------------------" 1 $l]
5330 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5333 proc getblobdiffline {bdf ids} {
5334 global diffids blobdifffd ctext curdiffstart
5335 global diffnexthead diffnextnote difffilestart
5336 global diffinhdr treediffs
5338 set nr 0
5339 $ctext conf -state normal
5340 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5341 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5342 close $bdf
5343 return 0
5345 if {![string compare -length 11 "diff --git " $line]} {
5346 # trim off "diff --git "
5347 set line [string range $line 11 end]
5348 set diffinhdr 1
5349 # start of a new file
5350 $ctext insert end "\n"
5351 set curdiffstart [$ctext index "end - 1c"]
5352 $ctext insert end "\n" filesep
5353 # If the name hasn't changed the length will be odd,
5354 # the middle char will be a space, and the two bits either
5355 # side will be a/name and b/name, or "a/name" and "b/name".
5356 # If the name has changed we'll get "rename from" and
5357 # "rename to" or "copy from" and "copy to" lines following this,
5358 # and we'll use them to get the filenames.
5359 # This complexity is necessary because spaces in the filename(s)
5360 # don't get escaped.
5361 set l [string length $line]
5362 set i [expr {$l / 2}]
5363 if {!(($l & 1) && [string index $line $i] eq " " &&
5364 [string range $line 2 [expr {$i - 1}]] eq \
5365 [string range $line [expr {$i + 3}] end])} {
5366 continue
5368 # unescape if quoted and chop off the a/ from the front
5369 if {[string index $line 0] eq "\""} {
5370 set fname [string range [lindex $line 0] 2 end]
5371 } else {
5372 set fname [string range $line 2 [expr {$i - 1}]]
5374 makediffhdr $fname $ids
5376 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5377 $line match f1l f1c f2l f2c rest]} {
5378 $ctext insert end "$line\n" hunksep
5379 set diffinhdr 0
5381 } elseif {$diffinhdr} {
5382 if {![string compare -length 12 "rename from " $line]} {
5383 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5384 if {[string index $fname 0] eq "\""} {
5385 set fname [lindex $fname 0]
5387 set i [lsearch -exact $treediffs($ids) $fname]
5388 if {$i >= 0} {
5389 setinlist difffilestart $i $curdiffstart
5391 } elseif {![string compare -length 10 $line "rename to "] ||
5392 ![string compare -length 8 $line "copy to "]} {
5393 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5394 if {[string index $fname 0] eq "\""} {
5395 set fname [lindex $fname 0]
5397 makediffhdr $fname $ids
5398 } elseif {[string compare -length 3 $line "---"] == 0} {
5399 # do nothing
5400 continue
5401 } elseif {[string compare -length 3 $line "+++"] == 0} {
5402 set diffinhdr 0
5403 continue
5405 $ctext insert end "$line\n" filesep
5407 } else {
5408 set x [string range $line 0 0]
5409 if {$x == "-" || $x == "+"} {
5410 set tag [expr {$x == "+"}]
5411 $ctext insert end "$line\n" d$tag
5412 } elseif {$x == " "} {
5413 $ctext insert end "$line\n"
5414 } else {
5415 # "\ No newline at end of file",
5416 # or something else we don't recognize
5417 $ctext insert end "$line\n" hunksep
5421 $ctext conf -state disabled
5422 if {[eof $bdf]} {
5423 close $bdf
5424 return 0
5426 return [expr {$nr >= 1000? 2: 1}]
5429 proc changediffdisp {} {
5430 global ctext diffelide
5432 $ctext tag conf d0 -elide [lindex $diffelide 0]
5433 $ctext tag conf d1 -elide [lindex $diffelide 1]
5436 proc prevfile {} {
5437 global difffilestart ctext
5438 set prev [lindex $difffilestart 0]
5439 set here [$ctext index @0,0]
5440 foreach loc $difffilestart {
5441 if {[$ctext compare $loc >= $here]} {
5442 $ctext yview $prev
5443 return
5445 set prev $loc
5447 $ctext yview $prev
5450 proc nextfile {} {
5451 global difffilestart ctext
5452 set here [$ctext index @0,0]
5453 foreach loc $difffilestart {
5454 if {[$ctext compare $loc > $here]} {
5455 $ctext yview $loc
5456 return
5461 proc clear_ctext {{first 1.0}} {
5462 global ctext smarktop smarkbot
5463 global pendinglinks
5465 set l [lindex [split $first .] 0]
5466 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5467 set smarktop $l
5469 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5470 set smarkbot $l
5472 $ctext delete $first end
5473 if {$first eq "1.0"} {
5474 catch {unset pendinglinks}
5478 proc settabs {{firstab {}}} {
5479 global firsttabstop tabstop ctext have_tk85
5481 if {$firstab ne {} && $have_tk85} {
5482 set firsttabstop $firstab
5484 set w [font measure textfont "0"]
5485 if {$firsttabstop != 0} {
5486 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5487 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5488 } elseif {$have_tk85 || $tabstop != 8} {
5489 $ctext conf -tabs [expr {$tabstop * $w}]
5490 } else {
5491 $ctext conf -tabs {}
5495 proc incrsearch {name ix op} {
5496 global ctext searchstring searchdirn
5498 $ctext tag remove found 1.0 end
5499 if {[catch {$ctext index anchor}]} {
5500 # no anchor set, use start of selection, or of visible area
5501 set sel [$ctext tag ranges sel]
5502 if {$sel ne {}} {
5503 $ctext mark set anchor [lindex $sel 0]
5504 } elseif {$searchdirn eq "-forwards"} {
5505 $ctext mark set anchor @0,0
5506 } else {
5507 $ctext mark set anchor @0,[winfo height $ctext]
5510 if {$searchstring ne {}} {
5511 set here [$ctext search $searchdirn -- $searchstring anchor]
5512 if {$here ne {}} {
5513 $ctext see $here
5515 searchmarkvisible 1
5519 proc dosearch {} {
5520 global sstring ctext searchstring searchdirn
5522 focus $sstring
5523 $sstring icursor end
5524 set searchdirn -forwards
5525 if {$searchstring ne {}} {
5526 set sel [$ctext tag ranges sel]
5527 if {$sel ne {}} {
5528 set start "[lindex $sel 0] + 1c"
5529 } elseif {[catch {set start [$ctext index anchor]}]} {
5530 set start "@0,0"
5532 set match [$ctext search -count mlen -- $searchstring $start]
5533 $ctext tag remove sel 1.0 end
5534 if {$match eq {}} {
5535 bell
5536 return
5538 $ctext see $match
5539 set mend "$match + $mlen c"
5540 $ctext tag add sel $match $mend
5541 $ctext mark unset anchor
5545 proc dosearchback {} {
5546 global sstring ctext searchstring searchdirn
5548 focus $sstring
5549 $sstring icursor end
5550 set searchdirn -backwards
5551 if {$searchstring ne {}} {
5552 set sel [$ctext tag ranges sel]
5553 if {$sel ne {}} {
5554 set start [lindex $sel 0]
5555 } elseif {[catch {set start [$ctext index anchor]}]} {
5556 set start @0,[winfo height $ctext]
5558 set match [$ctext search -backwards -count ml -- $searchstring $start]
5559 $ctext tag remove sel 1.0 end
5560 if {$match eq {}} {
5561 bell
5562 return
5564 $ctext see $match
5565 set mend "$match + $ml c"
5566 $ctext tag add sel $match $mend
5567 $ctext mark unset anchor
5571 proc searchmark {first last} {
5572 global ctext searchstring
5574 set mend $first.0
5575 while {1} {
5576 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5577 if {$match eq {}} break
5578 set mend "$match + $mlen c"
5579 $ctext tag add found $match $mend
5583 proc searchmarkvisible {doall} {
5584 global ctext smarktop smarkbot
5586 set topline [lindex [split [$ctext index @0,0] .] 0]
5587 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5588 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5589 # no overlap with previous
5590 searchmark $topline $botline
5591 set smarktop $topline
5592 set smarkbot $botline
5593 } else {
5594 if {$topline < $smarktop} {
5595 searchmark $topline [expr {$smarktop-1}]
5596 set smarktop $topline
5598 if {$botline > $smarkbot} {
5599 searchmark [expr {$smarkbot+1}] $botline
5600 set smarkbot $botline
5605 proc scrolltext {f0 f1} {
5606 global searchstring
5608 .bleft.sb set $f0 $f1
5609 if {$searchstring ne {}} {
5610 searchmarkvisible 0
5614 proc setcoords {} {
5615 global linespc charspc canvx0 canvy0
5616 global xspc1 xspc2 lthickness
5618 set linespc [font metrics mainfont -linespace]
5619 set charspc [font measure mainfont "m"]
5620 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5621 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5622 set lthickness [expr {int($linespc / 9) + 1}]
5623 set xspc1(0) $linespc
5624 set xspc2 $linespc
5627 proc redisplay {} {
5628 global canv
5629 global selectedline
5631 set ymax [lindex [$canv cget -scrollregion] 3]
5632 if {$ymax eq {} || $ymax == 0} return
5633 set span [$canv yview]
5634 clear_display
5635 setcanvscroll
5636 allcanvs yview moveto [lindex $span 0]
5637 drawvisible
5638 if {[info exists selectedline]} {
5639 selectline $selectedline 0
5640 allcanvs yview moveto [lindex $span 0]
5644 proc parsefont {f n} {
5645 global fontattr
5647 set fontattr($f,family) [lindex $n 0]
5648 set s [lindex $n 1]
5649 if {$s eq {} || $s == 0} {
5650 set s 10
5651 } elseif {$s < 0} {
5652 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5654 set fontattr($f,size) $s
5655 set fontattr($f,weight) normal
5656 set fontattr($f,slant) roman
5657 foreach style [lrange $n 2 end] {
5658 switch -- $style {
5659 "normal" -
5660 "bold" {set fontattr($f,weight) $style}
5661 "roman" -
5662 "italic" {set fontattr($f,slant) $style}
5667 proc fontflags {f {isbold 0}} {
5668 global fontattr
5670 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5671 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5672 -slant $fontattr($f,slant)]
5675 proc fontname {f} {
5676 global fontattr
5678 set n [list $fontattr($f,family) $fontattr($f,size)]
5679 if {$fontattr($f,weight) eq "bold"} {
5680 lappend n "bold"
5682 if {$fontattr($f,slant) eq "italic"} {
5683 lappend n "italic"
5685 return $n
5688 proc incrfont {inc} {
5689 global mainfont textfont ctext canv phase cflist showrefstop
5690 global stopped entries fontattr
5692 unmarkmatches
5693 set s $fontattr(mainfont,size)
5694 incr s $inc
5695 if {$s < 1} {
5696 set s 1
5698 set fontattr(mainfont,size) $s
5699 font config mainfont -size $s
5700 font config mainfontbold -size $s
5701 set mainfont [fontname mainfont]
5702 set s $fontattr(textfont,size)
5703 incr s $inc
5704 if {$s < 1} {
5705 set s 1
5707 set fontattr(textfont,size) $s
5708 font config textfont -size $s
5709 font config textfontbold -size $s
5710 set textfont [fontname textfont]
5711 setcoords
5712 settabs
5713 redisplay
5716 proc clearsha1 {} {
5717 global sha1entry sha1string
5718 if {[string length $sha1string] == 40} {
5719 $sha1entry delete 0 end
5723 proc sha1change {n1 n2 op} {
5724 global sha1string currentid sha1but
5725 if {$sha1string == {}
5726 || ([info exists currentid] && $sha1string == $currentid)} {
5727 set state disabled
5728 } else {
5729 set state normal
5731 if {[$sha1but cget -state] == $state} return
5732 if {$state == "normal"} {
5733 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5734 } else {
5735 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5739 proc gotocommit {} {
5740 global sha1string currentid commitrow tagids headids
5741 global displayorder numcommits curview
5743 if {$sha1string == {}
5744 || ([info exists currentid] && $sha1string == $currentid)} return
5745 if {[info exists tagids($sha1string)]} {
5746 set id $tagids($sha1string)
5747 } elseif {[info exists headids($sha1string)]} {
5748 set id $headids($sha1string)
5749 } else {
5750 set id [string tolower $sha1string]
5751 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5752 set matches {}
5753 foreach i $displayorder {
5754 if {[string match $id* $i]} {
5755 lappend matches $i
5758 if {$matches ne {}} {
5759 if {[llength $matches] > 1} {
5760 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5761 return
5763 set id [lindex $matches 0]
5767 if {[info exists commitrow($curview,$id)]} {
5768 selectline $commitrow($curview,$id) 1
5769 return
5771 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5772 set msg [mc "SHA1 id %s is not known" $sha1string]
5773 } else {
5774 set msg [mc "Tag/Head %s is not known" $sha1string]
5776 error_popup $msg
5779 proc lineenter {x y id} {
5780 global hoverx hovery hoverid hovertimer
5781 global commitinfo canv
5783 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5784 set hoverx $x
5785 set hovery $y
5786 set hoverid $id
5787 if {[info exists hovertimer]} {
5788 after cancel $hovertimer
5790 set hovertimer [after 500 linehover]
5791 $canv delete hover
5794 proc linemotion {x y id} {
5795 global hoverx hovery hoverid hovertimer
5797 if {[info exists hoverid] && $id == $hoverid} {
5798 set hoverx $x
5799 set hovery $y
5800 if {[info exists hovertimer]} {
5801 after cancel $hovertimer
5803 set hovertimer [after 500 linehover]
5807 proc lineleave {id} {
5808 global hoverid hovertimer canv
5810 if {[info exists hoverid] && $id == $hoverid} {
5811 $canv delete hover
5812 if {[info exists hovertimer]} {
5813 after cancel $hovertimer
5814 unset hovertimer
5816 unset hoverid
5820 proc linehover {} {
5821 global hoverx hovery hoverid hovertimer
5822 global canv linespc lthickness
5823 global commitinfo
5825 set text [lindex $commitinfo($hoverid) 0]
5826 set ymax [lindex [$canv cget -scrollregion] 3]
5827 if {$ymax == {}} return
5828 set yfrac [lindex [$canv yview] 0]
5829 set x [expr {$hoverx + 2 * $linespc}]
5830 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5831 set x0 [expr {$x - 2 * $lthickness}]
5832 set y0 [expr {$y - 2 * $lthickness}]
5833 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5834 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5835 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5836 -fill \#ffff80 -outline black -width 1 -tags hover]
5837 $canv raise $t
5838 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5839 -font mainfont]
5840 $canv raise $t
5843 proc clickisonarrow {id y} {
5844 global lthickness
5846 set ranges [rowranges $id]
5847 set thresh [expr {2 * $lthickness + 6}]
5848 set n [expr {[llength $ranges] - 1}]
5849 for {set i 1} {$i < $n} {incr i} {
5850 set row [lindex $ranges $i]
5851 if {abs([yc $row] - $y) < $thresh} {
5852 return $i
5855 return {}
5858 proc arrowjump {id n y} {
5859 global canv
5861 # 1 <-> 2, 3 <-> 4, etc...
5862 set n [expr {(($n - 1) ^ 1) + 1}]
5863 set row [lindex [rowranges $id] $n]
5864 set yt [yc $row]
5865 set ymax [lindex [$canv cget -scrollregion] 3]
5866 if {$ymax eq {} || $ymax <= 0} return
5867 set view [$canv yview]
5868 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5869 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5870 if {$yfrac < 0} {
5871 set yfrac 0
5873 allcanvs yview moveto $yfrac
5876 proc lineclick {x y id isnew} {
5877 global ctext commitinfo children canv thickerline curview commitrow
5879 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5880 unmarkmatches
5881 unselectline
5882 normalline
5883 $canv delete hover
5884 # draw this line thicker than normal
5885 set thickerline $id
5886 drawlines $id
5887 if {$isnew} {
5888 set ymax [lindex [$canv cget -scrollregion] 3]
5889 if {$ymax eq {}} return
5890 set yfrac [lindex [$canv yview] 0]
5891 set y [expr {$y + $yfrac * $ymax}]
5893 set dirn [clickisonarrow $id $y]
5894 if {$dirn ne {}} {
5895 arrowjump $id $dirn $y
5896 return
5899 if {$isnew} {
5900 addtohistory [list lineclick $x $y $id 0]
5902 # fill the details pane with info about this line
5903 $ctext conf -state normal
5904 clear_ctext
5905 settabs 0
5906 $ctext insert end "[mc "Parent"]:\t"
5907 $ctext insert end $id link0
5908 setlink $id link0
5909 set info $commitinfo($id)
5910 $ctext insert end "\n\t[lindex $info 0]\n"
5911 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5912 set date [formatdate [lindex $info 2]]
5913 $ctext insert end "\t[mc "Date"]:\t$date\n"
5914 set kids $children($curview,$id)
5915 if {$kids ne {}} {
5916 $ctext insert end "\n[mc "Children"]:"
5917 set i 0
5918 foreach child $kids {
5919 incr i
5920 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5921 set info $commitinfo($child)
5922 $ctext insert end "\n\t"
5923 $ctext insert end $child link$i
5924 setlink $child link$i
5925 $ctext insert end "\n\t[lindex $info 0]"
5926 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5927 set date [formatdate [lindex $info 2]]
5928 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5931 $ctext conf -state disabled
5932 init_flist {}
5935 proc normalline {} {
5936 global thickerline
5937 if {[info exists thickerline]} {
5938 set id $thickerline
5939 unset thickerline
5940 drawlines $id
5944 proc selbyid {id} {
5945 global commitrow curview
5946 if {[info exists commitrow($curview,$id)]} {
5947 selectline $commitrow($curview,$id) 1
5951 proc mstime {} {
5952 global startmstime
5953 if {![info exists startmstime]} {
5954 set startmstime [clock clicks -milliseconds]
5956 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5959 proc rowmenu {x y id} {
5960 global rowctxmenu commitrow selectedline rowmenuid curview
5961 global nullid nullid2 fakerowmenu mainhead
5963 stopfinding
5964 set rowmenuid $id
5965 if {![info exists selectedline]
5966 || $commitrow($curview,$id) eq $selectedline} {
5967 set state disabled
5968 } else {
5969 set state normal
5971 if {$id ne $nullid && $id ne $nullid2} {
5972 set menu $rowctxmenu
5973 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
5974 } else {
5975 set menu $fakerowmenu
5977 $menu entryconfigure [mc "Diff this -> selected"] -state $state
5978 $menu entryconfigure [mc "Diff selected -> this"] -state $state
5979 $menu entryconfigure [mc "Make patch"] -state $state
5980 tk_popup $menu $x $y
5983 proc diffvssel {dirn} {
5984 global rowmenuid selectedline displayorder
5986 if {![info exists selectedline]} return
5987 if {$dirn} {
5988 set oldid [lindex $displayorder $selectedline]
5989 set newid $rowmenuid
5990 } else {
5991 set oldid $rowmenuid
5992 set newid [lindex $displayorder $selectedline]
5994 addtohistory [list doseldiff $oldid $newid]
5995 doseldiff $oldid $newid
5998 proc doseldiff {oldid newid} {
5999 global ctext
6000 global commitinfo
6002 $ctext conf -state normal
6003 clear_ctext
6004 init_flist [mc "Top"]
6005 $ctext insert end "[mc "From"] "
6006 $ctext insert end $oldid link0
6007 setlink $oldid link0
6008 $ctext insert end "\n "
6009 $ctext insert end [lindex $commitinfo($oldid) 0]
6010 $ctext insert end "\n\n[mc "To"] "
6011 $ctext insert end $newid link1
6012 setlink $newid link1
6013 $ctext insert end "\n "
6014 $ctext insert end [lindex $commitinfo($newid) 0]
6015 $ctext insert end "\n"
6016 $ctext conf -state disabled
6017 $ctext tag remove found 1.0 end
6018 startdiff [list $oldid $newid]
6021 proc mkpatch {} {
6022 global rowmenuid currentid commitinfo patchtop patchnum
6024 if {![info exists currentid]} return
6025 set oldid $currentid
6026 set oldhead [lindex $commitinfo($oldid) 0]
6027 set newid $rowmenuid
6028 set newhead [lindex $commitinfo($newid) 0]
6029 set top .patch
6030 set patchtop $top
6031 catch {destroy $top}
6032 toplevel $top
6033 label $top.title -text [mc "Generate patch"]
6034 grid $top.title - -pady 10
6035 label $top.from -text [mc "From:"]
6036 entry $top.fromsha1 -width 40 -relief flat
6037 $top.fromsha1 insert 0 $oldid
6038 $top.fromsha1 conf -state readonly
6039 grid $top.from $top.fromsha1 -sticky w
6040 entry $top.fromhead -width 60 -relief flat
6041 $top.fromhead insert 0 $oldhead
6042 $top.fromhead conf -state readonly
6043 grid x $top.fromhead -sticky w
6044 label $top.to -text [mc "To:"]
6045 entry $top.tosha1 -width 40 -relief flat
6046 $top.tosha1 insert 0 $newid
6047 $top.tosha1 conf -state readonly
6048 grid $top.to $top.tosha1 -sticky w
6049 entry $top.tohead -width 60 -relief flat
6050 $top.tohead insert 0 $newhead
6051 $top.tohead conf -state readonly
6052 grid x $top.tohead -sticky w
6053 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6054 grid $top.rev x -pady 10
6055 label $top.flab -text [mc "Output file:"]
6056 entry $top.fname -width 60
6057 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6058 incr patchnum
6059 grid $top.flab $top.fname -sticky w
6060 frame $top.buts
6061 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6062 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6063 grid $top.buts.gen $top.buts.can
6064 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6065 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6066 grid $top.buts - -pady 10 -sticky ew
6067 focus $top.fname
6070 proc mkpatchrev {} {
6071 global patchtop
6073 set oldid [$patchtop.fromsha1 get]
6074 set oldhead [$patchtop.fromhead get]
6075 set newid [$patchtop.tosha1 get]
6076 set newhead [$patchtop.tohead get]
6077 foreach e [list fromsha1 fromhead tosha1 tohead] \
6078 v [list $newid $newhead $oldid $oldhead] {
6079 $patchtop.$e conf -state normal
6080 $patchtop.$e delete 0 end
6081 $patchtop.$e insert 0 $v
6082 $patchtop.$e conf -state readonly
6086 proc mkpatchgo {} {
6087 global patchtop nullid nullid2
6089 set oldid [$patchtop.fromsha1 get]
6090 set newid [$patchtop.tosha1 get]
6091 set fname [$patchtop.fname get]
6092 set cmd [diffcmd [list $oldid $newid] -p]
6093 # trim off the initial "|"
6094 set cmd [lrange $cmd 1 end]
6095 lappend cmd >$fname &
6096 if {[catch {eval exec $cmd} err]} {
6097 error_popup "[mc "Error creating patch:"] $err"
6099 catch {destroy $patchtop}
6100 unset patchtop
6103 proc mkpatchcan {} {
6104 global patchtop
6106 catch {destroy $patchtop}
6107 unset patchtop
6110 proc mktag {} {
6111 global rowmenuid mktagtop commitinfo
6113 set top .maketag
6114 set mktagtop $top
6115 catch {destroy $top}
6116 toplevel $top
6117 label $top.title -text [mc "Create tag"]
6118 grid $top.title - -pady 10
6119 label $top.id -text [mc "ID:"]
6120 entry $top.sha1 -width 40 -relief flat
6121 $top.sha1 insert 0 $rowmenuid
6122 $top.sha1 conf -state readonly
6123 grid $top.id $top.sha1 -sticky w
6124 entry $top.head -width 60 -relief flat
6125 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6126 $top.head conf -state readonly
6127 grid x $top.head -sticky w
6128 label $top.tlab -text [mc "Tag name:"]
6129 entry $top.tag -width 60
6130 grid $top.tlab $top.tag -sticky w
6131 frame $top.buts
6132 button $top.buts.gen -text [mc "Create"] -command mktaggo
6133 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6134 grid $top.buts.gen $top.buts.can
6135 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6136 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6137 grid $top.buts - -pady 10 -sticky ew
6138 focus $top.tag
6141 proc domktag {} {
6142 global mktagtop env tagids idtags
6144 set id [$mktagtop.sha1 get]
6145 set tag [$mktagtop.tag get]
6146 if {$tag == {}} {
6147 error_popup [mc "No tag name specified"]
6148 return
6150 if {[info exists tagids($tag)]} {
6151 error_popup [mc "Tag \"%s\" already exists" $tag]
6152 return
6154 if {[catch {
6155 exec git tag $tag $id
6156 } err]} {
6157 error_popup "[mc "Error creating tag:"] $err"
6158 return
6161 set tagids($tag) $id
6162 lappend idtags($id) $tag
6163 redrawtags $id
6164 addedtag $id
6165 dispneartags 0
6166 run refill_reflist
6169 proc redrawtags {id} {
6170 global canv linehtag commitrow idpos selectedline curview
6171 global canvxmax iddrawn
6173 if {![info exists commitrow($curview,$id)]} return
6174 if {![info exists iddrawn($id)]} return
6175 drawcommits $commitrow($curview,$id)
6176 $canv delete tag.$id
6177 set xt [eval drawtags $id $idpos($id)]
6178 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6179 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6180 set xr [expr {$xt + [font measure mainfont $text]}]
6181 if {$xr > $canvxmax} {
6182 set canvxmax $xr
6183 setcanvscroll
6185 if {[info exists selectedline]
6186 && $selectedline == $commitrow($curview,$id)} {
6187 selectline $selectedline 0
6191 proc mktagcan {} {
6192 global mktagtop
6194 catch {destroy $mktagtop}
6195 unset mktagtop
6198 proc mktaggo {} {
6199 domktag
6200 mktagcan
6203 proc writecommit {} {
6204 global rowmenuid wrcomtop commitinfo wrcomcmd
6206 set top .writecommit
6207 set wrcomtop $top
6208 catch {destroy $top}
6209 toplevel $top
6210 label $top.title -text [mc "Write commit to file"]
6211 grid $top.title - -pady 10
6212 label $top.id -text [mc "ID:"]
6213 entry $top.sha1 -width 40 -relief flat
6214 $top.sha1 insert 0 $rowmenuid
6215 $top.sha1 conf -state readonly
6216 grid $top.id $top.sha1 -sticky w
6217 entry $top.head -width 60 -relief flat
6218 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6219 $top.head conf -state readonly
6220 grid x $top.head -sticky w
6221 label $top.clab -text [mc "Command:"]
6222 entry $top.cmd -width 60 -textvariable wrcomcmd
6223 grid $top.clab $top.cmd -sticky w -pady 10
6224 label $top.flab -text [mc "Output file:"]
6225 entry $top.fname -width 60
6226 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6227 grid $top.flab $top.fname -sticky w
6228 frame $top.buts
6229 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6230 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6231 grid $top.buts.gen $top.buts.can
6232 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6233 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6234 grid $top.buts - -pady 10 -sticky ew
6235 focus $top.fname
6238 proc wrcomgo {} {
6239 global wrcomtop
6241 set id [$wrcomtop.sha1 get]
6242 set cmd "echo $id | [$wrcomtop.cmd get]"
6243 set fname [$wrcomtop.fname get]
6244 if {[catch {exec sh -c $cmd >$fname &} err]} {
6245 error_popup "[mc "Error writing commit:"] $err"
6247 catch {destroy $wrcomtop}
6248 unset wrcomtop
6251 proc wrcomcan {} {
6252 global wrcomtop
6254 catch {destroy $wrcomtop}
6255 unset wrcomtop
6258 proc mkbranch {} {
6259 global rowmenuid mkbrtop
6261 set top .makebranch
6262 catch {destroy $top}
6263 toplevel $top
6264 label $top.title -text [mc "Create new branch"]
6265 grid $top.title - -pady 10
6266 label $top.id -text [mc "ID:"]
6267 entry $top.sha1 -width 40 -relief flat
6268 $top.sha1 insert 0 $rowmenuid
6269 $top.sha1 conf -state readonly
6270 grid $top.id $top.sha1 -sticky w
6271 label $top.nlab -text [mc "Name:"]
6272 entry $top.name -width 40
6273 grid $top.nlab $top.name -sticky w
6274 frame $top.buts
6275 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6276 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6277 grid $top.buts.go $top.buts.can
6278 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6279 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6280 grid $top.buts - -pady 10 -sticky ew
6281 focus $top.name
6284 proc mkbrgo {top} {
6285 global headids idheads
6287 set name [$top.name get]
6288 set id [$top.sha1 get]
6289 if {$name eq {}} {
6290 error_popup [mc "Please specify a name for the new branch"]
6291 return
6293 catch {destroy $top}
6294 nowbusy newbranch
6295 update
6296 if {[catch {
6297 exec git branch $name $id
6298 } err]} {
6299 notbusy newbranch
6300 error_popup $err
6301 } else {
6302 set headids($name) $id
6303 lappend idheads($id) $name
6304 addedhead $id $name
6305 notbusy newbranch
6306 redrawtags $id
6307 dispneartags 0
6308 run refill_reflist
6312 proc cherrypick {} {
6313 global rowmenuid curview commitrow
6314 global mainhead
6316 set oldhead [exec git rev-parse HEAD]
6317 set dheads [descheads $rowmenuid]
6318 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6319 set ok [confirm_popup [mc "Commit %s is already\
6320 included in branch %s -- really re-apply it?" \
6321 [string range $rowmenuid 0 7] $mainhead]]
6322 if {!$ok} return
6324 nowbusy cherrypick [mc "Cherry-picking"]
6325 update
6326 # Unfortunately git-cherry-pick writes stuff to stderr even when
6327 # no error occurs, and exec takes that as an indication of error...
6328 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6329 notbusy cherrypick
6330 error_popup $err
6331 return
6333 set newhead [exec git rev-parse HEAD]
6334 if {$newhead eq $oldhead} {
6335 notbusy cherrypick
6336 error_popup [mc "No changes committed"]
6337 return
6339 addnewchild $newhead $oldhead
6340 if {[info exists commitrow($curview,$oldhead)]} {
6341 insertrow $commitrow($curview,$oldhead) $newhead
6342 if {$mainhead ne {}} {
6343 movehead $newhead $mainhead
6344 movedhead $newhead $mainhead
6346 redrawtags $oldhead
6347 redrawtags $newhead
6349 notbusy cherrypick
6352 proc resethead {} {
6353 global mainheadid mainhead rowmenuid confirm_ok resettype
6355 set confirm_ok 0
6356 set w ".confirmreset"
6357 toplevel $w
6358 wm transient $w .
6359 wm title $w [mc "Confirm reset"]
6360 message $w.m -text \
6361 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6362 -justify center -aspect 1000
6363 pack $w.m -side top -fill x -padx 20 -pady 20
6364 frame $w.f -relief sunken -border 2
6365 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6366 grid $w.f.rt -sticky w
6367 set resettype mixed
6368 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6369 -text [mc "Soft: Leave working tree and index untouched"]
6370 grid $w.f.soft -sticky w
6371 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6372 -text [mc "Mixed: Leave working tree untouched, reset index"]
6373 grid $w.f.mixed -sticky w
6374 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6375 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6376 grid $w.f.hard -sticky w
6377 pack $w.f -side top -fill x
6378 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6379 pack $w.ok -side left -fill x -padx 20 -pady 20
6380 button $w.cancel -text [mc Cancel] -command "destroy $w"
6381 pack $w.cancel -side right -fill x -padx 20 -pady 20
6382 bind $w <Visibility> "grab $w; focus $w"
6383 tkwait window $w
6384 if {!$confirm_ok} return
6385 if {[catch {set fd [open \
6386 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6387 error_popup $err
6388 } else {
6389 dohidelocalchanges
6390 filerun $fd [list readresetstat $fd]
6391 nowbusy reset [mc "Resetting"]
6395 proc readresetstat {fd} {
6396 global mainhead mainheadid showlocalchanges rprogcoord
6398 if {[gets $fd line] >= 0} {
6399 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6400 set rprogcoord [expr {1.0 * $m / $n}]
6401 adjustprogress
6403 return 1
6405 set rprogcoord 0
6406 adjustprogress
6407 notbusy reset
6408 if {[catch {close $fd} err]} {
6409 error_popup $err
6411 set oldhead $mainheadid
6412 set newhead [exec git rev-parse HEAD]
6413 if {$newhead ne $oldhead} {
6414 movehead $newhead $mainhead
6415 movedhead $newhead $mainhead
6416 set mainheadid $newhead
6417 redrawtags $oldhead
6418 redrawtags $newhead
6420 if {$showlocalchanges} {
6421 doshowlocalchanges
6423 return 0
6426 # context menu for a head
6427 proc headmenu {x y id head} {
6428 global headmenuid headmenuhead headctxmenu mainhead
6430 stopfinding
6431 set headmenuid $id
6432 set headmenuhead $head
6433 set state normal
6434 if {$head eq $mainhead} {
6435 set state disabled
6437 $headctxmenu entryconfigure 0 -state $state
6438 $headctxmenu entryconfigure 1 -state $state
6439 tk_popup $headctxmenu $x $y
6442 proc cobranch {} {
6443 global headmenuid headmenuhead mainhead headids
6444 global showlocalchanges mainheadid
6446 # check the tree is clean first??
6447 set oldmainhead $mainhead
6448 nowbusy checkout [mc "Checking out"]
6449 update
6450 dohidelocalchanges
6451 if {[catch {
6452 exec git checkout -q $headmenuhead
6453 } err]} {
6454 notbusy checkout
6455 error_popup $err
6456 } else {
6457 notbusy checkout
6458 set mainhead $headmenuhead
6459 set mainheadid $headmenuid
6460 if {[info exists headids($oldmainhead)]} {
6461 redrawtags $headids($oldmainhead)
6463 redrawtags $headmenuid
6465 if {$showlocalchanges} {
6466 dodiffindex
6470 proc rmbranch {} {
6471 global headmenuid headmenuhead mainhead
6472 global idheads
6474 set head $headmenuhead
6475 set id $headmenuid
6476 # this check shouldn't be needed any more...
6477 if {$head eq $mainhead} {
6478 error_popup [mc "Cannot delete the currently checked-out branch"]
6479 return
6481 set dheads [descheads $id]
6482 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6483 # the stuff on this branch isn't on any other branch
6484 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6485 branch.\nReally delete branch %s?" $head $head]]} return
6487 nowbusy rmbranch
6488 update
6489 if {[catch {exec git branch -D $head} err]} {
6490 notbusy rmbranch
6491 error_popup $err
6492 return
6494 removehead $id $head
6495 removedhead $id $head
6496 redrawtags $id
6497 notbusy rmbranch
6498 dispneartags 0
6499 run refill_reflist
6502 # Display a list of tags and heads
6503 proc showrefs {} {
6504 global showrefstop bgcolor fgcolor selectbgcolor
6505 global bglist fglist reflistfilter reflist maincursor
6507 set top .showrefs
6508 set showrefstop $top
6509 if {[winfo exists $top]} {
6510 raise $top
6511 refill_reflist
6512 return
6514 toplevel $top
6515 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6516 text $top.list -background $bgcolor -foreground $fgcolor \
6517 -selectbackground $selectbgcolor -font mainfont \
6518 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6519 -width 30 -height 20 -cursor $maincursor \
6520 -spacing1 1 -spacing3 1 -state disabled
6521 $top.list tag configure highlight -background $selectbgcolor
6522 lappend bglist $top.list
6523 lappend fglist $top.list
6524 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6525 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6526 grid $top.list $top.ysb -sticky nsew
6527 grid $top.xsb x -sticky ew
6528 frame $top.f
6529 label $top.f.l -text "[mc "Filter"]: "
6530 entry $top.f.e -width 20 -textvariable reflistfilter
6531 set reflistfilter "*"
6532 trace add variable reflistfilter write reflistfilter_change
6533 pack $top.f.e -side right -fill x -expand 1
6534 pack $top.f.l -side left
6535 grid $top.f - -sticky ew -pady 2
6536 button $top.close -command [list destroy $top] -text [mc "Close"]
6537 grid $top.close -
6538 grid columnconfigure $top 0 -weight 1
6539 grid rowconfigure $top 0 -weight 1
6540 bind $top.list <1> {break}
6541 bind $top.list <B1-Motion> {break}
6542 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6543 set reflist {}
6544 refill_reflist
6547 proc sel_reflist {w x y} {
6548 global showrefstop reflist headids tagids otherrefids
6550 if {![winfo exists $showrefstop]} return
6551 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6552 set ref [lindex $reflist [expr {$l-1}]]
6553 set n [lindex $ref 0]
6554 switch -- [lindex $ref 1] {
6555 "H" {selbyid $headids($n)}
6556 "T" {selbyid $tagids($n)}
6557 "o" {selbyid $otherrefids($n)}
6559 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6562 proc unsel_reflist {} {
6563 global showrefstop
6565 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6566 $showrefstop.list tag remove highlight 0.0 end
6569 proc reflistfilter_change {n1 n2 op} {
6570 global reflistfilter
6572 after cancel refill_reflist
6573 after 200 refill_reflist
6576 proc refill_reflist {} {
6577 global reflist reflistfilter showrefstop headids tagids otherrefids
6578 global commitrow curview commitinterest
6580 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6581 set refs {}
6582 foreach n [array names headids] {
6583 if {[string match $reflistfilter $n]} {
6584 if {[info exists commitrow($curview,$headids($n))]} {
6585 lappend refs [list $n H]
6586 } else {
6587 set commitinterest($headids($n)) {run refill_reflist}
6591 foreach n [array names tagids] {
6592 if {[string match $reflistfilter $n]} {
6593 if {[info exists commitrow($curview,$tagids($n))]} {
6594 lappend refs [list $n T]
6595 } else {
6596 set commitinterest($tagids($n)) {run refill_reflist}
6600 foreach n [array names otherrefids] {
6601 if {[string match $reflistfilter $n]} {
6602 if {[info exists commitrow($curview,$otherrefids($n))]} {
6603 lappend refs [list $n o]
6604 } else {
6605 set commitinterest($otherrefids($n)) {run refill_reflist}
6609 set refs [lsort -index 0 $refs]
6610 if {$refs eq $reflist} return
6612 # Update the contents of $showrefstop.list according to the
6613 # differences between $reflist (old) and $refs (new)
6614 $showrefstop.list conf -state normal
6615 $showrefstop.list insert end "\n"
6616 set i 0
6617 set j 0
6618 while {$i < [llength $reflist] || $j < [llength $refs]} {
6619 if {$i < [llength $reflist]} {
6620 if {$j < [llength $refs]} {
6621 set cmp [string compare [lindex $reflist $i 0] \
6622 [lindex $refs $j 0]]
6623 if {$cmp == 0} {
6624 set cmp [string compare [lindex $reflist $i 1] \
6625 [lindex $refs $j 1]]
6627 } else {
6628 set cmp -1
6630 } else {
6631 set cmp 1
6633 switch -- $cmp {
6634 -1 {
6635 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6636 incr i
6639 incr i
6640 incr j
6643 set l [expr {$j + 1}]
6644 $showrefstop.list image create $l.0 -align baseline \
6645 -image reficon-[lindex $refs $j 1] -padx 2
6646 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6647 incr j
6651 set reflist $refs
6652 # delete last newline
6653 $showrefstop.list delete end-2c end-1c
6654 $showrefstop.list conf -state disabled
6657 # Stuff for finding nearby tags
6658 proc getallcommits {} {
6659 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6660 global idheads idtags idotherrefs allparents tagobjid
6662 if {![info exists allcommits]} {
6663 set nextarc 0
6664 set allcommits 0
6665 set seeds {}
6666 set allcwait 0
6667 set cachedarcs 0
6668 set allccache [file join [gitdir] "gitk.cache"]
6669 if {![catch {
6670 set f [open $allccache r]
6671 set allcwait 1
6672 getcache $f
6673 }]} return
6676 if {$allcwait} {
6677 return
6679 set cmd [list | git rev-list --parents]
6680 set allcupdate [expr {$seeds ne {}}]
6681 if {!$allcupdate} {
6682 set ids "--all"
6683 } else {
6684 set refs [concat [array names idheads] [array names idtags] \
6685 [array names idotherrefs]]
6686 set ids {}
6687 set tagobjs {}
6688 foreach name [array names tagobjid] {
6689 lappend tagobjs $tagobjid($name)
6691 foreach id [lsort -unique $refs] {
6692 if {![info exists allparents($id)] &&
6693 [lsearch -exact $tagobjs $id] < 0} {
6694 lappend ids $id
6697 if {$ids ne {}} {
6698 foreach id $seeds {
6699 lappend ids "^$id"
6703 if {$ids ne {}} {
6704 set fd [open [concat $cmd $ids] r]
6705 fconfigure $fd -blocking 0
6706 incr allcommits
6707 nowbusy allcommits
6708 filerun $fd [list getallclines $fd]
6709 } else {
6710 dispneartags 0
6714 # Since most commits have 1 parent and 1 child, we group strings of
6715 # such commits into "arcs" joining branch/merge points (BMPs), which
6716 # are commits that either don't have 1 parent or don't have 1 child.
6718 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6719 # arcout(id) - outgoing arcs for BMP
6720 # arcids(a) - list of IDs on arc including end but not start
6721 # arcstart(a) - BMP ID at start of arc
6722 # arcend(a) - BMP ID at end of arc
6723 # growing(a) - arc a is still growing
6724 # arctags(a) - IDs out of arcids (excluding end) that have tags
6725 # archeads(a) - IDs out of arcids (excluding end) that have heads
6726 # The start of an arc is at the descendent end, so "incoming" means
6727 # coming from descendents, and "outgoing" means going towards ancestors.
6729 proc getallclines {fd} {
6730 global allparents allchildren idtags idheads nextarc
6731 global arcnos arcids arctags arcout arcend arcstart archeads growing
6732 global seeds allcommits cachedarcs allcupdate
6734 set nid 0
6735 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6736 set id [lindex $line 0]
6737 if {[info exists allparents($id)]} {
6738 # seen it already
6739 continue
6741 set cachedarcs 0
6742 set olds [lrange $line 1 end]
6743 set allparents($id) $olds
6744 if {![info exists allchildren($id)]} {
6745 set allchildren($id) {}
6746 set arcnos($id) {}
6747 lappend seeds $id
6748 } else {
6749 set a $arcnos($id)
6750 if {[llength $olds] == 1 && [llength $a] == 1} {
6751 lappend arcids($a) $id
6752 if {[info exists idtags($id)]} {
6753 lappend arctags($a) $id
6755 if {[info exists idheads($id)]} {
6756 lappend archeads($a) $id
6758 if {[info exists allparents($olds)]} {
6759 # seen parent already
6760 if {![info exists arcout($olds)]} {
6761 splitarc $olds
6763 lappend arcids($a) $olds
6764 set arcend($a) $olds
6765 unset growing($a)
6767 lappend allchildren($olds) $id
6768 lappend arcnos($olds) $a
6769 continue
6772 foreach a $arcnos($id) {
6773 lappend arcids($a) $id
6774 set arcend($a) $id
6775 unset growing($a)
6778 set ao {}
6779 foreach p $olds {
6780 lappend allchildren($p) $id
6781 set a [incr nextarc]
6782 set arcstart($a) $id
6783 set archeads($a) {}
6784 set arctags($a) {}
6785 set archeads($a) {}
6786 set arcids($a) {}
6787 lappend ao $a
6788 set growing($a) 1
6789 if {[info exists allparents($p)]} {
6790 # seen it already, may need to make a new branch
6791 if {![info exists arcout($p)]} {
6792 splitarc $p
6794 lappend arcids($a) $p
6795 set arcend($a) $p
6796 unset growing($a)
6798 lappend arcnos($p) $a
6800 set arcout($id) $ao
6802 if {$nid > 0} {
6803 global cached_dheads cached_dtags cached_atags
6804 catch {unset cached_dheads}
6805 catch {unset cached_dtags}
6806 catch {unset cached_atags}
6808 if {![eof $fd]} {
6809 return [expr {$nid >= 1000? 2: 1}]
6811 set cacheok 1
6812 if {[catch {
6813 fconfigure $fd -blocking 1
6814 close $fd
6815 } err]} {
6816 # got an error reading the list of commits
6817 # if we were updating, try rereading the whole thing again
6818 if {$allcupdate} {
6819 incr allcommits -1
6820 dropcache $err
6821 return
6823 error_popup "[mc "Error reading commit topology information;\
6824 branch and preceding/following tag information\
6825 will be incomplete."]\n($err)"
6826 set cacheok 0
6828 if {[incr allcommits -1] == 0} {
6829 notbusy allcommits
6830 if {$cacheok} {
6831 run savecache
6834 dispneartags 0
6835 return 0
6838 proc recalcarc {a} {
6839 global arctags archeads arcids idtags idheads
6841 set at {}
6842 set ah {}
6843 foreach id [lrange $arcids($a) 0 end-1] {
6844 if {[info exists idtags($id)]} {
6845 lappend at $id
6847 if {[info exists idheads($id)]} {
6848 lappend ah $id
6851 set arctags($a) $at
6852 set archeads($a) $ah
6855 proc splitarc {p} {
6856 global arcnos arcids nextarc arctags archeads idtags idheads
6857 global arcstart arcend arcout allparents growing
6859 set a $arcnos($p)
6860 if {[llength $a] != 1} {
6861 puts "oops splitarc called but [llength $a] arcs already"
6862 return
6864 set a [lindex $a 0]
6865 set i [lsearch -exact $arcids($a) $p]
6866 if {$i < 0} {
6867 puts "oops splitarc $p not in arc $a"
6868 return
6870 set na [incr nextarc]
6871 if {[info exists arcend($a)]} {
6872 set arcend($na) $arcend($a)
6873 } else {
6874 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6875 set j [lsearch -exact $arcnos($l) $a]
6876 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6878 set tail [lrange $arcids($a) [expr {$i+1}] end]
6879 set arcids($a) [lrange $arcids($a) 0 $i]
6880 set arcend($a) $p
6881 set arcstart($na) $p
6882 set arcout($p) $na
6883 set arcids($na) $tail
6884 if {[info exists growing($a)]} {
6885 set growing($na) 1
6886 unset growing($a)
6889 foreach id $tail {
6890 if {[llength $arcnos($id)] == 1} {
6891 set arcnos($id) $na
6892 } else {
6893 set j [lsearch -exact $arcnos($id) $a]
6894 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6898 # reconstruct tags and heads lists
6899 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6900 recalcarc $a
6901 recalcarc $na
6902 } else {
6903 set arctags($na) {}
6904 set archeads($na) {}
6908 # Update things for a new commit added that is a child of one
6909 # existing commit. Used when cherry-picking.
6910 proc addnewchild {id p} {
6911 global allparents allchildren idtags nextarc
6912 global arcnos arcids arctags arcout arcend arcstart archeads growing
6913 global seeds allcommits
6915 if {![info exists allcommits] || ![info exists arcnos($p)]} return
6916 set allparents($id) [list $p]
6917 set allchildren($id) {}
6918 set arcnos($id) {}
6919 lappend seeds $id
6920 lappend allchildren($p) $id
6921 set a [incr nextarc]
6922 set arcstart($a) $id
6923 set archeads($a) {}
6924 set arctags($a) {}
6925 set arcids($a) [list $p]
6926 set arcend($a) $p
6927 if {![info exists arcout($p)]} {
6928 splitarc $p
6930 lappend arcnos($p) $a
6931 set arcout($id) [list $a]
6934 # This implements a cache for the topology information.
6935 # The cache saves, for each arc, the start and end of the arc,
6936 # the ids on the arc, and the outgoing arcs from the end.
6937 proc readcache {f} {
6938 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6939 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6940 global allcwait
6942 set a $nextarc
6943 set lim $cachedarcs
6944 if {$lim - $a > 500} {
6945 set lim [expr {$a + 500}]
6947 if {[catch {
6948 if {$a == $lim} {
6949 # finish reading the cache and setting up arctags, etc.
6950 set line [gets $f]
6951 if {$line ne "1"} {error "bad final version"}
6952 close $f
6953 foreach id [array names idtags] {
6954 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6955 [llength $allparents($id)] == 1} {
6956 set a [lindex $arcnos($id) 0]
6957 if {$arctags($a) eq {}} {
6958 recalcarc $a
6962 foreach id [array names idheads] {
6963 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6964 [llength $allparents($id)] == 1} {
6965 set a [lindex $arcnos($id) 0]
6966 if {$archeads($a) eq {}} {
6967 recalcarc $a
6971 foreach id [lsort -unique $possible_seeds] {
6972 if {$arcnos($id) eq {}} {
6973 lappend seeds $id
6976 set allcwait 0
6977 } else {
6978 while {[incr a] <= $lim} {
6979 set line [gets $f]
6980 if {[llength $line] != 3} {error "bad line"}
6981 set s [lindex $line 0]
6982 set arcstart($a) $s
6983 lappend arcout($s) $a
6984 if {![info exists arcnos($s)]} {
6985 lappend possible_seeds $s
6986 set arcnos($s) {}
6988 set e [lindex $line 1]
6989 if {$e eq {}} {
6990 set growing($a) 1
6991 } else {
6992 set arcend($a) $e
6993 if {![info exists arcout($e)]} {
6994 set arcout($e) {}
6997 set arcids($a) [lindex $line 2]
6998 foreach id $arcids($a) {
6999 lappend allparents($s) $id
7000 set s $id
7001 lappend arcnos($id) $a
7003 if {![info exists allparents($s)]} {
7004 set allparents($s) {}
7006 set arctags($a) {}
7007 set archeads($a) {}
7009 set nextarc [expr {$a - 1}]
7011 } err]} {
7012 dropcache $err
7013 return 0
7015 if {!$allcwait} {
7016 getallcommits
7018 return $allcwait
7021 proc getcache {f} {
7022 global nextarc cachedarcs possible_seeds
7024 if {[catch {
7025 set line [gets $f]
7026 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7027 # make sure it's an integer
7028 set cachedarcs [expr {int([lindex $line 1])}]
7029 if {$cachedarcs < 0} {error "bad number of arcs"}
7030 set nextarc 0
7031 set possible_seeds {}
7032 run readcache $f
7033 } err]} {
7034 dropcache $err
7036 return 0
7039 proc dropcache {err} {
7040 global allcwait nextarc cachedarcs seeds
7042 #puts "dropping cache ($err)"
7043 foreach v {arcnos arcout arcids arcstart arcend growing \
7044 arctags archeads allparents allchildren} {
7045 global $v
7046 catch {unset $v}
7048 set allcwait 0
7049 set nextarc 0
7050 set cachedarcs 0
7051 set seeds {}
7052 getallcommits
7055 proc writecache {f} {
7056 global cachearc cachedarcs allccache
7057 global arcstart arcend arcnos arcids arcout
7059 set a $cachearc
7060 set lim $cachedarcs
7061 if {$lim - $a > 1000} {
7062 set lim [expr {$a + 1000}]
7064 if {[catch {
7065 while {[incr a] <= $lim} {
7066 if {[info exists arcend($a)]} {
7067 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7068 } else {
7069 puts $f [list $arcstart($a) {} $arcids($a)]
7072 } err]} {
7073 catch {close $f}
7074 catch {file delete $allccache}
7075 #puts "writing cache failed ($err)"
7076 return 0
7078 set cachearc [expr {$a - 1}]
7079 if {$a > $cachedarcs} {
7080 puts $f "1"
7081 close $f
7082 return 0
7084 return 1
7087 proc savecache {} {
7088 global nextarc cachedarcs cachearc allccache
7090 if {$nextarc == $cachedarcs} return
7091 set cachearc 0
7092 set cachedarcs $nextarc
7093 catch {
7094 set f [open $allccache w]
7095 puts $f [list 1 $cachedarcs]
7096 run writecache $f
7100 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7101 # or 0 if neither is true.
7102 proc anc_or_desc {a b} {
7103 global arcout arcstart arcend arcnos cached_isanc
7105 if {$arcnos($a) eq $arcnos($b)} {
7106 # Both are on the same arc(s); either both are the same BMP,
7107 # or if one is not a BMP, the other is also not a BMP or is
7108 # the BMP at end of the arc (and it only has 1 incoming arc).
7109 # Or both can be BMPs with no incoming arcs.
7110 if {$a eq $b || $arcnos($a) eq {}} {
7111 return 0
7113 # assert {[llength $arcnos($a)] == 1}
7114 set arc [lindex $arcnos($a) 0]
7115 set i [lsearch -exact $arcids($arc) $a]
7116 set j [lsearch -exact $arcids($arc) $b]
7117 if {$i < 0 || $i > $j} {
7118 return 1
7119 } else {
7120 return -1
7124 if {![info exists arcout($a)]} {
7125 set arc [lindex $arcnos($a) 0]
7126 if {[info exists arcend($arc)]} {
7127 set aend $arcend($arc)
7128 } else {
7129 set aend {}
7131 set a $arcstart($arc)
7132 } else {
7133 set aend $a
7135 if {![info exists arcout($b)]} {
7136 set arc [lindex $arcnos($b) 0]
7137 if {[info exists arcend($arc)]} {
7138 set bend $arcend($arc)
7139 } else {
7140 set bend {}
7142 set b $arcstart($arc)
7143 } else {
7144 set bend $b
7146 if {$a eq $bend} {
7147 return 1
7149 if {$b eq $aend} {
7150 return -1
7152 if {[info exists cached_isanc($a,$bend)]} {
7153 if {$cached_isanc($a,$bend)} {
7154 return 1
7157 if {[info exists cached_isanc($b,$aend)]} {
7158 if {$cached_isanc($b,$aend)} {
7159 return -1
7161 if {[info exists cached_isanc($a,$bend)]} {
7162 return 0
7166 set todo [list $a $b]
7167 set anc($a) a
7168 set anc($b) b
7169 for {set i 0} {$i < [llength $todo]} {incr i} {
7170 set x [lindex $todo $i]
7171 if {$anc($x) eq {}} {
7172 continue
7174 foreach arc $arcnos($x) {
7175 set xd $arcstart($arc)
7176 if {$xd eq $bend} {
7177 set cached_isanc($a,$bend) 1
7178 set cached_isanc($b,$aend) 0
7179 return 1
7180 } elseif {$xd eq $aend} {
7181 set cached_isanc($b,$aend) 1
7182 set cached_isanc($a,$bend) 0
7183 return -1
7185 if {![info exists anc($xd)]} {
7186 set anc($xd) $anc($x)
7187 lappend todo $xd
7188 } elseif {$anc($xd) ne $anc($x)} {
7189 set anc($xd) {}
7193 set cached_isanc($a,$bend) 0
7194 set cached_isanc($b,$aend) 0
7195 return 0
7198 # This identifies whether $desc has an ancestor that is
7199 # a growing tip of the graph and which is not an ancestor of $anc
7200 # and returns 0 if so and 1 if not.
7201 # If we subsequently discover a tag on such a growing tip, and that
7202 # turns out to be a descendent of $anc (which it could, since we
7203 # don't necessarily see children before parents), then $desc
7204 # isn't a good choice to display as a descendent tag of
7205 # $anc (since it is the descendent of another tag which is
7206 # a descendent of $anc). Similarly, $anc isn't a good choice to
7207 # display as a ancestor tag of $desc.
7209 proc is_certain {desc anc} {
7210 global arcnos arcout arcstart arcend growing problems
7212 set certain {}
7213 if {[llength $arcnos($anc)] == 1} {
7214 # tags on the same arc are certain
7215 if {$arcnos($desc) eq $arcnos($anc)} {
7216 return 1
7218 if {![info exists arcout($anc)]} {
7219 # if $anc is partway along an arc, use the start of the arc instead
7220 set a [lindex $arcnos($anc) 0]
7221 set anc $arcstart($a)
7224 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7225 set x $desc
7226 } else {
7227 set a [lindex $arcnos($desc) 0]
7228 set x $arcend($a)
7230 if {$x == $anc} {
7231 return 1
7233 set anclist [list $x]
7234 set dl($x) 1
7235 set nnh 1
7236 set ngrowanc 0
7237 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7238 set x [lindex $anclist $i]
7239 if {$dl($x)} {
7240 incr nnh -1
7242 set done($x) 1
7243 foreach a $arcout($x) {
7244 if {[info exists growing($a)]} {
7245 if {![info exists growanc($x)] && $dl($x)} {
7246 set growanc($x) 1
7247 incr ngrowanc
7249 } else {
7250 set y $arcend($a)
7251 if {[info exists dl($y)]} {
7252 if {$dl($y)} {
7253 if {!$dl($x)} {
7254 set dl($y) 0
7255 if {![info exists done($y)]} {
7256 incr nnh -1
7258 if {[info exists growanc($x)]} {
7259 incr ngrowanc -1
7261 set xl [list $y]
7262 for {set k 0} {$k < [llength $xl]} {incr k} {
7263 set z [lindex $xl $k]
7264 foreach c $arcout($z) {
7265 if {[info exists arcend($c)]} {
7266 set v $arcend($c)
7267 if {[info exists dl($v)] && $dl($v)} {
7268 set dl($v) 0
7269 if {![info exists done($v)]} {
7270 incr nnh -1
7272 if {[info exists growanc($v)]} {
7273 incr ngrowanc -1
7275 lappend xl $v
7282 } elseif {$y eq $anc || !$dl($x)} {
7283 set dl($y) 0
7284 lappend anclist $y
7285 } else {
7286 set dl($y) 1
7287 lappend anclist $y
7288 incr nnh
7293 foreach x [array names growanc] {
7294 if {$dl($x)} {
7295 return 0
7297 return 0
7299 return 1
7302 proc validate_arctags {a} {
7303 global arctags idtags
7305 set i -1
7306 set na $arctags($a)
7307 foreach id $arctags($a) {
7308 incr i
7309 if {![info exists idtags($id)]} {
7310 set na [lreplace $na $i $i]
7311 incr i -1
7314 set arctags($a) $na
7317 proc validate_archeads {a} {
7318 global archeads idheads
7320 set i -1
7321 set na $archeads($a)
7322 foreach id $archeads($a) {
7323 incr i
7324 if {![info exists idheads($id)]} {
7325 set na [lreplace $na $i $i]
7326 incr i -1
7329 set archeads($a) $na
7332 # Return the list of IDs that have tags that are descendents of id,
7333 # ignoring IDs that are descendents of IDs already reported.
7334 proc desctags {id} {
7335 global arcnos arcstart arcids arctags idtags allparents
7336 global growing cached_dtags
7338 if {![info exists allparents($id)]} {
7339 return {}
7341 set t1 [clock clicks -milliseconds]
7342 set argid $id
7343 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7344 # part-way along an arc; check that arc first
7345 set a [lindex $arcnos($id) 0]
7346 if {$arctags($a) ne {}} {
7347 validate_arctags $a
7348 set i [lsearch -exact $arcids($a) $id]
7349 set tid {}
7350 foreach t $arctags($a) {
7351 set j [lsearch -exact $arcids($a) $t]
7352 if {$j >= $i} break
7353 set tid $t
7355 if {$tid ne {}} {
7356 return $tid
7359 set id $arcstart($a)
7360 if {[info exists idtags($id)]} {
7361 return $id
7364 if {[info exists cached_dtags($id)]} {
7365 return $cached_dtags($id)
7368 set origid $id
7369 set todo [list $id]
7370 set queued($id) 1
7371 set nc 1
7372 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7373 set id [lindex $todo $i]
7374 set done($id) 1
7375 set ta [info exists hastaggedancestor($id)]
7376 if {!$ta} {
7377 incr nc -1
7379 # ignore tags on starting node
7380 if {!$ta && $i > 0} {
7381 if {[info exists idtags($id)]} {
7382 set tagloc($id) $id
7383 set ta 1
7384 } elseif {[info exists cached_dtags($id)]} {
7385 set tagloc($id) $cached_dtags($id)
7386 set ta 1
7389 foreach a $arcnos($id) {
7390 set d $arcstart($a)
7391 if {!$ta && $arctags($a) ne {}} {
7392 validate_arctags $a
7393 if {$arctags($a) ne {}} {
7394 lappend tagloc($id) [lindex $arctags($a) end]
7397 if {$ta || $arctags($a) ne {}} {
7398 set tomark [list $d]
7399 for {set j 0} {$j < [llength $tomark]} {incr j} {
7400 set dd [lindex $tomark $j]
7401 if {![info exists hastaggedancestor($dd)]} {
7402 if {[info exists done($dd)]} {
7403 foreach b $arcnos($dd) {
7404 lappend tomark $arcstart($b)
7406 if {[info exists tagloc($dd)]} {
7407 unset tagloc($dd)
7409 } elseif {[info exists queued($dd)]} {
7410 incr nc -1
7412 set hastaggedancestor($dd) 1
7416 if {![info exists queued($d)]} {
7417 lappend todo $d
7418 set queued($d) 1
7419 if {![info exists hastaggedancestor($d)]} {
7420 incr nc
7425 set tags {}
7426 foreach id [array names tagloc] {
7427 if {![info exists hastaggedancestor($id)]} {
7428 foreach t $tagloc($id) {
7429 if {[lsearch -exact $tags $t] < 0} {
7430 lappend tags $t
7435 set t2 [clock clicks -milliseconds]
7436 set loopix $i
7438 # remove tags that are descendents of other tags
7439 for {set i 0} {$i < [llength $tags]} {incr i} {
7440 set a [lindex $tags $i]
7441 for {set j 0} {$j < $i} {incr j} {
7442 set b [lindex $tags $j]
7443 set r [anc_or_desc $a $b]
7444 if {$r == 1} {
7445 set tags [lreplace $tags $j $j]
7446 incr j -1
7447 incr i -1
7448 } elseif {$r == -1} {
7449 set tags [lreplace $tags $i $i]
7450 incr i -1
7451 break
7456 if {[array names growing] ne {}} {
7457 # graph isn't finished, need to check if any tag could get
7458 # eclipsed by another tag coming later. Simply ignore any
7459 # tags that could later get eclipsed.
7460 set ctags {}
7461 foreach t $tags {
7462 if {[is_certain $t $origid]} {
7463 lappend ctags $t
7466 if {$tags eq $ctags} {
7467 set cached_dtags($origid) $tags
7468 } else {
7469 set tags $ctags
7471 } else {
7472 set cached_dtags($origid) $tags
7474 set t3 [clock clicks -milliseconds]
7475 if {0 && $t3 - $t1 >= 100} {
7476 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7477 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7479 return $tags
7482 proc anctags {id} {
7483 global arcnos arcids arcout arcend arctags idtags allparents
7484 global growing cached_atags
7486 if {![info exists allparents($id)]} {
7487 return {}
7489 set t1 [clock clicks -milliseconds]
7490 set argid $id
7491 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7492 # part-way along an arc; check that arc first
7493 set a [lindex $arcnos($id) 0]
7494 if {$arctags($a) ne {}} {
7495 validate_arctags $a
7496 set i [lsearch -exact $arcids($a) $id]
7497 foreach t $arctags($a) {
7498 set j [lsearch -exact $arcids($a) $t]
7499 if {$j > $i} {
7500 return $t
7504 if {![info exists arcend($a)]} {
7505 return {}
7507 set id $arcend($a)
7508 if {[info exists idtags($id)]} {
7509 return $id
7512 if {[info exists cached_atags($id)]} {
7513 return $cached_atags($id)
7516 set origid $id
7517 set todo [list $id]
7518 set queued($id) 1
7519 set taglist {}
7520 set nc 1
7521 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7522 set id [lindex $todo $i]
7523 set done($id) 1
7524 set td [info exists hastaggeddescendent($id)]
7525 if {!$td} {
7526 incr nc -1
7528 # ignore tags on starting node
7529 if {!$td && $i > 0} {
7530 if {[info exists idtags($id)]} {
7531 set tagloc($id) $id
7532 set td 1
7533 } elseif {[info exists cached_atags($id)]} {
7534 set tagloc($id) $cached_atags($id)
7535 set td 1
7538 foreach a $arcout($id) {
7539 if {!$td && $arctags($a) ne {}} {
7540 validate_arctags $a
7541 if {$arctags($a) ne {}} {
7542 lappend tagloc($id) [lindex $arctags($a) 0]
7545 if {![info exists arcend($a)]} continue
7546 set d $arcend($a)
7547 if {$td || $arctags($a) ne {}} {
7548 set tomark [list $d]
7549 for {set j 0} {$j < [llength $tomark]} {incr j} {
7550 set dd [lindex $tomark $j]
7551 if {![info exists hastaggeddescendent($dd)]} {
7552 if {[info exists done($dd)]} {
7553 foreach b $arcout($dd) {
7554 if {[info exists arcend($b)]} {
7555 lappend tomark $arcend($b)
7558 if {[info exists tagloc($dd)]} {
7559 unset tagloc($dd)
7561 } elseif {[info exists queued($dd)]} {
7562 incr nc -1
7564 set hastaggeddescendent($dd) 1
7568 if {![info exists queued($d)]} {
7569 lappend todo $d
7570 set queued($d) 1
7571 if {![info exists hastaggeddescendent($d)]} {
7572 incr nc
7577 set t2 [clock clicks -milliseconds]
7578 set loopix $i
7579 set tags {}
7580 foreach id [array names tagloc] {
7581 if {![info exists hastaggeddescendent($id)]} {
7582 foreach t $tagloc($id) {
7583 if {[lsearch -exact $tags $t] < 0} {
7584 lappend tags $t
7590 # remove tags that are ancestors of other tags
7591 for {set i 0} {$i < [llength $tags]} {incr i} {
7592 set a [lindex $tags $i]
7593 for {set j 0} {$j < $i} {incr j} {
7594 set b [lindex $tags $j]
7595 set r [anc_or_desc $a $b]
7596 if {$r == -1} {
7597 set tags [lreplace $tags $j $j]
7598 incr j -1
7599 incr i -1
7600 } elseif {$r == 1} {
7601 set tags [lreplace $tags $i $i]
7602 incr i -1
7603 break
7608 if {[array names growing] ne {}} {
7609 # graph isn't finished, need to check if any tag could get
7610 # eclipsed by another tag coming later. Simply ignore any
7611 # tags that could later get eclipsed.
7612 set ctags {}
7613 foreach t $tags {
7614 if {[is_certain $origid $t]} {
7615 lappend ctags $t
7618 if {$tags eq $ctags} {
7619 set cached_atags($origid) $tags
7620 } else {
7621 set tags $ctags
7623 } else {
7624 set cached_atags($origid) $tags
7626 set t3 [clock clicks -milliseconds]
7627 if {0 && $t3 - $t1 >= 100} {
7628 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7629 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7631 return $tags
7634 # Return the list of IDs that have heads that are descendents of id,
7635 # including id itself if it has a head.
7636 proc descheads {id} {
7637 global arcnos arcstart arcids archeads idheads cached_dheads
7638 global allparents
7640 if {![info exists allparents($id)]} {
7641 return {}
7643 set aret {}
7644 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7645 # part-way along an arc; check it first
7646 set a [lindex $arcnos($id) 0]
7647 if {$archeads($a) ne {}} {
7648 validate_archeads $a
7649 set i [lsearch -exact $arcids($a) $id]
7650 foreach t $archeads($a) {
7651 set j [lsearch -exact $arcids($a) $t]
7652 if {$j > $i} break
7653 lappend aret $t
7656 set id $arcstart($a)
7658 set origid $id
7659 set todo [list $id]
7660 set seen($id) 1
7661 set ret {}
7662 for {set i 0} {$i < [llength $todo]} {incr i} {
7663 set id [lindex $todo $i]
7664 if {[info exists cached_dheads($id)]} {
7665 set ret [concat $ret $cached_dheads($id)]
7666 } else {
7667 if {[info exists idheads($id)]} {
7668 lappend ret $id
7670 foreach a $arcnos($id) {
7671 if {$archeads($a) ne {}} {
7672 validate_archeads $a
7673 if {$archeads($a) ne {}} {
7674 set ret [concat $ret $archeads($a)]
7677 set d $arcstart($a)
7678 if {![info exists seen($d)]} {
7679 lappend todo $d
7680 set seen($d) 1
7685 set ret [lsort -unique $ret]
7686 set cached_dheads($origid) $ret
7687 return [concat $ret $aret]
7690 proc addedtag {id} {
7691 global arcnos arcout cached_dtags cached_atags
7693 if {![info exists arcnos($id)]} return
7694 if {![info exists arcout($id)]} {
7695 recalcarc [lindex $arcnos($id) 0]
7697 catch {unset cached_dtags}
7698 catch {unset cached_atags}
7701 proc addedhead {hid head} {
7702 global arcnos arcout cached_dheads
7704 if {![info exists arcnos($hid)]} return
7705 if {![info exists arcout($hid)]} {
7706 recalcarc [lindex $arcnos($hid) 0]
7708 catch {unset cached_dheads}
7711 proc removedhead {hid head} {
7712 global cached_dheads
7714 catch {unset cached_dheads}
7717 proc movedhead {hid head} {
7718 global arcnos arcout cached_dheads
7720 if {![info exists arcnos($hid)]} return
7721 if {![info exists arcout($hid)]} {
7722 recalcarc [lindex $arcnos($hid) 0]
7724 catch {unset cached_dheads}
7727 proc changedrefs {} {
7728 global cached_dheads cached_dtags cached_atags
7729 global arctags archeads arcnos arcout idheads idtags
7731 foreach id [concat [array names idheads] [array names idtags]] {
7732 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7733 set a [lindex $arcnos($id) 0]
7734 if {![info exists donearc($a)]} {
7735 recalcarc $a
7736 set donearc($a) 1
7740 catch {unset cached_dtags}
7741 catch {unset cached_atags}
7742 catch {unset cached_dheads}
7745 proc rereadrefs {} {
7746 global idtags idheads idotherrefs mainhead
7748 set refids [concat [array names idtags] \
7749 [array names idheads] [array names idotherrefs]]
7750 foreach id $refids {
7751 if {![info exists ref($id)]} {
7752 set ref($id) [listrefs $id]
7755 set oldmainhead $mainhead
7756 readrefs
7757 changedrefs
7758 set refids [lsort -unique [concat $refids [array names idtags] \
7759 [array names idheads] [array names idotherrefs]]]
7760 foreach id $refids {
7761 set v [listrefs $id]
7762 if {![info exists ref($id)] || $ref($id) != $v ||
7763 ($id eq $oldmainhead && $id ne $mainhead) ||
7764 ($id eq $mainhead && $id ne $oldmainhead)} {
7765 redrawtags $id
7768 run refill_reflist
7771 proc listrefs {id} {
7772 global idtags idheads idotherrefs
7774 set x {}
7775 if {[info exists idtags($id)]} {
7776 set x $idtags($id)
7778 set y {}
7779 if {[info exists idheads($id)]} {
7780 set y $idheads($id)
7782 set z {}
7783 if {[info exists idotherrefs($id)]} {
7784 set z $idotherrefs($id)
7786 return [list $x $y $z]
7789 proc showtag {tag isnew} {
7790 global ctext tagcontents tagids linknum tagobjid
7792 if {$isnew} {
7793 addtohistory [list showtag $tag 0]
7795 $ctext conf -state normal
7796 clear_ctext
7797 settabs 0
7798 set linknum 0
7799 if {![info exists tagcontents($tag)]} {
7800 catch {
7801 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7804 if {[info exists tagcontents($tag)]} {
7805 set text $tagcontents($tag)
7806 } else {
7807 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
7809 appendwithlinks $text {}
7810 $ctext conf -state disabled
7811 init_flist {}
7814 proc doquit {} {
7815 global stopped
7816 set stopped 100
7817 savestuff .
7818 destroy .
7821 proc mkfontdisp {font top which} {
7822 global fontattr fontpref $font
7824 set fontpref($font) [set $font]
7825 button $top.${font}but -text $which -font optionfont \
7826 -command [list choosefont $font $which]
7827 label $top.$font -relief flat -font $font \
7828 -text $fontattr($font,family) -justify left
7829 grid x $top.${font}but $top.$font -sticky w
7832 proc choosefont {font which} {
7833 global fontparam fontlist fonttop fontattr
7835 set fontparam(which) $which
7836 set fontparam(font) $font
7837 set fontparam(family) [font actual $font -family]
7838 set fontparam(size) $fontattr($font,size)
7839 set fontparam(weight) $fontattr($font,weight)
7840 set fontparam(slant) $fontattr($font,slant)
7841 set top .gitkfont
7842 set fonttop $top
7843 if {![winfo exists $top]} {
7844 font create sample
7845 eval font config sample [font actual $font]
7846 toplevel $top
7847 wm title $top [mc "Gitk font chooser"]
7848 label $top.l -textvariable fontparam(which)
7849 pack $top.l -side top
7850 set fontlist [lsort [font families]]
7851 frame $top.f
7852 listbox $top.f.fam -listvariable fontlist \
7853 -yscrollcommand [list $top.f.sb set]
7854 bind $top.f.fam <<ListboxSelect>> selfontfam
7855 scrollbar $top.f.sb -command [list $top.f.fam yview]
7856 pack $top.f.sb -side right -fill y
7857 pack $top.f.fam -side left -fill both -expand 1
7858 pack $top.f -side top -fill both -expand 1
7859 frame $top.g
7860 spinbox $top.g.size -from 4 -to 40 -width 4 \
7861 -textvariable fontparam(size) \
7862 -validatecommand {string is integer -strict %s}
7863 checkbutton $top.g.bold -padx 5 \
7864 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7865 -variable fontparam(weight) -onvalue bold -offvalue normal
7866 checkbutton $top.g.ital -padx 5 \
7867 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7868 -variable fontparam(slant) -onvalue italic -offvalue roman
7869 pack $top.g.size $top.g.bold $top.g.ital -side left
7870 pack $top.g -side top
7871 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7872 -background white
7873 $top.c create text 100 25 -anchor center -text $which -font sample \
7874 -fill black -tags text
7875 bind $top.c <Configure> [list centertext $top.c]
7876 pack $top.c -side top -fill x
7877 frame $top.buts
7878 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7879 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7880 grid $top.buts.ok $top.buts.can
7881 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7882 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7883 pack $top.buts -side bottom -fill x
7884 trace add variable fontparam write chg_fontparam
7885 } else {
7886 raise $top
7887 $top.c itemconf text -text $which
7889 set i [lsearch -exact $fontlist $fontparam(family)]
7890 if {$i >= 0} {
7891 $top.f.fam selection set $i
7892 $top.f.fam see $i
7896 proc centertext {w} {
7897 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7900 proc fontok {} {
7901 global fontparam fontpref prefstop
7903 set f $fontparam(font)
7904 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7905 if {$fontparam(weight) eq "bold"} {
7906 lappend fontpref($f) "bold"
7908 if {$fontparam(slant) eq "italic"} {
7909 lappend fontpref($f) "italic"
7911 set w $prefstop.$f
7912 $w conf -text $fontparam(family) -font $fontpref($f)
7914 fontcan
7917 proc fontcan {} {
7918 global fonttop fontparam
7920 if {[info exists fonttop]} {
7921 catch {destroy $fonttop}
7922 catch {font delete sample}
7923 unset fonttop
7924 unset fontparam
7928 proc selfontfam {} {
7929 global fonttop fontparam
7931 set i [$fonttop.f.fam curselection]
7932 if {$i ne {}} {
7933 set fontparam(family) [$fonttop.f.fam get $i]
7937 proc chg_fontparam {v sub op} {
7938 global fontparam
7940 font config sample -$sub $fontparam($sub)
7943 proc doprefs {} {
7944 global maxwidth maxgraphpct
7945 global oldprefs prefstop showneartags showlocalchanges
7946 global bgcolor fgcolor ctext diffcolors selectbgcolor
7947 global tabstop limitdiffs
7949 set top .gitkprefs
7950 set prefstop $top
7951 if {[winfo exists $top]} {
7952 raise $top
7953 return
7955 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7956 limitdiffs tabstop} {
7957 set oldprefs($v) [set $v]
7959 toplevel $top
7960 wm title $top [mc "Gitk preferences"]
7961 label $top.ldisp -text [mc "Commit list display options"]
7962 grid $top.ldisp - -sticky w -pady 10
7963 label $top.spacer -text " "
7964 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7965 -font optionfont
7966 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7967 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7968 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7969 -font optionfont
7970 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7971 grid x $top.maxpctl $top.maxpct -sticky w
7972 frame $top.showlocal
7973 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7974 checkbutton $top.showlocal.b -variable showlocalchanges
7975 pack $top.showlocal.b $top.showlocal.l -side left
7976 grid x $top.showlocal -sticky w
7978 label $top.ddisp -text [mc "Diff display options"]
7979 grid $top.ddisp - -sticky w -pady 10
7980 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7981 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7982 grid x $top.tabstopl $top.tabstop -sticky w
7983 frame $top.ntag
7984 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7985 checkbutton $top.ntag.b -variable showneartags
7986 pack $top.ntag.b $top.ntag.l -side left
7987 grid x $top.ntag -sticky w
7988 frame $top.ldiff
7989 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7990 checkbutton $top.ldiff.b -variable limitdiffs
7991 pack $top.ldiff.b $top.ldiff.l -side left
7992 grid x $top.ldiff -sticky w
7994 label $top.cdisp -text [mc "Colors: press to choose"]
7995 grid $top.cdisp - -sticky w -pady 10
7996 label $top.bg -padx 40 -relief sunk -background $bgcolor
7997 button $top.bgbut -text [mc "Background"] -font optionfont \
7998 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7999 grid x $top.bgbut $top.bg -sticky w
8000 label $top.fg -padx 40 -relief sunk -background $fgcolor
8001 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8002 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8003 grid x $top.fgbut $top.fg -sticky w
8004 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8005 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8006 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8007 [list $ctext tag conf d0 -foreground]]
8008 grid x $top.diffoldbut $top.diffold -sticky w
8009 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8010 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8011 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8012 [list $ctext tag conf d1 -foreground]]
8013 grid x $top.diffnewbut $top.diffnew -sticky w
8014 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8015 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8016 -command [list choosecolor diffcolors 2 $top.hunksep \
8017 "diff hunk header" \
8018 [list $ctext tag conf hunksep -foreground]]
8019 grid x $top.hunksepbut $top.hunksep -sticky w
8020 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8021 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8022 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8023 grid x $top.selbgbut $top.selbgsep -sticky w
8025 label $top.cfont -text [mc "Fonts: press to choose"]
8026 grid $top.cfont - -sticky w -pady 10
8027 mkfontdisp mainfont $top [mc "Main font"]
8028 mkfontdisp textfont $top [mc "Diff display font"]
8029 mkfontdisp uifont $top [mc "User interface font"]
8031 frame $top.buts
8032 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8033 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8034 grid $top.buts.ok $top.buts.can
8035 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8036 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8037 grid $top.buts - - -pady 10 -sticky ew
8038 bind $top <Visibility> "focus $top.buts.ok"
8041 proc choosecolor {v vi w x cmd} {
8042 global $v
8044 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8045 -title [mc "Gitk: choose color for %s" $x]]
8046 if {$c eq {}} return
8047 $w conf -background $c
8048 lset $v $vi $c
8049 eval $cmd $c
8052 proc setselbg {c} {
8053 global bglist cflist
8054 foreach w $bglist {
8055 $w configure -selectbackground $c
8057 $cflist tag configure highlight \
8058 -background [$cflist cget -selectbackground]
8059 allcanvs itemconf secsel -fill $c
8062 proc setbg {c} {
8063 global bglist
8065 foreach w $bglist {
8066 $w conf -background $c
8070 proc setfg {c} {
8071 global fglist canv
8073 foreach w $fglist {
8074 $w conf -foreground $c
8076 allcanvs itemconf text -fill $c
8077 $canv itemconf circle -outline $c
8080 proc prefscan {} {
8081 global oldprefs prefstop
8083 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8084 limitdiffs tabstop} {
8085 global $v
8086 set $v $oldprefs($v)
8088 catch {destroy $prefstop}
8089 unset prefstop
8090 fontcan
8093 proc prefsok {} {
8094 global maxwidth maxgraphpct
8095 global oldprefs prefstop showneartags showlocalchanges
8096 global fontpref mainfont textfont uifont
8097 global limitdiffs treediffs
8099 catch {destroy $prefstop}
8100 unset prefstop
8101 fontcan
8102 set fontchanged 0
8103 if {$mainfont ne $fontpref(mainfont)} {
8104 set mainfont $fontpref(mainfont)
8105 parsefont mainfont $mainfont
8106 eval font configure mainfont [fontflags mainfont]
8107 eval font configure mainfontbold [fontflags mainfont 1]
8108 setcoords
8109 set fontchanged 1
8111 if {$textfont ne $fontpref(textfont)} {
8112 set textfont $fontpref(textfont)
8113 parsefont textfont $textfont
8114 eval font configure textfont [fontflags textfont]
8115 eval font configure textfontbold [fontflags textfont 1]
8117 if {$uifont ne $fontpref(uifont)} {
8118 set uifont $fontpref(uifont)
8119 parsefont uifont $uifont
8120 eval font configure uifont [fontflags uifont]
8122 settabs
8123 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8124 if {$showlocalchanges} {
8125 doshowlocalchanges
8126 } else {
8127 dohidelocalchanges
8130 if {$limitdiffs != $oldprefs(limitdiffs)} {
8131 # treediffs elements are limited by path
8132 catch {unset treediffs}
8134 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8135 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8136 redisplay
8137 } elseif {$showneartags != $oldprefs(showneartags) ||
8138 $limitdiffs != $oldprefs(limitdiffs)} {
8139 reselectline
8143 proc formatdate {d} {
8144 global datetimeformat
8145 if {$d ne {}} {
8146 set d [clock format $d -format $datetimeformat]
8148 return $d
8151 # This list of encoding names and aliases is distilled from
8152 # http://www.iana.org/assignments/character-sets.
8153 # Not all of them are supported by Tcl.
8154 set encoding_aliases {
8155 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8156 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8157 { ISO-10646-UTF-1 csISO10646UTF1 }
8158 { ISO_646.basic:1983 ref csISO646basic1983 }
8159 { INVARIANT csINVARIANT }
8160 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8161 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8162 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8163 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8164 { NATS-DANO iso-ir-9-1 csNATSDANO }
8165 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8166 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8167 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8168 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8169 { ISO-2022-KR csISO2022KR }
8170 { EUC-KR csEUCKR }
8171 { ISO-2022-JP csISO2022JP }
8172 { ISO-2022-JP-2 csISO2022JP2 }
8173 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8174 csISO13JISC6220jp }
8175 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8176 { IT iso-ir-15 ISO646-IT csISO15Italian }
8177 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8178 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8179 { greek7-old iso-ir-18 csISO18Greek7Old }
8180 { latin-greek iso-ir-19 csISO19LatinGreek }
8181 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8182 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8183 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8184 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8185 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8186 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8187 { INIS iso-ir-49 csISO49INIS }
8188 { INIS-8 iso-ir-50 csISO50INIS8 }
8189 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8190 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8191 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8192 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8193 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8194 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8195 csISO60Norwegian1 }
8196 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8197 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8198 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8199 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8200 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8201 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8202 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8203 { greek7 iso-ir-88 csISO88Greek7 }
8204 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8205 { iso-ir-90 csISO90 }
8206 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8207 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8208 csISO92JISC62991984b }
8209 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8210 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8211 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8212 csISO95JIS62291984handadd }
8213 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8214 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8215 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8216 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8217 CP819 csISOLatin1 }
8218 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8219 { T.61-7bit iso-ir-102 csISO102T617bit }
8220 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8221 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8222 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8223 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8224 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8225 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8226 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8227 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8228 arabic csISOLatinArabic }
8229 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8230 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8231 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8232 greek greek8 csISOLatinGreek }
8233 { T.101-G2 iso-ir-128 csISO128T101G2 }
8234 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8235 csISOLatinHebrew }
8236 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8237 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8238 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8239 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8240 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8241 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8242 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8243 csISOLatinCyrillic }
8244 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8245 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8246 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8247 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8248 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8249 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8250 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8251 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8252 { ISO_10367-box iso-ir-155 csISO10367Box }
8253 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8254 { latin-lap lap iso-ir-158 csISO158Lap }
8255 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8256 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8257 { us-dk csUSDK }
8258 { dk-us csDKUS }
8259 { JIS_X0201 X0201 csHalfWidthKatakana }
8260 { KSC5636 ISO646-KR csKSC5636 }
8261 { ISO-10646-UCS-2 csUnicode }
8262 { ISO-10646-UCS-4 csUCS4 }
8263 { DEC-MCS dec csDECMCS }
8264 { hp-roman8 roman8 r8 csHPRoman8 }
8265 { macintosh mac csMacintosh }
8266 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8267 csIBM037 }
8268 { IBM038 EBCDIC-INT cp038 csIBM038 }
8269 { IBM273 CP273 csIBM273 }
8270 { IBM274 EBCDIC-BE CP274 csIBM274 }
8271 { IBM275 EBCDIC-BR cp275 csIBM275 }
8272 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8273 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8274 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8275 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8276 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8277 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8278 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8279 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8280 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8281 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8282 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8283 { IBM437 cp437 437 csPC8CodePage437 }
8284 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8285 { IBM775 cp775 csPC775Baltic }
8286 { IBM850 cp850 850 csPC850Multilingual }
8287 { IBM851 cp851 851 csIBM851 }
8288 { IBM852 cp852 852 csPCp852 }
8289 { IBM855 cp855 855 csIBM855 }
8290 { IBM857 cp857 857 csIBM857 }
8291 { IBM860 cp860 860 csIBM860 }
8292 { IBM861 cp861 861 cp-is csIBM861 }
8293 { IBM862 cp862 862 csPC862LatinHebrew }
8294 { IBM863 cp863 863 csIBM863 }
8295 { IBM864 cp864 csIBM864 }
8296 { IBM865 cp865 865 csIBM865 }
8297 { IBM866 cp866 866 csIBM866 }
8298 { IBM868 CP868 cp-ar csIBM868 }
8299 { IBM869 cp869 869 cp-gr csIBM869 }
8300 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8301 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8302 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8303 { IBM891 cp891 csIBM891 }
8304 { IBM903 cp903 csIBM903 }
8305 { IBM904 cp904 904 csIBBM904 }
8306 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8307 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8308 { IBM1026 CP1026 csIBM1026 }
8309 { EBCDIC-AT-DE csIBMEBCDICATDE }
8310 { EBCDIC-AT-DE-A csEBCDICATDEA }
8311 { EBCDIC-CA-FR csEBCDICCAFR }
8312 { EBCDIC-DK-NO csEBCDICDKNO }
8313 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8314 { EBCDIC-FI-SE csEBCDICFISE }
8315 { EBCDIC-FI-SE-A csEBCDICFISEA }
8316 { EBCDIC-FR csEBCDICFR }
8317 { EBCDIC-IT csEBCDICIT }
8318 { EBCDIC-PT csEBCDICPT }
8319 { EBCDIC-ES csEBCDICES }
8320 { EBCDIC-ES-A csEBCDICESA }
8321 { EBCDIC-ES-S csEBCDICESS }
8322 { EBCDIC-UK csEBCDICUK }
8323 { EBCDIC-US csEBCDICUS }
8324 { UNKNOWN-8BIT csUnknown8BiT }
8325 { MNEMONIC csMnemonic }
8326 { MNEM csMnem }
8327 { VISCII csVISCII }
8328 { VIQR csVIQR }
8329 { KOI8-R csKOI8R }
8330 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8331 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8332 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8333 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8334 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8335 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8336 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8337 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8338 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8339 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8340 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8341 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8342 { IBM1047 IBM-1047 }
8343 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8344 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8345 { UNICODE-1-1 csUnicode11 }
8346 { CESU-8 csCESU-8 }
8347 { BOCU-1 csBOCU-1 }
8348 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8349 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8350 l8 }
8351 { ISO-8859-15 ISO_8859-15 Latin-9 }
8352 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8353 { GBK CP936 MS936 windows-936 }
8354 { JIS_Encoding csJISEncoding }
8355 { Shift_JIS MS_Kanji csShiftJIS }
8356 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8357 EUC-JP }
8358 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8359 { ISO-10646-UCS-Basic csUnicodeASCII }
8360 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8361 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8362 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8363 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8364 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8365 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8366 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8367 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8368 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8369 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8370 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8371 { Ventura-US csVenturaUS }
8372 { Ventura-International csVenturaInternational }
8373 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8374 { PC8-Turkish csPC8Turkish }
8375 { IBM-Symbols csIBMSymbols }
8376 { IBM-Thai csIBMThai }
8377 { HP-Legal csHPLegal }
8378 { HP-Pi-font csHPPiFont }
8379 { HP-Math8 csHPMath8 }
8380 { Adobe-Symbol-Encoding csHPPSMath }
8381 { HP-DeskTop csHPDesktop }
8382 { Ventura-Math csVenturaMath }
8383 { Microsoft-Publishing csMicrosoftPublishing }
8384 { Windows-31J csWindows31J }
8385 { GB2312 csGB2312 }
8386 { Big5 csBig5 }
8389 proc tcl_encoding {enc} {
8390 global encoding_aliases
8391 set names [encoding names]
8392 set lcnames [string tolower $names]
8393 set enc [string tolower $enc]
8394 set i [lsearch -exact $lcnames $enc]
8395 if {$i < 0} {
8396 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8397 if {[regsub {^iso[-_]} $enc iso encx]} {
8398 set i [lsearch -exact $lcnames $encx]
8401 if {$i < 0} {
8402 foreach l $encoding_aliases {
8403 set ll [string tolower $l]
8404 if {[lsearch -exact $ll $enc] < 0} continue
8405 # look through the aliases for one that tcl knows about
8406 foreach e $ll {
8407 set i [lsearch -exact $lcnames $e]
8408 if {$i < 0} {
8409 if {[regsub {^iso[-_]} $e iso ex]} {
8410 set i [lsearch -exact $lcnames $ex]
8413 if {$i >= 0} break
8415 break
8418 if {$i >= 0} {
8419 return [lindex $names $i]
8421 return {}
8424 # First check that Tcl/Tk is recent enough
8425 if {[catch {package require Tk 8.4} err]} {
8426 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8427 Gitk requires at least Tcl/Tk 8.4."]
8428 exit 1
8431 # defaults...
8432 set datemode 0
8433 set wrcomcmd "git diff-tree --stdin -p --pretty"
8435 set gitencoding {}
8436 catch {
8437 set gitencoding [exec git config --get i18n.commitencoding]
8439 if {$gitencoding == ""} {
8440 set gitencoding "utf-8"
8442 set tclencoding [tcl_encoding $gitencoding]
8443 if {$tclencoding == {}} {
8444 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8447 set mainfont {Helvetica 9}
8448 set textfont {Courier 9}
8449 set uifont {Helvetica 9 bold}
8450 set tabstop 8
8451 set findmergefiles 0
8452 set maxgraphpct 50
8453 set maxwidth 16
8454 set revlistorder 0
8455 set fastdate 0
8456 set uparrowlen 5
8457 set downarrowlen 5
8458 set mingaplen 100
8459 set cmitmode "patch"
8460 set wrapcomment "none"
8461 set showneartags 1
8462 set maxrefs 20
8463 set maxlinelen 200
8464 set showlocalchanges 1
8465 set limitdiffs 1
8466 set datetimeformat "%Y-%m-%d %H:%M:%S"
8468 set colors {green red blue magenta darkgrey brown orange}
8469 set bgcolor white
8470 set fgcolor black
8471 set diffcolors {red "#00a000" blue}
8472 set diffcontext 3
8473 set ignorespace 0
8474 set selectbgcolor gray85
8476 ## For msgcat loading, first locate the installation location.
8477 if { [info exists ::env(GITK_MSGSDIR)] } {
8478 ## Msgsdir was manually set in the environment.
8479 set gitk_msgsdir $::env(GITK_MSGSDIR)
8480 } else {
8481 ## Let's guess the prefix from argv0.
8482 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8483 set gitk_libdir [file join $gitk_prefix share gitk lib]
8484 set gitk_msgsdir [file join $gitk_libdir msgs]
8485 unset gitk_prefix
8488 ## Internationalization (i18n) through msgcat and gettext. See
8489 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8490 package require msgcat
8491 namespace import ::msgcat::mc
8492 ## And eventually load the actual message catalog
8493 ::msgcat::mcload $gitk_msgsdir
8495 catch {source ~/.gitk}
8497 font create optionfont -family sans-serif -size -12
8499 parsefont mainfont $mainfont
8500 eval font create mainfont [fontflags mainfont]
8501 eval font create mainfontbold [fontflags mainfont 1]
8503 parsefont textfont $textfont
8504 eval font create textfont [fontflags textfont]
8505 eval font create textfontbold [fontflags textfont 1]
8507 parsefont uifont $uifont
8508 eval font create uifont [fontflags uifont]
8510 setoptions
8512 # check that we can find a .git directory somewhere...
8513 if {[catch {set gitdir [gitdir]}]} {
8514 show_error {} . [mc "Cannot find a git repository here."]
8515 exit 1
8517 if {![file isdirectory $gitdir]} {
8518 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8519 exit 1
8522 set mergeonly 0
8523 set revtreeargs {}
8524 set cmdline_files {}
8525 set i 0
8526 foreach arg $argv {
8527 switch -- $arg {
8528 "" { }
8529 "-d" { set datemode 1 }
8530 "--merge" {
8531 set mergeonly 1
8532 lappend revtreeargs $arg
8534 "--" {
8535 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8536 break
8538 default {
8539 lappend revtreeargs $arg
8542 incr i
8545 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8546 # no -- on command line, but some arguments (other than -d)
8547 if {[catch {
8548 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8549 set cmdline_files [split $f "\n"]
8550 set n [llength $cmdline_files]
8551 set revtreeargs [lrange $revtreeargs 0 end-$n]
8552 # Unfortunately git rev-parse doesn't produce an error when
8553 # something is both a revision and a filename. To be consistent
8554 # with git log and git rev-list, check revtreeargs for filenames.
8555 foreach arg $revtreeargs {
8556 if {[file exists $arg]} {
8557 show_error {} . [mc "Ambiguous argument '%s': both revision\
8558 and filename" $arg]
8559 exit 1
8562 } err]} {
8563 # unfortunately we get both stdout and stderr in $err,
8564 # so look for "fatal:".
8565 set i [string first "fatal:" $err]
8566 if {$i > 0} {
8567 set err [string range $err [expr {$i + 6}] end]
8569 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8570 exit 1
8574 if {$mergeonly} {
8575 # find the list of unmerged files
8576 set mlist {}
8577 set nr_unmerged 0
8578 if {[catch {
8579 set fd [open "| git ls-files -u" r]
8580 } err]} {
8581 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8582 exit 1
8584 while {[gets $fd line] >= 0} {
8585 set i [string first "\t" $line]
8586 if {$i < 0} continue
8587 set fname [string range $line [expr {$i+1}] end]
8588 if {[lsearch -exact $mlist $fname] >= 0} continue
8589 incr nr_unmerged
8590 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8591 lappend mlist $fname
8594 catch {close $fd}
8595 if {$mlist eq {}} {
8596 if {$nr_unmerged == 0} {
8597 show_error {} . [mc "No files selected: --merge specified but\
8598 no files are unmerged."]
8599 } else {
8600 show_error {} . [mc "No files selected: --merge specified but\
8601 no unmerged files are within file limit."]
8603 exit 1
8605 set cmdline_files $mlist
8608 set nullid "0000000000000000000000000000000000000000"
8609 set nullid2 "0000000000000000000000000000000000000001"
8611 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8613 set runq {}
8614 set history {}
8615 set historyindex 0
8616 set fh_serial 0
8617 set nhl_names {}
8618 set highlight_paths {}
8619 set findpattern {}
8620 set searchdirn -forwards
8621 set boldrows {}
8622 set boldnamerows {}
8623 set diffelide {0 0}
8624 set markingmatches 0
8625 set linkentercount 0
8626 set need_redisplay 0
8627 set nrows_drawn 0
8628 set firsttabstop 0
8630 set nextviewnum 1
8631 set curview 0
8632 set selectedview 0
8633 set selectedhlview [mc "None"]
8634 set highlight_related [mc "None"]
8635 set highlight_files {}
8636 set viewfiles(0) {}
8637 set viewperm(0) 0
8638 set viewargs(0) {}
8640 set cmdlineok 0
8641 set stopped 0
8642 set stuffsaved 0
8643 set patchnum 0
8644 set localirow -1
8645 set localfrow -1
8646 set lserial 0
8647 setcoords
8648 makewindow
8649 # wait for the window to become visible
8650 tkwait visibility .
8651 wm title . "[file tail $argv0]: [file tail [pwd]]"
8652 readrefs
8654 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8655 # create a view for the files/dirs specified on the command line
8656 set curview 1
8657 set selectedview 1
8658 set nextviewnum 2
8659 set viewname(1) [mc "Command line"]
8660 set viewfiles(1) $cmdline_files
8661 set viewargs(1) $revtreeargs
8662 set viewperm(1) 0
8663 addviewmenu 1
8664 .bar.view entryconf [mc "Edit view..."] -state normal
8665 .bar.view entryconf [mc "Delete view"] -state normal
8668 if {[info exists permviews]} {
8669 foreach v $permviews {
8670 set n $nextviewnum
8671 incr nextviewnum
8672 set viewname($n) [lindex $v 0]
8673 set viewfiles($n) [lindex $v 1]
8674 set viewargs($n) [lindex $v 2]
8675 set viewperm($n) 1
8676 addviewmenu $n
8679 getcommits