gitk: Fix the Makefile to cope with systems lacking msgfmt
[git/mjg.git] / gitk
blob801a5a9d86d78b77811ef27b23cb37926c69f463
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}
249 set ids [string range $ids 1 end]
251 set ok 1
252 foreach id $ids {
253 if {[string length $id] != 40} {
254 set ok 0
255 break
259 if {!$ok} {
260 set shortcmit $cmit
261 if {[string length $shortcmit] > 80} {
262 set shortcmit "[string range $shortcmit 0 80]..."
264 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
265 exit 1
267 set id [lindex $ids 0]
268 if {![info exists ordertok($view,$id)]} {
269 set otok "o[strrep $vnextroot($view)]"
270 incr vnextroot($view)
271 set ordertok($view,$id) $otok
272 } else {
273 set otok $ordertok($view,$id)
274 unset idpending($view,$id)
276 if {$listed} {
277 set olds [lrange $ids 1 end]
278 if {[llength $olds] == 1} {
279 set p [lindex $olds 0]
280 lappend children($view,$p) $id
281 if {![info exists ordertok($view,$p)]} {
282 set ordertok($view,$p) $ordertok($view,$id)
283 set idpending($view,$p) 1
285 } else {
286 set i 0
287 foreach p $olds {
288 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
289 lappend children($view,$p) $id
291 if {![info exists ordertok($view,$p)]} {
292 set ordertok($view,$p) "$otok[strrep $i]]"
293 set idpending($view,$p) 1
295 incr i
298 } else {
299 set olds {}
301 if {![info exists children($view,$id)]} {
302 set children($view,$id) {}
304 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
305 set commitrow($view,$id) $commitidx($view)
306 incr commitidx($view)
307 if {$view == $curview} {
308 lappend parentlist $olds
309 lappend displayorder $id
310 lappend commitlisted $listed
311 } else {
312 lappend vparentlist($view) $olds
313 lappend vdisporder($view) $id
314 lappend vcmitlisted($view) $listed
316 if {[info exists commitinterest($id)]} {
317 foreach script $commitinterest($id) {
318 eval [string map [list "%I" $id] $script]
320 unset commitinterest($id)
322 set gotsome 1
324 if {$gotsome} {
325 run chewcommits $view
326 if {$view == $curview} {
327 # update progress bar
328 global progressdirn progresscoords proglastnc
329 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
330 set proglastnc $commitidx($view)
331 set l [lindex $progresscoords 0]
332 set r [lindex $progresscoords 1]
333 if {$progressdirn} {
334 set r [expr {$r + $inc}]
335 if {$r >= 1.0} {
336 set r 1.0
337 set progressdirn 0
339 if {$r > 0.2} {
340 set l [expr {$r - 0.2}]
342 } else {
343 set l [expr {$l - $inc}]
344 if {$l <= 0.0} {
345 set l 0.0
346 set progressdirn 1
348 set r [expr {$l + 0.2}]
350 set progresscoords [list $l $r]
351 adjustprogress
354 return 2
357 proc chewcommits {view} {
358 global curview hlview viewcomplete
359 global selectedline pending_select
361 if {$view == $curview} {
362 layoutmore
363 if {$viewcomplete($view)} {
364 global displayorder commitidx phase
365 global numcommits startmsecs
367 if {[info exists pending_select]} {
368 set row [first_real_row]
369 selectline $row 1
371 if {$commitidx($curview) > 0} {
372 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
373 #puts "overall $ms ms for $numcommits commits"
374 } else {
375 show_status [mc "No commits selected"]
377 notbusy layout
378 set phase {}
381 if {[info exists hlview] && $view == $hlview} {
382 vhighlightmore
384 return 0
387 proc readcommit {id} {
388 if {[catch {set contents [exec git cat-file commit $id]}]} return
389 parsecommit $id $contents 0
392 proc updatecommits {} {
393 global viewdata curview phase displayorder ordertok idpending
394 global children commitrow selectedline thickerline showneartags
396 if {$phase ne {}} {
397 stop_rev_list
398 set phase {}
400 set n $curview
401 foreach id $displayorder {
402 catch {unset children($n,$id)}
403 catch {unset commitrow($n,$id)}
404 catch {unset ordertok($n,$id)}
406 foreach vid [array names idpending "$n,*"] {
407 unset idpending($vid)
409 set curview -1
410 catch {unset selectedline}
411 catch {unset thickerline}
412 catch {unset viewdata($n)}
413 readrefs
414 changedrefs
415 if {$showneartags} {
416 getallcommits
418 showview $n
421 proc parsecommit {id contents listed} {
422 global commitinfo cdate
424 set inhdr 1
425 set comment {}
426 set headline {}
427 set auname {}
428 set audate {}
429 set comname {}
430 set comdate {}
431 set hdrend [string first "\n\n" $contents]
432 if {$hdrend < 0} {
433 # should never happen...
434 set hdrend [string length $contents]
436 set header [string range $contents 0 [expr {$hdrend - 1}]]
437 set comment [string range $contents [expr {$hdrend + 2}] end]
438 foreach line [split $header "\n"] {
439 set tag [lindex $line 0]
440 if {$tag == "author"} {
441 set audate [lindex $line end-1]
442 set auname [lrange $line 1 end-2]
443 } elseif {$tag == "committer"} {
444 set comdate [lindex $line end-1]
445 set comname [lrange $line 1 end-2]
448 set headline {}
449 # take the first non-blank line of the comment as the headline
450 set headline [string trimleft $comment]
451 set i [string first "\n" $headline]
452 if {$i >= 0} {
453 set headline [string range $headline 0 $i]
455 set headline [string trimright $headline]
456 set i [string first "\r" $headline]
457 if {$i >= 0} {
458 set headline [string trimright [string range $headline 0 $i]]
460 if {!$listed} {
461 # git rev-list indents the comment by 4 spaces;
462 # if we got this via git cat-file, add the indentation
463 set newcomment {}
464 foreach line [split $comment "\n"] {
465 append newcomment " "
466 append newcomment $line
467 append newcomment "\n"
469 set comment $newcomment
471 if {$comdate != {}} {
472 set cdate($id) $comdate
474 set commitinfo($id) [list $headline $auname $audate \
475 $comname $comdate $comment]
478 proc getcommit {id} {
479 global commitdata commitinfo
481 if {[info exists commitdata($id)]} {
482 parsecommit $id $commitdata($id) 1
483 } else {
484 readcommit $id
485 if {![info exists commitinfo($id)]} {
486 set commitinfo($id) [list [mc "No commit information available"]]
489 return 1
492 proc readrefs {} {
493 global tagids idtags headids idheads tagobjid
494 global otherrefids idotherrefs mainhead mainheadid
496 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
497 catch {unset $v}
499 set refd [open [list | git show-ref -d] r]
500 while {[gets $refd line] >= 0} {
501 if {[string index $line 40] ne " "} continue
502 set id [string range $line 0 39]
503 set ref [string range $line 41 end]
504 if {![string match "refs/*" $ref]} continue
505 set name [string range $ref 5 end]
506 if {[string match "remotes/*" $name]} {
507 if {![string match "*/HEAD" $name]} {
508 set headids($name) $id
509 lappend idheads($id) $name
511 } elseif {[string match "heads/*" $name]} {
512 set name [string range $name 6 end]
513 set headids($name) $id
514 lappend idheads($id) $name
515 } elseif {[string match "tags/*" $name]} {
516 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
517 # which is what we want since the former is the commit ID
518 set name [string range $name 5 end]
519 if {[string match "*^{}" $name]} {
520 set name [string range $name 0 end-3]
521 } else {
522 set tagobjid($name) $id
524 set tagids($name) $id
525 lappend idtags($id) $name
526 } else {
527 set otherrefids($name) $id
528 lappend idotherrefs($id) $name
531 catch {close $refd}
532 set mainhead {}
533 set mainheadid {}
534 catch {
535 set thehead [exec git symbolic-ref HEAD]
536 if {[string match "refs/heads/*" $thehead]} {
537 set mainhead [string range $thehead 11 end]
538 if {[info exists headids($mainhead)]} {
539 set mainheadid $headids($mainhead)
545 # skip over fake commits
546 proc first_real_row {} {
547 global nullid nullid2 displayorder numcommits
549 for {set row 0} {$row < $numcommits} {incr row} {
550 set id [lindex $displayorder $row]
551 if {$id ne $nullid && $id ne $nullid2} {
552 break
555 return $row
558 # update things for a head moved to a child of its previous location
559 proc movehead {id name} {
560 global headids idheads
562 removehead $headids($name) $name
563 set headids($name) $id
564 lappend idheads($id) $name
567 # update things when a head has been removed
568 proc removehead {id name} {
569 global headids idheads
571 if {$idheads($id) eq $name} {
572 unset idheads($id)
573 } else {
574 set i [lsearch -exact $idheads($id) $name]
575 if {$i >= 0} {
576 set idheads($id) [lreplace $idheads($id) $i $i]
579 unset headids($name)
582 proc show_error {w top msg} {
583 message $w.m -text $msg -justify center -aspect 400
584 pack $w.m -side top -fill x -padx 20 -pady 20
585 button $w.ok -text [mc OK] -command "destroy $top"
586 pack $w.ok -side bottom -fill x
587 bind $top <Visibility> "grab $top; focus $top"
588 bind $top <Key-Return> "destroy $top"
589 tkwait window $top
592 proc error_popup msg {
593 set w .error
594 toplevel $w
595 wm transient $w .
596 show_error $w $w $msg
599 proc confirm_popup msg {
600 global confirm_ok
601 set confirm_ok 0
602 set w .confirm
603 toplevel $w
604 wm transient $w .
605 message $w.m -text $msg -justify center -aspect 400
606 pack $w.m -side top -fill x -padx 20 -pady 20
607 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text [mc Cancel] -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
612 tkwait window $w
613 return $confirm_ok
616 proc setoptions {} {
617 option add *Panedwindow.showHandle 1 startupFile
618 option add *Panedwindow.sashRelief raised startupFile
619 option add *Button.font uifont startupFile
620 option add *Checkbutton.font uifont startupFile
621 option add *Radiobutton.font uifont startupFile
622 option add *Menu.font uifont startupFile
623 option add *Menubutton.font uifont startupFile
624 option add *Label.font uifont startupFile
625 option add *Message.font uifont startupFile
626 option add *Entry.font uifont startupFile
629 proc makewindow {} {
630 global canv canv2 canv3 linespc charspc ctext cflist
631 global tabstop
632 global findtype findtypemenu findloc findstring fstring geometry
633 global entries sha1entry sha1string sha1but
634 global diffcontextstring diffcontext
635 global maincursor textcursor curtextcursor
636 global rowctxmenu fakerowmenu mergemax wrapcomment
637 global highlight_files gdttype
638 global searchstring sstring
639 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
640 global headctxmenu progresscanv progressitem progresscoords statusw
641 global fprogitem fprogcoord lastprogupdate progupdatepending
642 global rprogitem rprogcoord
643 global have_tk85
645 menu .bar
646 .bar add cascade -label [mc "File"] -menu .bar.file
647 menu .bar.file
648 .bar.file add command -label [mc "Update"] -command updatecommits
649 .bar.file add command -label [mc "Reread references"] -command rereadrefs
650 .bar.file add command -label [mc "List references"] -command showrefs
651 .bar.file add command -label [mc "Quit"] -command doquit
652 menu .bar.edit
653 .bar add cascade -label [mc "Edit"] -menu .bar.edit
654 .bar.edit add command -label [mc "Preferences"] -command doprefs
656 menu .bar.view
657 .bar add cascade -label [mc "View"] -menu .bar.view
658 .bar.view add command -label [mc "New view..."] -command {newview 0}
659 .bar.view add command -label [mc "Edit view..."] -command editview \
660 -state disabled
661 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
662 .bar.view add separator
663 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
664 -variable selectedview -value 0
666 menu .bar.help
667 .bar add cascade -label [mc "Help"] -menu .bar.help
668 .bar.help add command -label [mc "About gitk"] -command about
669 .bar.help add command -label [mc "Key bindings"] -command keys
670 .bar.help configure
671 . configure -menu .bar
673 # the gui has upper and lower half, parts of a paned window.
674 panedwindow .ctop -orient vertical
676 # possibly use assumed geometry
677 if {![info exists geometry(pwsash0)]} {
678 set geometry(topheight) [expr {15 * $linespc}]
679 set geometry(topwidth) [expr {80 * $charspc}]
680 set geometry(botheight) [expr {15 * $linespc}]
681 set geometry(botwidth) [expr {50 * $charspc}]
682 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
683 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
686 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
687 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
688 frame .tf.histframe
689 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
691 # create three canvases
692 set cscroll .tf.histframe.csb
693 set canv .tf.histframe.pwclist.canv
694 canvas $canv \
695 -selectbackground $selectbgcolor \
696 -background $bgcolor -bd 0 \
697 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
698 .tf.histframe.pwclist add $canv
699 set canv2 .tf.histframe.pwclist.canv2
700 canvas $canv2 \
701 -selectbackground $selectbgcolor \
702 -background $bgcolor -bd 0 -yscrollincr $linespc
703 .tf.histframe.pwclist add $canv2
704 set canv3 .tf.histframe.pwclist.canv3
705 canvas $canv3 \
706 -selectbackground $selectbgcolor \
707 -background $bgcolor -bd 0 -yscrollincr $linespc
708 .tf.histframe.pwclist add $canv3
709 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
710 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
712 # a scroll bar to rule them
713 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
714 pack $cscroll -side right -fill y
715 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
716 lappend bglist $canv $canv2 $canv3
717 pack .tf.histframe.pwclist -fill both -expand 1 -side left
719 # we have two button bars at bottom of top frame. Bar 1
720 frame .tf.bar
721 frame .tf.lbar -height 15
723 set sha1entry .tf.bar.sha1
724 set entries $sha1entry
725 set sha1but .tf.bar.sha1label
726 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
727 -command gotocommit -width 8
728 $sha1but conf -disabledforeground [$sha1but cget -foreground]
729 pack .tf.bar.sha1label -side left
730 entry $sha1entry -width 40 -font textfont -textvariable sha1string
731 trace add variable sha1string write sha1change
732 pack $sha1entry -side left -pady 2
734 image create bitmap bm-left -data {
735 #define left_width 16
736 #define left_height 16
737 static unsigned char left_bits[] = {
738 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
739 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
740 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
742 image create bitmap bm-right -data {
743 #define right_width 16
744 #define right_height 16
745 static unsigned char right_bits[] = {
746 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
747 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
748 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
750 button .tf.bar.leftbut -image bm-left -command goback \
751 -state disabled -width 26
752 pack .tf.bar.leftbut -side left -fill y
753 button .tf.bar.rightbut -image bm-right -command goforw \
754 -state disabled -width 26
755 pack .tf.bar.rightbut -side left -fill y
757 # Status label and progress bar
758 set statusw .tf.bar.status
759 label $statusw -width 15 -relief sunken
760 pack $statusw -side left -padx 5
761 set h [expr {[font metrics uifont -linespace] + 2}]
762 set progresscanv .tf.bar.progress
763 canvas $progresscanv -relief sunken -height $h -borderwidth 2
764 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
765 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
766 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
767 pack $progresscanv -side right -expand 1 -fill x
768 set progresscoords {0 0}
769 set fprogcoord 0
770 set rprogcoord 0
771 bind $progresscanv <Configure> adjustprogress
772 set lastprogupdate [clock clicks -milliseconds]
773 set progupdatepending 0
775 # build up the bottom bar of upper window
776 label .tf.lbar.flabel -text "[mc "Find"] "
777 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
778 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
779 label .tf.lbar.flab2 -text " [mc "commit"] "
780 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
781 -side left -fill y
782 set gdttype [mc "containing:"]
783 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
784 [mc "containing:"] \
785 [mc "touching paths:"] \
786 [mc "adding/removing string:"]]
787 trace add variable gdttype write gdttype_change
788 pack .tf.lbar.gdttype -side left -fill y
790 set findstring {}
791 set fstring .tf.lbar.findstring
792 lappend entries $fstring
793 entry $fstring -width 30 -font textfont -textvariable findstring
794 trace add variable findstring write find_change
795 set findtype [mc "Exact"]
796 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
797 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
798 trace add variable findtype write findcom_change
799 set findloc [mc "All fields"]
800 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
801 [mc "Comments"] [mc "Author"] [mc "Committer"]
802 trace add variable findloc write find_change
803 pack .tf.lbar.findloc -side right
804 pack .tf.lbar.findtype -side right
805 pack $fstring -side left -expand 1 -fill x
807 # Finish putting the upper half of the viewer together
808 pack .tf.lbar -in .tf -side bottom -fill x
809 pack .tf.bar -in .tf -side bottom -fill x
810 pack .tf.histframe -fill both -side top -expand 1
811 .ctop add .tf
812 .ctop paneconfigure .tf -height $geometry(topheight)
813 .ctop paneconfigure .tf -width $geometry(topwidth)
815 # now build up the bottom
816 panedwindow .pwbottom -orient horizontal
818 # lower left, a text box over search bar, scroll bar to the right
819 # if we know window height, then that will set the lower text height, otherwise
820 # we set lower text height which will drive window height
821 if {[info exists geometry(main)]} {
822 frame .bleft -width $geometry(botwidth)
823 } else {
824 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
826 frame .bleft.top
827 frame .bleft.mid
829 button .bleft.top.search -text [mc "Search"] -command dosearch
830 pack .bleft.top.search -side left -padx 5
831 set sstring .bleft.top.sstring
832 entry $sstring -width 20 -font textfont -textvariable searchstring
833 lappend entries $sstring
834 trace add variable searchstring write incrsearch
835 pack $sstring -side left -expand 1 -fill x
836 radiobutton .bleft.mid.diff -text [mc "Diff"] \
837 -command changediffdisp -variable diffelide -value {0 0}
838 radiobutton .bleft.mid.old -text [mc "Old version"] \
839 -command changediffdisp -variable diffelide -value {0 1}
840 radiobutton .bleft.mid.new -text [mc "New version"] \
841 -command changediffdisp -variable diffelide -value {1 0}
842 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
843 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
844 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
845 -from 1 -increment 1 -to 10000000 \
846 -validate all -validatecommand "diffcontextvalidate %P" \
847 -textvariable diffcontextstring
848 .bleft.mid.diffcontext set $diffcontext
849 trace add variable diffcontextstring write diffcontextchange
850 lappend entries .bleft.mid.diffcontext
851 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
852 set ctext .bleft.ctext
853 text $ctext -background $bgcolor -foreground $fgcolor \
854 -state disabled -font textfont \
855 -yscrollcommand scrolltext -wrap none
856 if {$have_tk85} {
857 $ctext conf -tabstyle wordprocessor
859 scrollbar .bleft.sb -command "$ctext yview"
860 pack .bleft.top -side top -fill x
861 pack .bleft.mid -side top -fill x
862 pack .bleft.sb -side right -fill y
863 pack $ctext -side left -fill both -expand 1
864 lappend bglist $ctext
865 lappend fglist $ctext
867 $ctext tag conf comment -wrap $wrapcomment
868 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
869 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
870 $ctext tag conf d0 -fore [lindex $diffcolors 0]
871 $ctext tag conf d1 -fore [lindex $diffcolors 1]
872 $ctext tag conf m0 -fore red
873 $ctext tag conf m1 -fore blue
874 $ctext tag conf m2 -fore green
875 $ctext tag conf m3 -fore purple
876 $ctext tag conf m4 -fore brown
877 $ctext tag conf m5 -fore "#009090"
878 $ctext tag conf m6 -fore magenta
879 $ctext tag conf m7 -fore "#808000"
880 $ctext tag conf m8 -fore "#009000"
881 $ctext tag conf m9 -fore "#ff0080"
882 $ctext tag conf m10 -fore cyan
883 $ctext tag conf m11 -fore "#b07070"
884 $ctext tag conf m12 -fore "#70b0f0"
885 $ctext tag conf m13 -fore "#70f0b0"
886 $ctext tag conf m14 -fore "#f0b070"
887 $ctext tag conf m15 -fore "#ff70b0"
888 $ctext tag conf mmax -fore darkgrey
889 set mergemax 16
890 $ctext tag conf mresult -font textfontbold
891 $ctext tag conf msep -font textfontbold
892 $ctext tag conf found -back yellow
894 .pwbottom add .bleft
895 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
897 # lower right
898 frame .bright
899 frame .bright.mode
900 radiobutton .bright.mode.patch -text [mc "Patch"] \
901 -command reselectline -variable cmitmode -value "patch"
902 radiobutton .bright.mode.tree -text [mc "Tree"] \
903 -command reselectline -variable cmitmode -value "tree"
904 grid .bright.mode.patch .bright.mode.tree -sticky ew
905 pack .bright.mode -side top -fill x
906 set cflist .bright.cfiles
907 set indent [font measure mainfont "nn"]
908 text $cflist \
909 -selectbackground $selectbgcolor \
910 -background $bgcolor -foreground $fgcolor \
911 -font mainfont \
912 -tabs [list $indent [expr {2 * $indent}]] \
913 -yscrollcommand ".bright.sb set" \
914 -cursor [. cget -cursor] \
915 -spacing1 1 -spacing3 1
916 lappend bglist $cflist
917 lappend fglist $cflist
918 scrollbar .bright.sb -command "$cflist yview"
919 pack .bright.sb -side right -fill y
920 pack $cflist -side left -fill both -expand 1
921 $cflist tag configure highlight \
922 -background [$cflist cget -selectbackground]
923 $cflist tag configure bold -font mainfontbold
925 .pwbottom add .bright
926 .ctop add .pwbottom
928 # restore window position if known
929 if {[info exists geometry(main)]} {
930 wm geometry . "$geometry(main)"
933 if {[tk windowingsystem] eq {aqua}} {
934 set M1B M1
935 } else {
936 set M1B Control
939 bind .pwbottom <Configure> {resizecdetpanes %W %w}
940 pack .ctop -fill both -expand 1
941 bindall <1> {selcanvline %W %x %y}
942 #bindall <B1-Motion> {selcanvline %W %x %y}
943 if {[tk windowingsystem] == "win32"} {
944 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
945 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
946 } else {
947 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
948 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
949 if {[tk windowingsystem] eq "aqua"} {
950 bindall <MouseWheel> {
951 set delta [expr {- (%D)}]
952 allcanvs yview scroll $delta units
956 bindall <2> "canvscan mark %W %x %y"
957 bindall <B2-Motion> "canvscan dragto %W %x %y"
958 bindkey <Home> selfirstline
959 bindkey <End> sellastline
960 bind . <Key-Up> "selnextline -1"
961 bind . <Key-Down> "selnextline 1"
962 bind . <Shift-Key-Up> "dofind -1 0"
963 bind . <Shift-Key-Down> "dofind 1 0"
964 bindkey <Key-Right> "goforw"
965 bindkey <Key-Left> "goback"
966 bind . <Key-Prior> "selnextpage -1"
967 bind . <Key-Next> "selnextpage 1"
968 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
969 bind . <$M1B-End> "allcanvs yview moveto 1.0"
970 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
971 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
972 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
973 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
974 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
975 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
976 bindkey <Key-space> "$ctext yview scroll 1 pages"
977 bindkey p "selnextline -1"
978 bindkey n "selnextline 1"
979 bindkey z "goback"
980 bindkey x "goforw"
981 bindkey i "selnextline -1"
982 bindkey k "selnextline 1"
983 bindkey j "goback"
984 bindkey l "goforw"
985 bindkey b "$ctext yview scroll -1 pages"
986 bindkey d "$ctext yview scroll 18 units"
987 bindkey u "$ctext yview scroll -18 units"
988 bindkey / {dofind 1 1}
989 bindkey <Key-Return> {dofind 1 1}
990 bindkey ? {dofind -1 1}
991 bindkey f nextfile
992 bindkey <F5> updatecommits
993 bind . <$M1B-q> doquit
994 bind . <$M1B-f> {dofind 1 1}
995 bind . <$M1B-g> {dofind 1 0}
996 bind . <$M1B-r> dosearchback
997 bind . <$M1B-s> dosearch
998 bind . <$M1B-equal> {incrfont 1}
999 bind . <$M1B-KP_Add> {incrfont 1}
1000 bind . <$M1B-minus> {incrfont -1}
1001 bind . <$M1B-KP_Subtract> {incrfont -1}
1002 wm protocol . WM_DELETE_WINDOW doquit
1003 bind . <Button-1> "click %W"
1004 bind $fstring <Key-Return> {dofind 1 1}
1005 bind $sha1entry <Key-Return> gotocommit
1006 bind $sha1entry <<PasteSelection>> clearsha1
1007 bind $cflist <1> {sel_flist %W %x %y; break}
1008 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1009 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1010 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1012 set maincursor [. cget -cursor]
1013 set textcursor [$ctext cget -cursor]
1014 set curtextcursor $textcursor
1016 set rowctxmenu .rowctxmenu
1017 menu $rowctxmenu -tearoff 0
1018 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1019 -command {diffvssel 0}
1020 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1021 -command {diffvssel 1}
1022 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1023 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1024 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1025 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1026 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1027 -command cherrypick
1028 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1029 -command resethead
1031 set fakerowmenu .fakerowmenu
1032 menu $fakerowmenu -tearoff 0
1033 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1034 -command {diffvssel 0}
1035 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1036 -command {diffvssel 1}
1037 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1038 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1039 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1040 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1042 set headctxmenu .headctxmenu
1043 menu $headctxmenu -tearoff 0
1044 $headctxmenu add command -label [mc "Check out this branch"] \
1045 -command cobranch
1046 $headctxmenu add command -label [mc "Remove this branch"] \
1047 -command rmbranch
1049 global flist_menu
1050 set flist_menu .flistctxmenu
1051 menu $flist_menu -tearoff 0
1052 $flist_menu add command -label [mc "Highlight this too"] \
1053 -command {flist_hl 0}
1054 $flist_menu add command -label [mc "Highlight this only"] \
1055 -command {flist_hl 1}
1058 # Windows sends all mouse wheel events to the current focused window, not
1059 # the one where the mouse hovers, so bind those events here and redirect
1060 # to the correct window
1061 proc windows_mousewheel_redirector {W X Y D} {
1062 global canv canv2 canv3
1063 set w [winfo containing -displayof $W $X $Y]
1064 if {$w ne ""} {
1065 set u [expr {$D < 0 ? 5 : -5}]
1066 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1067 allcanvs yview scroll $u units
1068 } else {
1069 catch {
1070 $w yview scroll $u units
1076 # mouse-2 makes all windows scan vertically, but only the one
1077 # the cursor is in scans horizontally
1078 proc canvscan {op w x y} {
1079 global canv canv2 canv3
1080 foreach c [list $canv $canv2 $canv3] {
1081 if {$c == $w} {
1082 $c scan $op $x $y
1083 } else {
1084 $c scan $op 0 $y
1089 proc scrollcanv {cscroll f0 f1} {
1090 $cscroll set $f0 $f1
1091 drawfrac $f0 $f1
1092 flushhighlights
1095 # when we make a key binding for the toplevel, make sure
1096 # it doesn't get triggered when that key is pressed in the
1097 # find string entry widget.
1098 proc bindkey {ev script} {
1099 global entries
1100 bind . $ev $script
1101 set escript [bind Entry $ev]
1102 if {$escript == {}} {
1103 set escript [bind Entry <Key>]
1105 foreach e $entries {
1106 bind $e $ev "$escript; break"
1110 # set the focus back to the toplevel for any click outside
1111 # the entry widgets
1112 proc click {w} {
1113 global ctext entries
1114 foreach e [concat $entries $ctext] {
1115 if {$w == $e} return
1117 focus .
1120 # Adjust the progress bar for a change in requested extent or canvas size
1121 proc adjustprogress {} {
1122 global progresscanv progressitem progresscoords
1123 global fprogitem fprogcoord lastprogupdate progupdatepending
1124 global rprogitem rprogcoord
1126 set w [expr {[winfo width $progresscanv] - 4}]
1127 set x0 [expr {$w * [lindex $progresscoords 0]}]
1128 set x1 [expr {$w * [lindex $progresscoords 1]}]
1129 set h [winfo height $progresscanv]
1130 $progresscanv coords $progressitem $x0 0 $x1 $h
1131 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1132 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1133 set now [clock clicks -milliseconds]
1134 if {$now >= $lastprogupdate + 100} {
1135 set progupdatepending 0
1136 update
1137 } elseif {!$progupdatepending} {
1138 set progupdatepending 1
1139 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1143 proc doprogupdate {} {
1144 global lastprogupdate progupdatepending
1146 if {$progupdatepending} {
1147 set progupdatepending 0
1148 set lastprogupdate [clock clicks -milliseconds]
1149 update
1153 proc savestuff {w} {
1154 global canv canv2 canv3 mainfont textfont uifont tabstop
1155 global stuffsaved findmergefiles maxgraphpct
1156 global maxwidth showneartags showlocalchanges
1157 global viewname viewfiles viewargs viewperm nextviewnum
1158 global cmitmode wrapcomment datetimeformat limitdiffs
1159 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1161 if {$stuffsaved} return
1162 if {![winfo viewable .]} return
1163 catch {
1164 set f [open "~/.gitk-new" w]
1165 puts $f [list set mainfont $mainfont]
1166 puts $f [list set textfont $textfont]
1167 puts $f [list set uifont $uifont]
1168 puts $f [list set tabstop $tabstop]
1169 puts $f [list set findmergefiles $findmergefiles]
1170 puts $f [list set maxgraphpct $maxgraphpct]
1171 puts $f [list set maxwidth $maxwidth]
1172 puts $f [list set cmitmode $cmitmode]
1173 puts $f [list set wrapcomment $wrapcomment]
1174 puts $f [list set showneartags $showneartags]
1175 puts $f [list set showlocalchanges $showlocalchanges]
1176 puts $f [list set datetimeformat $datetimeformat]
1177 puts $f [list set limitdiffs $limitdiffs]
1178 puts $f [list set bgcolor $bgcolor]
1179 puts $f [list set fgcolor $fgcolor]
1180 puts $f [list set colors $colors]
1181 puts $f [list set diffcolors $diffcolors]
1182 puts $f [list set diffcontext $diffcontext]
1183 puts $f [list set selectbgcolor $selectbgcolor]
1185 puts $f "set geometry(main) [wm geometry .]"
1186 puts $f "set geometry(topwidth) [winfo width .tf]"
1187 puts $f "set geometry(topheight) [winfo height .tf]"
1188 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1189 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1190 puts $f "set geometry(botwidth) [winfo width .bleft]"
1191 puts $f "set geometry(botheight) [winfo height .bleft]"
1193 puts -nonewline $f "set permviews {"
1194 for {set v 0} {$v < $nextviewnum} {incr v} {
1195 if {$viewperm($v)} {
1196 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1199 puts $f "}"
1200 close $f
1201 file rename -force "~/.gitk-new" "~/.gitk"
1203 set stuffsaved 1
1206 proc resizeclistpanes {win w} {
1207 global oldwidth
1208 if {[info exists oldwidth($win)]} {
1209 set s0 [$win sash coord 0]
1210 set s1 [$win sash coord 1]
1211 if {$w < 60} {
1212 set sash0 [expr {int($w/2 - 2)}]
1213 set sash1 [expr {int($w*5/6 - 2)}]
1214 } else {
1215 set factor [expr {1.0 * $w / $oldwidth($win)}]
1216 set sash0 [expr {int($factor * [lindex $s0 0])}]
1217 set sash1 [expr {int($factor * [lindex $s1 0])}]
1218 if {$sash0 < 30} {
1219 set sash0 30
1221 if {$sash1 < $sash0 + 20} {
1222 set sash1 [expr {$sash0 + 20}]
1224 if {$sash1 > $w - 10} {
1225 set sash1 [expr {$w - 10}]
1226 if {$sash0 > $sash1 - 20} {
1227 set sash0 [expr {$sash1 - 20}]
1231 $win sash place 0 $sash0 [lindex $s0 1]
1232 $win sash place 1 $sash1 [lindex $s1 1]
1234 set oldwidth($win) $w
1237 proc resizecdetpanes {win w} {
1238 global oldwidth
1239 if {[info exists oldwidth($win)]} {
1240 set s0 [$win sash coord 0]
1241 if {$w < 60} {
1242 set sash0 [expr {int($w*3/4 - 2)}]
1243 } else {
1244 set factor [expr {1.0 * $w / $oldwidth($win)}]
1245 set sash0 [expr {int($factor * [lindex $s0 0])}]
1246 if {$sash0 < 45} {
1247 set sash0 45
1249 if {$sash0 > $w - 15} {
1250 set sash0 [expr {$w - 15}]
1253 $win sash place 0 $sash0 [lindex $s0 1]
1255 set oldwidth($win) $w
1258 proc allcanvs args {
1259 global canv canv2 canv3
1260 eval $canv $args
1261 eval $canv2 $args
1262 eval $canv3 $args
1265 proc bindall {event action} {
1266 global canv canv2 canv3
1267 bind $canv $event $action
1268 bind $canv2 $event $action
1269 bind $canv3 $event $action
1272 proc about {} {
1273 global uifont
1274 set w .about
1275 if {[winfo exists $w]} {
1276 raise $w
1277 return
1279 toplevel $w
1280 wm title $w [mc "About gitk"]
1281 message $w.m -text [mc "
1282 Gitk - a commit viewer for git
1284 Copyright © 2005-2006 Paul Mackerras
1286 Use and redistribute under the terms of the GNU General Public License"] \
1287 -justify center -aspect 400 -border 2 -bg white -relief groove
1288 pack $w.m -side top -fill x -padx 2 -pady 2
1289 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1290 pack $w.ok -side bottom
1291 bind $w <Visibility> "focus $w.ok"
1292 bind $w <Key-Escape> "destroy $w"
1293 bind $w <Key-Return> "destroy $w"
1296 proc keys {} {
1297 set w .keys
1298 if {[winfo exists $w]} {
1299 raise $w
1300 return
1302 if {[tk windowingsystem] eq {aqua}} {
1303 set M1T Cmd
1304 } else {
1305 set M1T Ctrl
1307 toplevel $w
1308 wm title $w [mc "Gitk key bindings"]
1309 message $w.m -text [mc "
1310 Gitk key bindings:
1312 <$M1T-Q> Quit
1313 <Home> Move to first commit
1314 <End> Move to last commit
1315 <Up>, p, i Move up one commit
1316 <Down>, n, k Move down one commit
1317 <Left>, z, j Go back in history list
1318 <Right>, x, l Go forward in history list
1319 <PageUp> Move up one page in commit list
1320 <PageDown> Move down one page in commit list
1321 <$M1T-Home> Scroll to top of commit list
1322 <$M1T-End> Scroll to bottom of commit list
1323 <$M1T-Up> Scroll commit list up one line
1324 <$M1T-Down> Scroll commit list down one line
1325 <$M1T-PageUp> Scroll commit list up one page
1326 <$M1T-PageDown> Scroll commit list down one page
1327 <Shift-Up> Find backwards (upwards, later commits)
1328 <Shift-Down> Find forwards (downwards, earlier commits)
1329 <Delete>, b Scroll diff view up one page
1330 <Backspace> Scroll diff view up one page
1331 <Space> Scroll diff view down one page
1332 u Scroll diff view up 18 lines
1333 d Scroll diff view down 18 lines
1334 <$M1T-F> Find
1335 <$M1T-G> Move to next find hit
1336 <Return> Move to next find hit
1337 / Move to next find hit, or redo find
1338 ? Move to previous find hit
1339 f Scroll diff view to next file
1340 <$M1T-S> Search for next hit in diff view
1341 <$M1T-R> Search for previous hit in diff view
1342 <$M1T-KP+> Increase font size
1343 <$M1T-plus> Increase font size
1344 <$M1T-KP-> Decrease font size
1345 <$M1T-minus> Decrease font size
1346 <F5> Update
1347 "] \
1348 -justify left -bg white -border 2 -relief groove
1349 pack $w.m -side top -fill both -padx 2 -pady 2
1350 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1351 pack $w.ok -side bottom
1352 bind $w <Visibility> "focus $w.ok"
1353 bind $w <Key-Escape> "destroy $w"
1354 bind $w <Key-Return> "destroy $w"
1357 # Procedures for manipulating the file list window at the
1358 # bottom right of the overall window.
1360 proc treeview {w l openlevs} {
1361 global treecontents treediropen treeheight treeparent treeindex
1363 set ix 0
1364 set treeindex() 0
1365 set lev 0
1366 set prefix {}
1367 set prefixend -1
1368 set prefendstack {}
1369 set htstack {}
1370 set ht 0
1371 set treecontents() {}
1372 $w conf -state normal
1373 foreach f $l {
1374 while {[string range $f 0 $prefixend] ne $prefix} {
1375 if {$lev <= $openlevs} {
1376 $w mark set e:$treeindex($prefix) "end -1c"
1377 $w mark gravity e:$treeindex($prefix) left
1379 set treeheight($prefix) $ht
1380 incr ht [lindex $htstack end]
1381 set htstack [lreplace $htstack end end]
1382 set prefixend [lindex $prefendstack end]
1383 set prefendstack [lreplace $prefendstack end end]
1384 set prefix [string range $prefix 0 $prefixend]
1385 incr lev -1
1387 set tail [string range $f [expr {$prefixend+1}] end]
1388 while {[set slash [string first "/" $tail]] >= 0} {
1389 lappend htstack $ht
1390 set ht 0
1391 lappend prefendstack $prefixend
1392 incr prefixend [expr {$slash + 1}]
1393 set d [string range $tail 0 $slash]
1394 lappend treecontents($prefix) $d
1395 set oldprefix $prefix
1396 append prefix $d
1397 set treecontents($prefix) {}
1398 set treeindex($prefix) [incr ix]
1399 set treeparent($prefix) $oldprefix
1400 set tail [string range $tail [expr {$slash+1}] end]
1401 if {$lev <= $openlevs} {
1402 set ht 1
1403 set treediropen($prefix) [expr {$lev < $openlevs}]
1404 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1405 $w mark set d:$ix "end -1c"
1406 $w mark gravity d:$ix left
1407 set str "\n"
1408 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1409 $w insert end $str
1410 $w image create end -align center -image $bm -padx 1 \
1411 -name a:$ix
1412 $w insert end $d [highlight_tag $prefix]
1413 $w mark set s:$ix "end -1c"
1414 $w mark gravity s:$ix left
1416 incr lev
1418 if {$tail ne {}} {
1419 if {$lev <= $openlevs} {
1420 incr ht
1421 set str "\n"
1422 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1423 $w insert end $str
1424 $w insert end $tail [highlight_tag $f]
1426 lappend treecontents($prefix) $tail
1429 while {$htstack ne {}} {
1430 set treeheight($prefix) $ht
1431 incr ht [lindex $htstack end]
1432 set htstack [lreplace $htstack end end]
1433 set prefixend [lindex $prefendstack end]
1434 set prefendstack [lreplace $prefendstack end end]
1435 set prefix [string range $prefix 0 $prefixend]
1437 $w conf -state disabled
1440 proc linetoelt {l} {
1441 global treeheight treecontents
1443 set y 2
1444 set prefix {}
1445 while {1} {
1446 foreach e $treecontents($prefix) {
1447 if {$y == $l} {
1448 return "$prefix$e"
1450 set n 1
1451 if {[string index $e end] eq "/"} {
1452 set n $treeheight($prefix$e)
1453 if {$y + $n > $l} {
1454 append prefix $e
1455 incr y
1456 break
1459 incr y $n
1464 proc highlight_tree {y prefix} {
1465 global treeheight treecontents cflist
1467 foreach e $treecontents($prefix) {
1468 set path $prefix$e
1469 if {[highlight_tag $path] ne {}} {
1470 $cflist tag add bold $y.0 "$y.0 lineend"
1472 incr y
1473 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1474 set y [highlight_tree $y $path]
1477 return $y
1480 proc treeclosedir {w dir} {
1481 global treediropen treeheight treeparent treeindex
1483 set ix $treeindex($dir)
1484 $w conf -state normal
1485 $w delete s:$ix e:$ix
1486 set treediropen($dir) 0
1487 $w image configure a:$ix -image tri-rt
1488 $w conf -state disabled
1489 set n [expr {1 - $treeheight($dir)}]
1490 while {$dir ne {}} {
1491 incr treeheight($dir) $n
1492 set dir $treeparent($dir)
1496 proc treeopendir {w dir} {
1497 global treediropen treeheight treeparent treecontents treeindex
1499 set ix $treeindex($dir)
1500 $w conf -state normal
1501 $w image configure a:$ix -image tri-dn
1502 $w mark set e:$ix s:$ix
1503 $w mark gravity e:$ix right
1504 set lev 0
1505 set str "\n"
1506 set n [llength $treecontents($dir)]
1507 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1508 incr lev
1509 append str "\t"
1510 incr treeheight($x) $n
1512 foreach e $treecontents($dir) {
1513 set de $dir$e
1514 if {[string index $e end] eq "/"} {
1515 set iy $treeindex($de)
1516 $w mark set d:$iy e:$ix
1517 $w mark gravity d:$iy left
1518 $w insert e:$ix $str
1519 set treediropen($de) 0
1520 $w image create e:$ix -align center -image tri-rt -padx 1 \
1521 -name a:$iy
1522 $w insert e:$ix $e [highlight_tag $de]
1523 $w mark set s:$iy e:$ix
1524 $w mark gravity s:$iy left
1525 set treeheight($de) 1
1526 } else {
1527 $w insert e:$ix $str
1528 $w insert e:$ix $e [highlight_tag $de]
1531 $w mark gravity e:$ix left
1532 $w conf -state disabled
1533 set treediropen($dir) 1
1534 set top [lindex [split [$w index @0,0] .] 0]
1535 set ht [$w cget -height]
1536 set l [lindex [split [$w index s:$ix] .] 0]
1537 if {$l < $top} {
1538 $w yview $l.0
1539 } elseif {$l + $n + 1 > $top + $ht} {
1540 set top [expr {$l + $n + 2 - $ht}]
1541 if {$l < $top} {
1542 set top $l
1544 $w yview $top.0
1548 proc treeclick {w x y} {
1549 global treediropen cmitmode ctext cflist cflist_top
1551 if {$cmitmode ne "tree"} return
1552 if {![info exists cflist_top]} return
1553 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1554 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1555 $cflist tag add highlight $l.0 "$l.0 lineend"
1556 set cflist_top $l
1557 if {$l == 1} {
1558 $ctext yview 1.0
1559 return
1561 set e [linetoelt $l]
1562 if {[string index $e end] ne "/"} {
1563 showfile $e
1564 } elseif {$treediropen($e)} {
1565 treeclosedir $w $e
1566 } else {
1567 treeopendir $w $e
1571 proc setfilelist {id} {
1572 global treefilelist cflist
1574 treeview $cflist $treefilelist($id) 0
1577 image create bitmap tri-rt -background black -foreground blue -data {
1578 #define tri-rt_width 13
1579 #define tri-rt_height 13
1580 static unsigned char tri-rt_bits[] = {
1581 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1582 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1583 0x00, 0x00};
1584 } -maskdata {
1585 #define tri-rt-mask_width 13
1586 #define tri-rt-mask_height 13
1587 static unsigned char tri-rt-mask_bits[] = {
1588 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1589 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1590 0x08, 0x00};
1592 image create bitmap tri-dn -background black -foreground blue -data {
1593 #define tri-dn_width 13
1594 #define tri-dn_height 13
1595 static unsigned char tri-dn_bits[] = {
1596 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1597 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1598 0x00, 0x00};
1599 } -maskdata {
1600 #define tri-dn-mask_width 13
1601 #define tri-dn-mask_height 13
1602 static unsigned char tri-dn-mask_bits[] = {
1603 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1604 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1605 0x00, 0x00};
1608 image create bitmap reficon-T -background black -foreground yellow -data {
1609 #define tagicon_width 13
1610 #define tagicon_height 9
1611 static unsigned char tagicon_bits[] = {
1612 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1613 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1614 } -maskdata {
1615 #define tagicon-mask_width 13
1616 #define tagicon-mask_height 9
1617 static unsigned char tagicon-mask_bits[] = {
1618 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1619 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1621 set rectdata {
1622 #define headicon_width 13
1623 #define headicon_height 9
1624 static unsigned char headicon_bits[] = {
1625 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1626 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1628 set rectmask {
1629 #define headicon-mask_width 13
1630 #define headicon-mask_height 9
1631 static unsigned char headicon-mask_bits[] = {
1632 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1633 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1635 image create bitmap reficon-H -background black -foreground green \
1636 -data $rectdata -maskdata $rectmask
1637 image create bitmap reficon-o -background black -foreground "#ddddff" \
1638 -data $rectdata -maskdata $rectmask
1640 proc init_flist {first} {
1641 global cflist cflist_top selectedline difffilestart
1643 $cflist conf -state normal
1644 $cflist delete 0.0 end
1645 if {$first ne {}} {
1646 $cflist insert end $first
1647 set cflist_top 1
1648 $cflist tag add highlight 1.0 "1.0 lineend"
1649 } else {
1650 catch {unset cflist_top}
1652 $cflist conf -state disabled
1653 set difffilestart {}
1656 proc highlight_tag {f} {
1657 global highlight_paths
1659 foreach p $highlight_paths {
1660 if {[string match $p $f]} {
1661 return "bold"
1664 return {}
1667 proc highlight_filelist {} {
1668 global cmitmode cflist
1670 $cflist conf -state normal
1671 if {$cmitmode ne "tree"} {
1672 set end [lindex [split [$cflist index end] .] 0]
1673 for {set l 2} {$l < $end} {incr l} {
1674 set line [$cflist get $l.0 "$l.0 lineend"]
1675 if {[highlight_tag $line] ne {}} {
1676 $cflist tag add bold $l.0 "$l.0 lineend"
1679 } else {
1680 highlight_tree 2 {}
1682 $cflist conf -state disabled
1685 proc unhighlight_filelist {} {
1686 global cflist
1688 $cflist conf -state normal
1689 $cflist tag remove bold 1.0 end
1690 $cflist conf -state disabled
1693 proc add_flist {fl} {
1694 global cflist
1696 $cflist conf -state normal
1697 foreach f $fl {
1698 $cflist insert end "\n"
1699 $cflist insert end $f [highlight_tag $f]
1701 $cflist conf -state disabled
1704 proc sel_flist {w x y} {
1705 global ctext difffilestart cflist cflist_top cmitmode
1707 if {$cmitmode eq "tree"} return
1708 if {![info exists cflist_top]} return
1709 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1710 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1711 $cflist tag add highlight $l.0 "$l.0 lineend"
1712 set cflist_top $l
1713 if {$l == 1} {
1714 $ctext yview 1.0
1715 } else {
1716 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1720 proc pop_flist_menu {w X Y x y} {
1721 global ctext cflist cmitmode flist_menu flist_menu_file
1722 global treediffs diffids
1724 stopfinding
1725 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1726 if {$l <= 1} return
1727 if {$cmitmode eq "tree"} {
1728 set e [linetoelt $l]
1729 if {[string index $e end] eq "/"} return
1730 } else {
1731 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1733 set flist_menu_file $e
1734 tk_popup $flist_menu $X $Y
1737 proc flist_hl {only} {
1738 global flist_menu_file findstring gdttype
1740 set x [shellquote $flist_menu_file]
1741 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1742 set findstring $x
1743 } else {
1744 append findstring " " $x
1746 set gdttype [mc "touching paths:"]
1749 # Functions for adding and removing shell-type quoting
1751 proc shellquote {str} {
1752 if {![string match "*\['\"\\ \t]*" $str]} {
1753 return $str
1755 if {![string match "*\['\"\\]*" $str]} {
1756 return "\"$str\""
1758 if {![string match "*'*" $str]} {
1759 return "'$str'"
1761 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1764 proc shellarglist {l} {
1765 set str {}
1766 foreach a $l {
1767 if {$str ne {}} {
1768 append str " "
1770 append str [shellquote $a]
1772 return $str
1775 proc shelldequote {str} {
1776 set ret {}
1777 set used -1
1778 while {1} {
1779 incr used
1780 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1781 append ret [string range $str $used end]
1782 set used [string length $str]
1783 break
1785 set first [lindex $first 0]
1786 set ch [string index $str $first]
1787 if {$first > $used} {
1788 append ret [string range $str $used [expr {$first - 1}]]
1789 set used $first
1791 if {$ch eq " " || $ch eq "\t"} break
1792 incr used
1793 if {$ch eq "'"} {
1794 set first [string first "'" $str $used]
1795 if {$first < 0} {
1796 error "unmatched single-quote"
1798 append ret [string range $str $used [expr {$first - 1}]]
1799 set used $first
1800 continue
1802 if {$ch eq "\\"} {
1803 if {$used >= [string length $str]} {
1804 error "trailing backslash"
1806 append ret [string index $str $used]
1807 continue
1809 # here ch == "\""
1810 while {1} {
1811 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1812 error "unmatched double-quote"
1814 set first [lindex $first 0]
1815 set ch [string index $str $first]
1816 if {$first > $used} {
1817 append ret [string range $str $used [expr {$first - 1}]]
1818 set used $first
1820 if {$ch eq "\""} break
1821 incr used
1822 append ret [string index $str $used]
1823 incr used
1826 return [list $used $ret]
1829 proc shellsplit {str} {
1830 set l {}
1831 while {1} {
1832 set str [string trimleft $str]
1833 if {$str eq {}} break
1834 set dq [shelldequote $str]
1835 set n [lindex $dq 0]
1836 set word [lindex $dq 1]
1837 set str [string range $str $n end]
1838 lappend l $word
1840 return $l
1843 # Code to implement multiple views
1845 proc newview {ishighlight} {
1846 global nextviewnum newviewname newviewperm newishighlight
1847 global newviewargs revtreeargs
1849 set newishighlight $ishighlight
1850 set top .gitkview
1851 if {[winfo exists $top]} {
1852 raise $top
1853 return
1855 set newviewname($nextviewnum) "View $nextviewnum"
1856 set newviewperm($nextviewnum) 0
1857 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1858 vieweditor $top $nextviewnum [mc "Gitk view definition"]
1861 proc editview {} {
1862 global curview
1863 global viewname viewperm newviewname newviewperm
1864 global viewargs newviewargs
1866 set top .gitkvedit-$curview
1867 if {[winfo exists $top]} {
1868 raise $top
1869 return
1871 set newviewname($curview) $viewname($curview)
1872 set newviewperm($curview) $viewperm($curview)
1873 set newviewargs($curview) [shellarglist $viewargs($curview)]
1874 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1877 proc vieweditor {top n title} {
1878 global newviewname newviewperm viewfiles bgcolor
1880 toplevel $top
1881 wm title $top $title
1882 label $top.nl -text [mc "Name"]
1883 entry $top.name -width 20 -textvariable newviewname($n)
1884 grid $top.nl $top.name -sticky w -pady 5
1885 checkbutton $top.perm -text [mc "Remember this view"] \
1886 -variable newviewperm($n)
1887 grid $top.perm - -pady 5 -sticky w
1888 message $top.al -aspect 1000 \
1889 -text [mc "Commits to include (arguments to git rev-list):"]
1890 grid $top.al - -sticky w -pady 5
1891 entry $top.args -width 50 -textvariable newviewargs($n) \
1892 -background $bgcolor
1893 grid $top.args - -sticky ew -padx 5
1894 message $top.l -aspect 1000 \
1895 -text [mc "Enter files and directories to include, one per line:"]
1896 grid $top.l - -sticky w
1897 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1898 if {[info exists viewfiles($n)]} {
1899 foreach f $viewfiles($n) {
1900 $top.t insert end $f
1901 $top.t insert end "\n"
1903 $top.t delete {end - 1c} end
1904 $top.t mark set insert 0.0
1906 grid $top.t - -sticky ew -padx 5
1907 frame $top.buts
1908 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1909 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1910 grid $top.buts.ok $top.buts.can
1911 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1912 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1913 grid $top.buts - -pady 10 -sticky ew
1914 focus $top.t
1917 proc doviewmenu {m first cmd op argv} {
1918 set nmenu [$m index end]
1919 for {set i $first} {$i <= $nmenu} {incr i} {
1920 if {[$m entrycget $i -command] eq $cmd} {
1921 eval $m $op $i $argv
1922 break
1927 proc allviewmenus {n op args} {
1928 # global viewhlmenu
1930 doviewmenu .bar.view 5 [list showview $n] $op $args
1931 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1934 proc newviewok {top n} {
1935 global nextviewnum newviewperm newviewname newishighlight
1936 global viewname viewfiles viewperm selectedview curview
1937 global viewargs newviewargs viewhlmenu
1939 if {[catch {
1940 set newargs [shellsplit $newviewargs($n)]
1941 } err]} {
1942 error_popup "[mc "Error in commit selection arguments:"] $err"
1943 wm raise $top
1944 focus $top
1945 return
1947 set files {}
1948 foreach f [split [$top.t get 0.0 end] "\n"] {
1949 set ft [string trim $f]
1950 if {$ft ne {}} {
1951 lappend files $ft
1954 if {![info exists viewfiles($n)]} {
1955 # creating a new view
1956 incr nextviewnum
1957 set viewname($n) $newviewname($n)
1958 set viewperm($n) $newviewperm($n)
1959 set viewfiles($n) $files
1960 set viewargs($n) $newargs
1961 addviewmenu $n
1962 if {!$newishighlight} {
1963 run showview $n
1964 } else {
1965 run addvhighlight $n
1967 } else {
1968 # editing an existing view
1969 set viewperm($n) $newviewperm($n)
1970 if {$newviewname($n) ne $viewname($n)} {
1971 set viewname($n) $newviewname($n)
1972 doviewmenu .bar.view 5 [list showview $n] \
1973 entryconf [list -label $viewname($n)]
1974 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1975 # entryconf [list -label $viewname($n) -value $viewname($n)]
1977 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1978 set viewfiles($n) $files
1979 set viewargs($n) $newargs
1980 if {$curview == $n} {
1981 run updatecommits
1985 catch {destroy $top}
1988 proc delview {} {
1989 global curview viewdata viewperm hlview selectedhlview
1991 if {$curview == 0} return
1992 if {[info exists hlview] && $hlview == $curview} {
1993 set selectedhlview [mc "None"]
1994 unset hlview
1996 allviewmenus $curview delete
1997 set viewdata($curview) {}
1998 set viewperm($curview) 0
1999 showview 0
2002 proc addviewmenu {n} {
2003 global viewname viewhlmenu
2005 .bar.view add radiobutton -label $viewname($n) \
2006 -command [list showview $n] -variable selectedview -value $n
2007 #$viewhlmenu add radiobutton -label $viewname($n) \
2008 # -command [list addvhighlight $n] -variable selectedhlview
2011 proc flatten {var} {
2012 global $var
2014 set ret {}
2015 foreach i [array names $var] {
2016 lappend ret $i [set $var\($i\)]
2018 return $ret
2021 proc unflatten {var l} {
2022 global $var
2024 catch {unset $var}
2025 foreach {i v} $l {
2026 set $var\($i\) $v
2030 proc showview {n} {
2031 global curview viewdata viewfiles
2032 global displayorder parentlist rowidlist rowisopt rowfinal
2033 global colormap rowtextx commitrow nextcolor canvxmax
2034 global numcommits commitlisted
2035 global selectedline currentid canv canvy0
2036 global treediffs
2037 global pending_select phase
2038 global commitidx
2039 global commfd
2040 global selectedview selectfirst
2041 global vparentlist vdisporder vcmitlisted
2042 global hlview selectedhlview commitinterest
2044 if {$n == $curview} return
2045 set selid {}
2046 if {[info exists selectedline]} {
2047 set selid $currentid
2048 set y [yc $selectedline]
2049 set ymax [lindex [$canv cget -scrollregion] 3]
2050 set span [$canv yview]
2051 set ytop [expr {[lindex $span 0] * $ymax}]
2052 set ybot [expr {[lindex $span 1] * $ymax}]
2053 if {$ytop < $y && $y < $ybot} {
2054 set yscreen [expr {$y - $ytop}]
2055 } else {
2056 set yscreen [expr {($ybot - $ytop) / 2}]
2058 } elseif {[info exists pending_select]} {
2059 set selid $pending_select
2060 unset pending_select
2062 unselectline
2063 normalline
2064 if {$curview >= 0} {
2065 set vparentlist($curview) $parentlist
2066 set vdisporder($curview) $displayorder
2067 set vcmitlisted($curview) $commitlisted
2068 if {$phase ne {} ||
2069 ![info exists viewdata($curview)] ||
2070 [lindex $viewdata($curview) 0] ne {}} {
2071 set viewdata($curview) \
2072 [list $phase $rowidlist $rowisopt $rowfinal]
2075 catch {unset treediffs}
2076 clear_display
2077 if {[info exists hlview] && $hlview == $n} {
2078 unset hlview
2079 set selectedhlview [mc "None"]
2081 catch {unset commitinterest}
2083 set curview $n
2084 set selectedview $n
2085 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2086 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2088 run refill_reflist
2089 if {![info exists viewdata($n)]} {
2090 if {$selid ne {}} {
2091 set pending_select $selid
2093 getcommits
2094 return
2097 set v $viewdata($n)
2098 set phase [lindex $v 0]
2099 set displayorder $vdisporder($n)
2100 set parentlist $vparentlist($n)
2101 set commitlisted $vcmitlisted($n)
2102 set rowidlist [lindex $v 1]
2103 set rowisopt [lindex $v 2]
2104 set rowfinal [lindex $v 3]
2105 set numcommits $commitidx($n)
2107 catch {unset colormap}
2108 catch {unset rowtextx}
2109 set nextcolor 0
2110 set canvxmax [$canv cget -width]
2111 set curview $n
2112 set row 0
2113 setcanvscroll
2114 set yf 0
2115 set row {}
2116 set selectfirst 0
2117 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2118 set row $commitrow($n,$selid)
2119 # try to get the selected row in the same position on the screen
2120 set ymax [lindex [$canv cget -scrollregion] 3]
2121 set ytop [expr {[yc $row] - $yscreen}]
2122 if {$ytop < 0} {
2123 set ytop 0
2125 set yf [expr {$ytop * 1.0 / $ymax}]
2127 allcanvs yview moveto $yf
2128 drawvisible
2129 if {$row ne {}} {
2130 selectline $row 0
2131 } elseif {$selid ne {}} {
2132 set pending_select $selid
2133 } else {
2134 set row [first_real_row]
2135 if {$row < $numcommits} {
2136 selectline $row 0
2137 } else {
2138 set selectfirst 1
2141 if {$phase ne {}} {
2142 if {$phase eq "getcommits"} {
2143 show_status [mc "Reading commits..."]
2145 run chewcommits $n
2146 } elseif {$numcommits == 0} {
2147 show_status [mc "No commits selected"]
2151 # Stuff relating to the highlighting facility
2153 proc ishighlighted {row} {
2154 global vhighlights fhighlights nhighlights rhighlights
2156 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2157 return $nhighlights($row)
2159 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2160 return $vhighlights($row)
2162 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2163 return $fhighlights($row)
2165 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2166 return $rhighlights($row)
2168 return 0
2171 proc bolden {row font} {
2172 global canv linehtag selectedline boldrows
2174 lappend boldrows $row
2175 $canv itemconf $linehtag($row) -font $font
2176 if {[info exists selectedline] && $row == $selectedline} {
2177 $canv delete secsel
2178 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2179 -outline {{}} -tags secsel \
2180 -fill [$canv cget -selectbackground]]
2181 $canv lower $t
2185 proc bolden_name {row font} {
2186 global canv2 linentag selectedline boldnamerows
2188 lappend boldnamerows $row
2189 $canv2 itemconf $linentag($row) -font $font
2190 if {[info exists selectedline] && $row == $selectedline} {
2191 $canv2 delete secsel
2192 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2193 -outline {{}} -tags secsel \
2194 -fill [$canv2 cget -selectbackground]]
2195 $canv2 lower $t
2199 proc unbolden {} {
2200 global boldrows
2202 set stillbold {}
2203 foreach row $boldrows {
2204 if {![ishighlighted $row]} {
2205 bolden $row mainfont
2206 } else {
2207 lappend stillbold $row
2210 set boldrows $stillbold
2213 proc addvhighlight {n} {
2214 global hlview curview viewdata vhl_done vhighlights commitidx
2216 if {[info exists hlview]} {
2217 delvhighlight
2219 set hlview $n
2220 if {$n != $curview && ![info exists viewdata($n)]} {
2221 set viewdata($n) [list getcommits {{}} 0 0 0]
2222 set vparentlist($n) {}
2223 set vdisporder($n) {}
2224 set vcmitlisted($n) {}
2225 start_rev_list $n
2227 set vhl_done $commitidx($hlview)
2228 if {$vhl_done > 0} {
2229 drawvisible
2233 proc delvhighlight {} {
2234 global hlview vhighlights
2236 if {![info exists hlview]} return
2237 unset hlview
2238 catch {unset vhighlights}
2239 unbolden
2242 proc vhighlightmore {} {
2243 global hlview vhl_done commitidx vhighlights
2244 global displayorder vdisporder curview
2246 set max $commitidx($hlview)
2247 if {$hlview == $curview} {
2248 set disp $displayorder
2249 } else {
2250 set disp $vdisporder($hlview)
2252 set vr [visiblerows]
2253 set r0 [lindex $vr 0]
2254 set r1 [lindex $vr 1]
2255 for {set i $vhl_done} {$i < $max} {incr i} {
2256 set id [lindex $disp $i]
2257 if {[info exists commitrow($curview,$id)]} {
2258 set row $commitrow($curview,$id)
2259 if {$r0 <= $row && $row <= $r1} {
2260 if {![highlighted $row]} {
2261 bolden $row mainfontbold
2263 set vhighlights($row) 1
2267 set vhl_done $max
2270 proc askvhighlight {row id} {
2271 global hlview vhighlights commitrow iddrawn
2273 if {[info exists commitrow($hlview,$id)]} {
2274 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2275 bolden $row mainfontbold
2277 set vhighlights($row) 1
2278 } else {
2279 set vhighlights($row) 0
2283 proc hfiles_change {} {
2284 global highlight_files filehighlight fhighlights fh_serial
2285 global highlight_paths gdttype
2287 if {[info exists filehighlight]} {
2288 # delete previous highlights
2289 catch {close $filehighlight}
2290 unset filehighlight
2291 catch {unset fhighlights}
2292 unbolden
2293 unhighlight_filelist
2295 set highlight_paths {}
2296 after cancel do_file_hl $fh_serial
2297 incr fh_serial
2298 if {$highlight_files ne {}} {
2299 after 300 do_file_hl $fh_serial
2303 proc gdttype_change {name ix op} {
2304 global gdttype highlight_files findstring findpattern
2306 stopfinding
2307 if {$findstring ne {}} {
2308 if {$gdttype eq [mc "containing:"]} {
2309 if {$highlight_files ne {}} {
2310 set highlight_files {}
2311 hfiles_change
2313 findcom_change
2314 } else {
2315 if {$findpattern ne {}} {
2316 set findpattern {}
2317 findcom_change
2319 set highlight_files $findstring
2320 hfiles_change
2322 drawvisible
2324 # enable/disable findtype/findloc menus too
2327 proc find_change {name ix op} {
2328 global gdttype findstring highlight_files
2330 stopfinding
2331 if {$gdttype eq [mc "containing:"]} {
2332 findcom_change
2333 } else {
2334 if {$highlight_files ne $findstring} {
2335 set highlight_files $findstring
2336 hfiles_change
2339 drawvisible
2342 proc findcom_change args {
2343 global nhighlights boldnamerows
2344 global findpattern findtype findstring gdttype
2346 stopfinding
2347 # delete previous highlights, if any
2348 foreach row $boldnamerows {
2349 bolden_name $row mainfont
2351 set boldnamerows {}
2352 catch {unset nhighlights}
2353 unbolden
2354 unmarkmatches
2355 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2356 set findpattern {}
2357 } elseif {$findtype eq [mc "Regexp"]} {
2358 set findpattern $findstring
2359 } else {
2360 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2361 $findstring]
2362 set findpattern "*$e*"
2366 proc makepatterns {l} {
2367 set ret {}
2368 foreach e $l {
2369 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2370 if {[string index $ee end] eq "/"} {
2371 lappend ret "$ee*"
2372 } else {
2373 lappend ret $ee
2374 lappend ret "$ee/*"
2377 return $ret
2380 proc do_file_hl {serial} {
2381 global highlight_files filehighlight highlight_paths gdttype fhl_list
2383 if {$gdttype eq [mc "touching paths:"]} {
2384 if {[catch {set paths [shellsplit $highlight_files]}]} return
2385 set highlight_paths [makepatterns $paths]
2386 highlight_filelist
2387 set gdtargs [concat -- $paths]
2388 } elseif {$gdttype eq [mc "adding/removing string:"]} {
2389 set gdtargs [list "-S$highlight_files"]
2390 } else {
2391 # must be "containing:", i.e. we're searching commit info
2392 return
2394 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2395 set filehighlight [open $cmd r+]
2396 fconfigure $filehighlight -blocking 0
2397 filerun $filehighlight readfhighlight
2398 set fhl_list {}
2399 drawvisible
2400 flushhighlights
2403 proc flushhighlights {} {
2404 global filehighlight fhl_list
2406 if {[info exists filehighlight]} {
2407 lappend fhl_list {}
2408 puts $filehighlight ""
2409 flush $filehighlight
2413 proc askfilehighlight {row id} {
2414 global filehighlight fhighlights fhl_list
2416 lappend fhl_list $id
2417 set fhighlights($row) -1
2418 puts $filehighlight $id
2421 proc readfhighlight {} {
2422 global filehighlight fhighlights commitrow curview iddrawn
2423 global fhl_list find_dirn
2425 if {![info exists filehighlight]} {
2426 return 0
2428 set nr 0
2429 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2430 set line [string trim $line]
2431 set i [lsearch -exact $fhl_list $line]
2432 if {$i < 0} continue
2433 for {set j 0} {$j < $i} {incr j} {
2434 set id [lindex $fhl_list $j]
2435 if {[info exists commitrow($curview,$id)]} {
2436 set fhighlights($commitrow($curview,$id)) 0
2439 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2440 if {$line eq {}} continue
2441 if {![info exists commitrow($curview,$line)]} continue
2442 set row $commitrow($curview,$line)
2443 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2444 bolden $row mainfontbold
2446 set fhighlights($row) 1
2448 if {[eof $filehighlight]} {
2449 # strange...
2450 puts "oops, git diff-tree died"
2451 catch {close $filehighlight}
2452 unset filehighlight
2453 return 0
2455 if {[info exists find_dirn]} {
2456 run findmore
2458 return 1
2461 proc doesmatch {f} {
2462 global findtype findpattern
2464 if {$findtype eq [mc "Regexp"]} {
2465 return [regexp $findpattern $f]
2466 } elseif {$findtype eq [mc "IgnCase"]} {
2467 return [string match -nocase $findpattern $f]
2468 } else {
2469 return [string match $findpattern $f]
2473 proc askfindhighlight {row id} {
2474 global nhighlights commitinfo iddrawn
2475 global findloc
2476 global markingmatches
2478 if {![info exists commitinfo($id)]} {
2479 getcommit $id
2481 set info $commitinfo($id)
2482 set isbold 0
2483 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2484 foreach f $info ty $fldtypes {
2485 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2486 [doesmatch $f]} {
2487 if {$ty eq [mc "Author"]} {
2488 set isbold 2
2489 break
2491 set isbold 1
2494 if {$isbold && [info exists iddrawn($id)]} {
2495 if {![ishighlighted $row]} {
2496 bolden $row mainfontbold
2497 if {$isbold > 1} {
2498 bolden_name $row mainfontbold
2501 if {$markingmatches} {
2502 markrowmatches $row $id
2505 set nhighlights($row) $isbold
2508 proc markrowmatches {row id} {
2509 global canv canv2 linehtag linentag commitinfo findloc
2511 set headline [lindex $commitinfo($id) 0]
2512 set author [lindex $commitinfo($id) 1]
2513 $canv delete match$row
2514 $canv2 delete match$row
2515 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2516 set m [findmatches $headline]
2517 if {$m ne {}} {
2518 markmatches $canv $row $headline $linehtag($row) $m \
2519 [$canv itemcget $linehtag($row) -font] $row
2522 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2523 set m [findmatches $author]
2524 if {$m ne {}} {
2525 markmatches $canv2 $row $author $linentag($row) $m \
2526 [$canv2 itemcget $linentag($row) -font] $row
2531 proc vrel_change {name ix op} {
2532 global highlight_related
2534 rhighlight_none
2535 if {$highlight_related ne [mc "None"]} {
2536 run drawvisible
2540 # prepare for testing whether commits are descendents or ancestors of a
2541 proc rhighlight_sel {a} {
2542 global descendent desc_todo ancestor anc_todo
2543 global highlight_related rhighlights
2545 catch {unset descendent}
2546 set desc_todo [list $a]
2547 catch {unset ancestor}
2548 set anc_todo [list $a]
2549 if {$highlight_related ne [mc "None"]} {
2550 rhighlight_none
2551 run drawvisible
2555 proc rhighlight_none {} {
2556 global rhighlights
2558 catch {unset rhighlights}
2559 unbolden
2562 proc is_descendent {a} {
2563 global curview children commitrow descendent desc_todo
2565 set v $curview
2566 set la $commitrow($v,$a)
2567 set todo $desc_todo
2568 set leftover {}
2569 set done 0
2570 for {set i 0} {$i < [llength $todo]} {incr i} {
2571 set do [lindex $todo $i]
2572 if {$commitrow($v,$do) < $la} {
2573 lappend leftover $do
2574 continue
2576 foreach nk $children($v,$do) {
2577 if {![info exists descendent($nk)]} {
2578 set descendent($nk) 1
2579 lappend todo $nk
2580 if {$nk eq $a} {
2581 set done 1
2585 if {$done} {
2586 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2587 return
2590 set descendent($a) 0
2591 set desc_todo $leftover
2594 proc is_ancestor {a} {
2595 global curview parentlist commitrow ancestor anc_todo
2597 set v $curview
2598 set la $commitrow($v,$a)
2599 set todo $anc_todo
2600 set leftover {}
2601 set done 0
2602 for {set i 0} {$i < [llength $todo]} {incr i} {
2603 set do [lindex $todo $i]
2604 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2605 lappend leftover $do
2606 continue
2608 foreach np [lindex $parentlist $commitrow($v,$do)] {
2609 if {![info exists ancestor($np)]} {
2610 set ancestor($np) 1
2611 lappend todo $np
2612 if {$np eq $a} {
2613 set done 1
2617 if {$done} {
2618 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2619 return
2622 set ancestor($a) 0
2623 set anc_todo $leftover
2626 proc askrelhighlight {row id} {
2627 global descendent highlight_related iddrawn rhighlights
2628 global selectedline ancestor
2630 if {![info exists selectedline]} return
2631 set isbold 0
2632 if {$highlight_related eq [mc "Descendent"] ||
2633 $highlight_related eq [mc "Not descendent"]} {
2634 if {![info exists descendent($id)]} {
2635 is_descendent $id
2637 if {$descendent($id) == ($highlight_related eq [mc "Descendent"])} {
2638 set isbold 1
2640 } elseif {$highlight_related eq [mc "Ancestor"] ||
2641 $highlight_related eq [mc "Not ancestor"]} {
2642 if {![info exists ancestor($id)]} {
2643 is_ancestor $id
2645 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2646 set isbold 1
2649 if {[info exists iddrawn($id)]} {
2650 if {$isbold && ![ishighlighted $row]} {
2651 bolden $row mainfontbold
2654 set rhighlights($row) $isbold
2657 # Graph layout functions
2659 proc shortids {ids} {
2660 set res {}
2661 foreach id $ids {
2662 if {[llength $id] > 1} {
2663 lappend res [shortids $id]
2664 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2665 lappend res [string range $id 0 7]
2666 } else {
2667 lappend res $id
2670 return $res
2673 proc ntimes {n o} {
2674 set ret {}
2675 set o [list $o]
2676 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2677 if {($n & $mask) != 0} {
2678 set ret [concat $ret $o]
2680 set o [concat $o $o]
2682 return $ret
2685 # Work out where id should go in idlist so that order-token
2686 # values increase from left to right
2687 proc idcol {idlist id {i 0}} {
2688 global ordertok curview
2690 set t $ordertok($curview,$id)
2691 if {$i >= [llength $idlist] ||
2692 $t < $ordertok($curview,[lindex $idlist $i])} {
2693 if {$i > [llength $idlist]} {
2694 set i [llength $idlist]
2696 while {[incr i -1] >= 0 &&
2697 $t < $ordertok($curview,[lindex $idlist $i])} {}
2698 incr i
2699 } else {
2700 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2701 while {[incr i] < [llength $idlist] &&
2702 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2705 return $i
2708 proc initlayout {} {
2709 global rowidlist rowisopt rowfinal displayorder commitlisted
2710 global numcommits canvxmax canv
2711 global nextcolor
2712 global parentlist
2713 global colormap rowtextx
2714 global selectfirst
2716 set numcommits 0
2717 set displayorder {}
2718 set commitlisted {}
2719 set parentlist {}
2720 set nextcolor 0
2721 set rowidlist {}
2722 set rowisopt {}
2723 set rowfinal {}
2724 set canvxmax [$canv cget -width]
2725 catch {unset colormap}
2726 catch {unset rowtextx}
2727 set selectfirst 1
2730 proc setcanvscroll {} {
2731 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2733 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2734 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2735 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2736 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2739 proc visiblerows {} {
2740 global canv numcommits linespc
2742 set ymax [lindex [$canv cget -scrollregion] 3]
2743 if {$ymax eq {} || $ymax == 0} return
2744 set f [$canv yview]
2745 set y0 [expr {int([lindex $f 0] * $ymax)}]
2746 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2747 if {$r0 < 0} {
2748 set r0 0
2750 set y1 [expr {int([lindex $f 1] * $ymax)}]
2751 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2752 if {$r1 >= $numcommits} {
2753 set r1 [expr {$numcommits - 1}]
2755 return [list $r0 $r1]
2758 proc layoutmore {} {
2759 global commitidx viewcomplete numcommits
2760 global uparrowlen downarrowlen mingaplen curview
2762 set show $commitidx($curview)
2763 if {$show > $numcommits || $viewcomplete($curview)} {
2764 showstuff $show $viewcomplete($curview)
2768 proc showstuff {canshow last} {
2769 global numcommits commitrow pending_select selectedline curview
2770 global mainheadid displayorder selectfirst
2771 global lastscrollset commitinterest
2773 if {$numcommits == 0} {
2774 global phase
2775 set phase "incrdraw"
2776 allcanvs delete all
2778 set r0 $numcommits
2779 set prev $numcommits
2780 set numcommits $canshow
2781 set t [clock clicks -milliseconds]
2782 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2783 set lastscrollset $t
2784 setcanvscroll
2786 set rows [visiblerows]
2787 set r1 [lindex $rows 1]
2788 if {$r1 >= $canshow} {
2789 set r1 [expr {$canshow - 1}]
2791 if {$r0 <= $r1} {
2792 drawcommits $r0 $r1
2794 if {[info exists pending_select] &&
2795 [info exists commitrow($curview,$pending_select)] &&
2796 $commitrow($curview,$pending_select) < $numcommits} {
2797 selectline $commitrow($curview,$pending_select) 1
2799 if {$selectfirst} {
2800 if {[info exists selectedline] || [info exists pending_select]} {
2801 set selectfirst 0
2802 } else {
2803 set l [first_real_row]
2804 selectline $l 1
2805 set selectfirst 0
2810 proc doshowlocalchanges {} {
2811 global curview mainheadid phase commitrow
2813 if {[info exists commitrow($curview,$mainheadid)] &&
2814 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2815 dodiffindex
2816 } elseif {$phase ne {}} {
2817 lappend commitinterest($mainheadid) {}
2821 proc dohidelocalchanges {} {
2822 global localfrow localirow lserial
2824 if {$localfrow >= 0} {
2825 removerow $localfrow
2826 set localfrow -1
2827 if {$localirow > 0} {
2828 incr localirow -1
2831 if {$localirow >= 0} {
2832 removerow $localirow
2833 set localirow -1
2835 incr lserial
2838 # spawn off a process to do git diff-index --cached HEAD
2839 proc dodiffindex {} {
2840 global localirow localfrow lserial showlocalchanges
2842 if {!$showlocalchanges} return
2843 incr lserial
2844 set localfrow -1
2845 set localirow -1
2846 set fd [open "|git diff-index --cached HEAD" r]
2847 fconfigure $fd -blocking 0
2848 filerun $fd [list readdiffindex $fd $lserial]
2851 proc readdiffindex {fd serial} {
2852 global localirow commitrow mainheadid nullid2 curview
2853 global commitinfo commitdata lserial
2855 set isdiff 1
2856 if {[gets $fd line] < 0} {
2857 if {![eof $fd]} {
2858 return 1
2860 set isdiff 0
2862 # we only need to see one line and we don't really care what it says...
2863 close $fd
2865 # now see if there are any local changes not checked in to the index
2866 if {$serial == $lserial} {
2867 set fd [open "|git diff-files" r]
2868 fconfigure $fd -blocking 0
2869 filerun $fd [list readdifffiles $fd $serial]
2872 if {$isdiff && $serial == $lserial && $localirow == -1} {
2873 # add the line for the changes in the index to the graph
2874 set localirow $commitrow($curview,$mainheadid)
2875 set hl [mc "Local changes checked in to index but not committed"]
2876 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2877 set commitdata($nullid2) "\n $hl\n"
2878 insertrow $localirow $nullid2
2880 return 0
2883 proc readdifffiles {fd serial} {
2884 global localirow localfrow commitrow mainheadid nullid curview
2885 global commitinfo commitdata lserial
2887 set isdiff 1
2888 if {[gets $fd line] < 0} {
2889 if {![eof $fd]} {
2890 return 1
2892 set isdiff 0
2894 # we only need to see one line and we don't really care what it says...
2895 close $fd
2897 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2898 # add the line for the local diff to the graph
2899 if {$localirow >= 0} {
2900 set localfrow $localirow
2901 incr localirow
2902 } else {
2903 set localfrow $commitrow($curview,$mainheadid)
2905 set hl [mc "Local uncommitted changes, not checked in to index"]
2906 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2907 set commitdata($nullid) "\n $hl\n"
2908 insertrow $localfrow $nullid
2910 return 0
2913 proc nextuse {id row} {
2914 global commitrow curview children
2916 if {[info exists children($curview,$id)]} {
2917 foreach kid $children($curview,$id) {
2918 if {![info exists commitrow($curview,$kid)]} {
2919 return -1
2921 if {$commitrow($curview,$kid) > $row} {
2922 return $commitrow($curview,$kid)
2926 if {[info exists commitrow($curview,$id)]} {
2927 return $commitrow($curview,$id)
2929 return -1
2932 proc prevuse {id row} {
2933 global commitrow curview children
2935 set ret -1
2936 if {[info exists children($curview,$id)]} {
2937 foreach kid $children($curview,$id) {
2938 if {![info exists commitrow($curview,$kid)]} break
2939 if {$commitrow($curview,$kid) < $row} {
2940 set ret $commitrow($curview,$kid)
2944 return $ret
2947 proc make_idlist {row} {
2948 global displayorder parentlist uparrowlen downarrowlen mingaplen
2949 global commitidx curview ordertok children commitrow
2951 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2952 if {$r < 0} {
2953 set r 0
2955 set ra [expr {$row - $downarrowlen}]
2956 if {$ra < 0} {
2957 set ra 0
2959 set rb [expr {$row + $uparrowlen}]
2960 if {$rb > $commitidx($curview)} {
2961 set rb $commitidx($curview)
2963 set ids {}
2964 for {} {$r < $ra} {incr r} {
2965 set nextid [lindex $displayorder [expr {$r + 1}]]
2966 foreach p [lindex $parentlist $r] {
2967 if {$p eq $nextid} continue
2968 set rn [nextuse $p $r]
2969 if {$rn >= $row &&
2970 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2971 lappend ids [list $ordertok($curview,$p) $p]
2975 for {} {$r < $row} {incr r} {
2976 set nextid [lindex $displayorder [expr {$r + 1}]]
2977 foreach p [lindex $parentlist $r] {
2978 if {$p eq $nextid} continue
2979 set rn [nextuse $p $r]
2980 if {$rn < 0 || $rn >= $row} {
2981 lappend ids [list $ordertok($curview,$p) $p]
2985 set id [lindex $displayorder $row]
2986 lappend ids [list $ordertok($curview,$id) $id]
2987 while {$r < $rb} {
2988 foreach p [lindex $parentlist $r] {
2989 set firstkid [lindex $children($curview,$p) 0]
2990 if {$commitrow($curview,$firstkid) < $row} {
2991 lappend ids [list $ordertok($curview,$p) $p]
2994 incr r
2995 set id [lindex $displayorder $r]
2996 if {$id ne {}} {
2997 set firstkid [lindex $children($curview,$id) 0]
2998 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
2999 lappend ids [list $ordertok($curview,$id) $id]
3003 set idlist {}
3004 foreach idx [lsort -unique $ids] {
3005 lappend idlist [lindex $idx 1]
3007 return $idlist
3010 proc rowsequal {a b} {
3011 while {[set i [lsearch -exact $a {}]] >= 0} {
3012 set a [lreplace $a $i $i]
3014 while {[set i [lsearch -exact $b {}]] >= 0} {
3015 set b [lreplace $b $i $i]
3017 return [expr {$a eq $b}]
3020 proc makeupline {id row rend col} {
3021 global rowidlist uparrowlen downarrowlen mingaplen
3023 for {set r $rend} {1} {set r $rstart} {
3024 set rstart [prevuse $id $r]
3025 if {$rstart < 0} return
3026 if {$rstart < $row} break
3028 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3029 set rstart [expr {$rend - $uparrowlen - 1}]
3031 for {set r $rstart} {[incr r] <= $row} {} {
3032 set idlist [lindex $rowidlist $r]
3033 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3034 set col [idcol $idlist $id $col]
3035 lset rowidlist $r [linsert $idlist $col $id]
3036 changedrow $r
3041 proc layoutrows {row endrow} {
3042 global rowidlist rowisopt rowfinal displayorder
3043 global uparrowlen downarrowlen maxwidth mingaplen
3044 global children parentlist
3045 global commitidx viewcomplete curview commitrow
3047 set idlist {}
3048 if {$row > 0} {
3049 set rm1 [expr {$row - 1}]
3050 foreach id [lindex $rowidlist $rm1] {
3051 if {$id ne {}} {
3052 lappend idlist $id
3055 set final [lindex $rowfinal $rm1]
3057 for {} {$row < $endrow} {incr row} {
3058 set rm1 [expr {$row - 1}]
3059 if {$rm1 < 0 || $idlist eq {}} {
3060 set idlist [make_idlist $row]
3061 set final 1
3062 } else {
3063 set id [lindex $displayorder $rm1]
3064 set col [lsearch -exact $idlist $id]
3065 set idlist [lreplace $idlist $col $col]
3066 foreach p [lindex $parentlist $rm1] {
3067 if {[lsearch -exact $idlist $p] < 0} {
3068 set col [idcol $idlist $p $col]
3069 set idlist [linsert $idlist $col $p]
3070 # if not the first child, we have to insert a line going up
3071 if {$id ne [lindex $children($curview,$p) 0]} {
3072 makeupline $p $rm1 $row $col
3076 set id [lindex $displayorder $row]
3077 if {$row > $downarrowlen} {
3078 set termrow [expr {$row - $downarrowlen - 1}]
3079 foreach p [lindex $parentlist $termrow] {
3080 set i [lsearch -exact $idlist $p]
3081 if {$i < 0} continue
3082 set nr [nextuse $p $termrow]
3083 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3084 set idlist [lreplace $idlist $i $i]
3088 set col [lsearch -exact $idlist $id]
3089 if {$col < 0} {
3090 set col [idcol $idlist $id]
3091 set idlist [linsert $idlist $col $id]
3092 if {$children($curview,$id) ne {}} {
3093 makeupline $id $rm1 $row $col
3096 set r [expr {$row + $uparrowlen - 1}]
3097 if {$r < $commitidx($curview)} {
3098 set x $col
3099 foreach p [lindex $parentlist $r] {
3100 if {[lsearch -exact $idlist $p] >= 0} continue
3101 set fk [lindex $children($curview,$p) 0]
3102 if {$commitrow($curview,$fk) < $row} {
3103 set x [idcol $idlist $p $x]
3104 set idlist [linsert $idlist $x $p]
3107 if {[incr r] < $commitidx($curview)} {
3108 set p [lindex $displayorder $r]
3109 if {[lsearch -exact $idlist $p] < 0} {
3110 set fk [lindex $children($curview,$p) 0]
3111 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3112 set x [idcol $idlist $p $x]
3113 set idlist [linsert $idlist $x $p]
3119 if {$final && !$viewcomplete($curview) &&
3120 $row + $uparrowlen + $mingaplen + $downarrowlen
3121 >= $commitidx($curview)} {
3122 set final 0
3124 set l [llength $rowidlist]
3125 if {$row == $l} {
3126 lappend rowidlist $idlist
3127 lappend rowisopt 0
3128 lappend rowfinal $final
3129 } elseif {$row < $l} {
3130 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3131 lset rowidlist $row $idlist
3132 changedrow $row
3134 lset rowfinal $row $final
3135 } else {
3136 set pad [ntimes [expr {$row - $l}] {}]
3137 set rowidlist [concat $rowidlist $pad]
3138 lappend rowidlist $idlist
3139 set rowfinal [concat $rowfinal $pad]
3140 lappend rowfinal $final
3141 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3144 return $row
3147 proc changedrow {row} {
3148 global displayorder iddrawn rowisopt need_redisplay
3150 set l [llength $rowisopt]
3151 if {$row < $l} {
3152 lset rowisopt $row 0
3153 if {$row + 1 < $l} {
3154 lset rowisopt [expr {$row + 1}] 0
3155 if {$row + 2 < $l} {
3156 lset rowisopt [expr {$row + 2}] 0
3160 set id [lindex $displayorder $row]
3161 if {[info exists iddrawn($id)]} {
3162 set need_redisplay 1
3166 proc insert_pad {row col npad} {
3167 global rowidlist
3169 set pad [ntimes $npad {}]
3170 set idlist [lindex $rowidlist $row]
3171 set bef [lrange $idlist 0 [expr {$col - 1}]]
3172 set aft [lrange $idlist $col end]
3173 set i [lsearch -exact $aft {}]
3174 if {$i > 0} {
3175 set aft [lreplace $aft $i $i]
3177 lset rowidlist $row [concat $bef $pad $aft]
3178 changedrow $row
3181 proc optimize_rows {row col endrow} {
3182 global rowidlist rowisopt displayorder curview children
3184 if {$row < 1} {
3185 set row 1
3187 for {} {$row < $endrow} {incr row; set col 0} {
3188 if {[lindex $rowisopt $row]} continue
3189 set haspad 0
3190 set y0 [expr {$row - 1}]
3191 set ym [expr {$row - 2}]
3192 set idlist [lindex $rowidlist $row]
3193 set previdlist [lindex $rowidlist $y0]
3194 if {$idlist eq {} || $previdlist eq {}} continue
3195 if {$ym >= 0} {
3196 set pprevidlist [lindex $rowidlist $ym]
3197 if {$pprevidlist eq {}} continue
3198 } else {
3199 set pprevidlist {}
3201 set x0 -1
3202 set xm -1
3203 for {} {$col < [llength $idlist]} {incr col} {
3204 set id [lindex $idlist $col]
3205 if {[lindex $previdlist $col] eq $id} continue
3206 if {$id eq {}} {
3207 set haspad 1
3208 continue
3210 set x0 [lsearch -exact $previdlist $id]
3211 if {$x0 < 0} continue
3212 set z [expr {$x0 - $col}]
3213 set isarrow 0
3214 set z0 {}
3215 if {$ym >= 0} {
3216 set xm [lsearch -exact $pprevidlist $id]
3217 if {$xm >= 0} {
3218 set z0 [expr {$xm - $x0}]
3221 if {$z0 eq {}} {
3222 # if row y0 is the first child of $id then it's not an arrow
3223 if {[lindex $children($curview,$id) 0] ne
3224 [lindex $displayorder $y0]} {
3225 set isarrow 1
3228 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3229 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3230 set isarrow 1
3232 # Looking at lines from this row to the previous row,
3233 # make them go straight up if they end in an arrow on
3234 # the previous row; otherwise make them go straight up
3235 # or at 45 degrees.
3236 if {$z < -1 || ($z < 0 && $isarrow)} {
3237 # Line currently goes left too much;
3238 # insert pads in the previous row, then optimize it
3239 set npad [expr {-1 - $z + $isarrow}]
3240 insert_pad $y0 $x0 $npad
3241 if {$y0 > 0} {
3242 optimize_rows $y0 $x0 $row
3244 set previdlist [lindex $rowidlist $y0]
3245 set x0 [lsearch -exact $previdlist $id]
3246 set z [expr {$x0 - $col}]
3247 if {$z0 ne {}} {
3248 set pprevidlist [lindex $rowidlist $ym]
3249 set xm [lsearch -exact $pprevidlist $id]
3250 set z0 [expr {$xm - $x0}]
3252 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3253 # Line currently goes right too much;
3254 # insert pads in this line
3255 set npad [expr {$z - 1 + $isarrow}]
3256 insert_pad $row $col $npad
3257 set idlist [lindex $rowidlist $row]
3258 incr col $npad
3259 set z [expr {$x0 - $col}]
3260 set haspad 1
3262 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3263 # this line links to its first child on row $row-2
3264 set id [lindex $displayorder $ym]
3265 set xc [lsearch -exact $pprevidlist $id]
3266 if {$xc >= 0} {
3267 set z0 [expr {$xc - $x0}]
3270 # avoid lines jigging left then immediately right
3271 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3272 insert_pad $y0 $x0 1
3273 incr x0
3274 optimize_rows $y0 $x0 $row
3275 set previdlist [lindex $rowidlist $y0]
3278 if {!$haspad} {
3279 # Find the first column that doesn't have a line going right
3280 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3281 set id [lindex $idlist $col]
3282 if {$id eq {}} break
3283 set x0 [lsearch -exact $previdlist $id]
3284 if {$x0 < 0} {
3285 # check if this is the link to the first child
3286 set kid [lindex $displayorder $y0]
3287 if {[lindex $children($curview,$id) 0] eq $kid} {
3288 # it is, work out offset to child
3289 set x0 [lsearch -exact $previdlist $kid]
3292 if {$x0 <= $col} break
3294 # Insert a pad at that column as long as it has a line and
3295 # isn't the last column
3296 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3297 set idlist [linsert $idlist $col {}]
3298 lset rowidlist $row $idlist
3299 changedrow $row
3305 proc xc {row col} {
3306 global canvx0 linespc
3307 return [expr {$canvx0 + $col * $linespc}]
3310 proc yc {row} {
3311 global canvy0 linespc
3312 return [expr {$canvy0 + $row * $linespc}]
3315 proc linewidth {id} {
3316 global thickerline lthickness
3318 set wid $lthickness
3319 if {[info exists thickerline] && $id eq $thickerline} {
3320 set wid [expr {2 * $lthickness}]
3322 return $wid
3325 proc rowranges {id} {
3326 global commitrow curview children uparrowlen downarrowlen
3327 global rowidlist
3329 set kids $children($curview,$id)
3330 if {$kids eq {}} {
3331 return {}
3333 set ret {}
3334 lappend kids $id
3335 foreach child $kids {
3336 if {![info exists commitrow($curview,$child)]} break
3337 set row $commitrow($curview,$child)
3338 if {![info exists prev]} {
3339 lappend ret [expr {$row + 1}]
3340 } else {
3341 if {$row <= $prevrow} {
3342 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3344 # see if the line extends the whole way from prevrow to row
3345 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3346 [lsearch -exact [lindex $rowidlist \
3347 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3348 # it doesn't, see where it ends
3349 set r [expr {$prevrow + $downarrowlen}]
3350 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3351 while {[incr r -1] > $prevrow &&
3352 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3353 } else {
3354 while {[incr r] <= $row &&
3355 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3356 incr r -1
3358 lappend ret $r
3359 # see where it starts up again
3360 set r [expr {$row - $uparrowlen}]
3361 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3362 while {[incr r] < $row &&
3363 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3364 } else {
3365 while {[incr r -1] >= $prevrow &&
3366 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3367 incr r
3369 lappend ret $r
3372 if {$child eq $id} {
3373 lappend ret $row
3375 set prev $id
3376 set prevrow $row
3378 return $ret
3381 proc drawlineseg {id row endrow arrowlow} {
3382 global rowidlist displayorder iddrawn linesegs
3383 global canv colormap linespc curview maxlinelen parentlist
3385 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3386 set le [expr {$row + 1}]
3387 set arrowhigh 1
3388 while {1} {
3389 set c [lsearch -exact [lindex $rowidlist $le] $id]
3390 if {$c < 0} {
3391 incr le -1
3392 break
3394 lappend cols $c
3395 set x [lindex $displayorder $le]
3396 if {$x eq $id} {
3397 set arrowhigh 0
3398 break
3400 if {[info exists iddrawn($x)] || $le == $endrow} {
3401 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3402 if {$c >= 0} {
3403 lappend cols $c
3404 set arrowhigh 0
3406 break
3408 incr le
3410 if {$le <= $row} {
3411 return $row
3414 set lines {}
3415 set i 0
3416 set joinhigh 0
3417 if {[info exists linesegs($id)]} {
3418 set lines $linesegs($id)
3419 foreach li $lines {
3420 set r0 [lindex $li 0]
3421 if {$r0 > $row} {
3422 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3423 set joinhigh 1
3425 break
3427 incr i
3430 set joinlow 0
3431 if {$i > 0} {
3432 set li [lindex $lines [expr {$i-1}]]
3433 set r1 [lindex $li 1]
3434 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3435 set joinlow 1
3439 set x [lindex $cols [expr {$le - $row}]]
3440 set xp [lindex $cols [expr {$le - 1 - $row}]]
3441 set dir [expr {$xp - $x}]
3442 if {$joinhigh} {
3443 set ith [lindex $lines $i 2]
3444 set coords [$canv coords $ith]
3445 set ah [$canv itemcget $ith -arrow]
3446 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3447 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3448 if {$x2 ne {} && $x - $x2 == $dir} {
3449 set coords [lrange $coords 0 end-2]
3451 } else {
3452 set coords [list [xc $le $x] [yc $le]]
3454 if {$joinlow} {
3455 set itl [lindex $lines [expr {$i-1}] 2]
3456 set al [$canv itemcget $itl -arrow]
3457 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3458 } elseif {$arrowlow} {
3459 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3460 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3461 set arrowlow 0
3464 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3465 for {set y $le} {[incr y -1] > $row} {} {
3466 set x $xp
3467 set xp [lindex $cols [expr {$y - 1 - $row}]]
3468 set ndir [expr {$xp - $x}]
3469 if {$dir != $ndir || $xp < 0} {
3470 lappend coords [xc $y $x] [yc $y]
3472 set dir $ndir
3474 if {!$joinlow} {
3475 if {$xp < 0} {
3476 # join parent line to first child
3477 set ch [lindex $displayorder $row]
3478 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3479 if {$xc < 0} {
3480 puts "oops: drawlineseg: child $ch not on row $row"
3481 } elseif {$xc != $x} {
3482 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3483 set d [expr {int(0.5 * $linespc)}]
3484 set x1 [xc $row $x]
3485 if {$xc < $x} {
3486 set x2 [expr {$x1 - $d}]
3487 } else {
3488 set x2 [expr {$x1 + $d}]
3490 set y2 [yc $row]
3491 set y1 [expr {$y2 + $d}]
3492 lappend coords $x1 $y1 $x2 $y2
3493 } elseif {$xc < $x - 1} {
3494 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3495 } elseif {$xc > $x + 1} {
3496 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3498 set x $xc
3500 lappend coords [xc $row $x] [yc $row]
3501 } else {
3502 set xn [xc $row $xp]
3503 set yn [yc $row]
3504 lappend coords $xn $yn
3506 if {!$joinhigh} {
3507 assigncolor $id
3508 set t [$canv create line $coords -width [linewidth $id] \
3509 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3510 $canv lower $t
3511 bindline $t $id
3512 set lines [linsert $lines $i [list $row $le $t]]
3513 } else {
3514 $canv coords $ith $coords
3515 if {$arrow ne $ah} {
3516 $canv itemconf $ith -arrow $arrow
3518 lset lines $i 0 $row
3520 } else {
3521 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3522 set ndir [expr {$xo - $xp}]
3523 set clow [$canv coords $itl]
3524 if {$dir == $ndir} {
3525 set clow [lrange $clow 2 end]
3527 set coords [concat $coords $clow]
3528 if {!$joinhigh} {
3529 lset lines [expr {$i-1}] 1 $le
3530 } else {
3531 # coalesce two pieces
3532 $canv delete $ith
3533 set b [lindex $lines [expr {$i-1}] 0]
3534 set e [lindex $lines $i 1]
3535 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3537 $canv coords $itl $coords
3538 if {$arrow ne $al} {
3539 $canv itemconf $itl -arrow $arrow
3543 set linesegs($id) $lines
3544 return $le
3547 proc drawparentlinks {id row} {
3548 global rowidlist canv colormap curview parentlist
3549 global idpos linespc
3551 set rowids [lindex $rowidlist $row]
3552 set col [lsearch -exact $rowids $id]
3553 if {$col < 0} return
3554 set olds [lindex $parentlist $row]
3555 set row2 [expr {$row + 1}]
3556 set x [xc $row $col]
3557 set y [yc $row]
3558 set y2 [yc $row2]
3559 set d [expr {int(0.5 * $linespc)}]
3560 set ymid [expr {$y + $d}]
3561 set ids [lindex $rowidlist $row2]
3562 # rmx = right-most X coord used
3563 set rmx 0
3564 foreach p $olds {
3565 set i [lsearch -exact $ids $p]
3566 if {$i < 0} {
3567 puts "oops, parent $p of $id not in list"
3568 continue
3570 set x2 [xc $row2 $i]
3571 if {$x2 > $rmx} {
3572 set rmx $x2
3574 set j [lsearch -exact $rowids $p]
3575 if {$j < 0} {
3576 # drawlineseg will do this one for us
3577 continue
3579 assigncolor $p
3580 # should handle duplicated parents here...
3581 set coords [list $x $y]
3582 if {$i != $col} {
3583 # if attaching to a vertical segment, draw a smaller
3584 # slant for visual distinctness
3585 if {$i == $j} {
3586 if {$i < $col} {
3587 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3588 } else {
3589 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3591 } elseif {$i < $col && $i < $j} {
3592 # segment slants towards us already
3593 lappend coords [xc $row $j] $y
3594 } else {
3595 if {$i < $col - 1} {
3596 lappend coords [expr {$x2 + $linespc}] $y
3597 } elseif {$i > $col + 1} {
3598 lappend coords [expr {$x2 - $linespc}] $y
3600 lappend coords $x2 $y2
3602 } else {
3603 lappend coords $x2 $y2
3605 set t [$canv create line $coords -width [linewidth $p] \
3606 -fill $colormap($p) -tags lines.$p]
3607 $canv lower $t
3608 bindline $t $p
3610 if {$rmx > [lindex $idpos($id) 1]} {
3611 lset idpos($id) 1 $rmx
3612 redrawtags $id
3616 proc drawlines {id} {
3617 global canv
3619 $canv itemconf lines.$id -width [linewidth $id]
3622 proc drawcmittext {id row col} {
3623 global linespc canv canv2 canv3 canvy0 fgcolor curview
3624 global commitlisted commitinfo rowidlist parentlist
3625 global rowtextx idpos idtags idheads idotherrefs
3626 global linehtag linentag linedtag selectedline
3627 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3629 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3630 set listed [lindex $commitlisted $row]
3631 if {$id eq $nullid} {
3632 set ofill red
3633 } elseif {$id eq $nullid2} {
3634 set ofill green
3635 } else {
3636 set ofill [expr {$listed != 0? "blue": "white"}]
3638 set x [xc $row $col]
3639 set y [yc $row]
3640 set orad [expr {$linespc / 3}]
3641 if {$listed <= 1} {
3642 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3643 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3644 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3645 } elseif {$listed == 2} {
3646 # triangle pointing left for left-side commits
3647 set t [$canv create polygon \
3648 [expr {$x - $orad}] $y \
3649 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3650 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3651 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3652 } else {
3653 # triangle pointing right for right-side commits
3654 set t [$canv create polygon \
3655 [expr {$x + $orad - 1}] $y \
3656 [expr {$x - $orad}] [expr {$y - $orad}] \
3657 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3658 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3660 $canv raise $t
3661 $canv bind $t <1> {selcanvline {} %x %y}
3662 set rmx [llength [lindex $rowidlist $row]]
3663 set olds [lindex $parentlist $row]
3664 if {$olds ne {}} {
3665 set nextids [lindex $rowidlist [expr {$row + 1}]]
3666 foreach p $olds {
3667 set i [lsearch -exact $nextids $p]
3668 if {$i > $rmx} {
3669 set rmx $i
3673 set xt [xc $row $rmx]
3674 set rowtextx($row) $xt
3675 set idpos($id) [list $x $xt $y]
3676 if {[info exists idtags($id)] || [info exists idheads($id)]
3677 || [info exists idotherrefs($id)]} {
3678 set xt [drawtags $id $x $xt $y]
3680 set headline [lindex $commitinfo($id) 0]
3681 set name [lindex $commitinfo($id) 1]
3682 set date [lindex $commitinfo($id) 2]
3683 set date [formatdate $date]
3684 set font mainfont
3685 set nfont mainfont
3686 set isbold [ishighlighted $row]
3687 if {$isbold > 0} {
3688 lappend boldrows $row
3689 set font mainfontbold
3690 if {$isbold > 1} {
3691 lappend boldnamerows $row
3692 set nfont mainfontbold
3695 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3696 -text $headline -font $font -tags text]
3697 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3698 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3699 -text $name -font $nfont -tags text]
3700 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3701 -text $date -font mainfont -tags text]
3702 if {[info exists selectedline] && $selectedline == $row} {
3703 make_secsel $row
3705 set xr [expr {$xt + [font measure $font $headline]}]
3706 if {$xr > $canvxmax} {
3707 set canvxmax $xr
3708 setcanvscroll
3712 proc drawcmitrow {row} {
3713 global displayorder rowidlist nrows_drawn
3714 global iddrawn markingmatches
3715 global commitinfo parentlist numcommits
3716 global filehighlight fhighlights findpattern nhighlights
3717 global hlview vhighlights
3718 global highlight_related rhighlights
3720 if {$row >= $numcommits} return
3722 set id [lindex $displayorder $row]
3723 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3724 askvhighlight $row $id
3726 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3727 askfilehighlight $row $id
3729 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3730 askfindhighlight $row $id
3732 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3733 askrelhighlight $row $id
3735 if {![info exists iddrawn($id)]} {
3736 set col [lsearch -exact [lindex $rowidlist $row] $id]
3737 if {$col < 0} {
3738 puts "oops, row $row id $id not in list"
3739 return
3741 if {![info exists commitinfo($id)]} {
3742 getcommit $id
3744 assigncolor $id
3745 drawcmittext $id $row $col
3746 set iddrawn($id) 1
3747 incr nrows_drawn
3749 if {$markingmatches} {
3750 markrowmatches $row $id
3754 proc drawcommits {row {endrow {}}} {
3755 global numcommits iddrawn displayorder curview need_redisplay
3756 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3758 if {$row < 0} {
3759 set row 0
3761 if {$endrow eq {}} {
3762 set endrow $row
3764 if {$endrow >= $numcommits} {
3765 set endrow [expr {$numcommits - 1}]
3768 set rl1 [expr {$row - $downarrowlen - 3}]
3769 if {$rl1 < 0} {
3770 set rl1 0
3772 set ro1 [expr {$row - 3}]
3773 if {$ro1 < 0} {
3774 set ro1 0
3776 set r2 [expr {$endrow + $uparrowlen + 3}]
3777 if {$r2 > $numcommits} {
3778 set r2 $numcommits
3780 for {set r $rl1} {$r < $r2} {incr r} {
3781 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3782 if {$rl1 < $r} {
3783 layoutrows $rl1 $r
3785 set rl1 [expr {$r + 1}]
3788 if {$rl1 < $r} {
3789 layoutrows $rl1 $r
3791 optimize_rows $ro1 0 $r2
3792 if {$need_redisplay || $nrows_drawn > 2000} {
3793 clear_display
3794 drawvisible
3797 # make the lines join to already-drawn rows either side
3798 set r [expr {$row - 1}]
3799 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3800 set r $row
3802 set er [expr {$endrow + 1}]
3803 if {$er >= $numcommits ||
3804 ![info exists iddrawn([lindex $displayorder $er])]} {
3805 set er $endrow
3807 for {} {$r <= $er} {incr r} {
3808 set id [lindex $displayorder $r]
3809 set wasdrawn [info exists iddrawn($id)]
3810 drawcmitrow $r
3811 if {$r == $er} break
3812 set nextid [lindex $displayorder [expr {$r + 1}]]
3813 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3814 drawparentlinks $id $r
3816 set rowids [lindex $rowidlist $r]
3817 foreach lid $rowids {
3818 if {$lid eq {}} continue
3819 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3820 if {$lid eq $id} {
3821 # see if this is the first child of any of its parents
3822 foreach p [lindex $parentlist $r] {
3823 if {[lsearch -exact $rowids $p] < 0} {
3824 # make this line extend up to the child
3825 set lineend($p) [drawlineseg $p $r $er 0]
3828 } else {
3829 set lineend($lid) [drawlineseg $lid $r $er 1]
3835 proc drawfrac {f0 f1} {
3836 global canv linespc
3838 set ymax [lindex [$canv cget -scrollregion] 3]
3839 if {$ymax eq {} || $ymax == 0} return
3840 set y0 [expr {int($f0 * $ymax)}]
3841 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3842 set y1 [expr {int($f1 * $ymax)}]
3843 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3844 drawcommits $row $endrow
3847 proc drawvisible {} {
3848 global canv
3849 eval drawfrac [$canv yview]
3852 proc clear_display {} {
3853 global iddrawn linesegs need_redisplay nrows_drawn
3854 global vhighlights fhighlights nhighlights rhighlights
3856 allcanvs delete all
3857 catch {unset iddrawn}
3858 catch {unset linesegs}
3859 catch {unset vhighlights}
3860 catch {unset fhighlights}
3861 catch {unset nhighlights}
3862 catch {unset rhighlights}
3863 set need_redisplay 0
3864 set nrows_drawn 0
3867 proc findcrossings {id} {
3868 global rowidlist parentlist numcommits displayorder
3870 set cross {}
3871 set ccross {}
3872 foreach {s e} [rowranges $id] {
3873 if {$e >= $numcommits} {
3874 set e [expr {$numcommits - 1}]
3876 if {$e <= $s} continue
3877 for {set row $e} {[incr row -1] >= $s} {} {
3878 set x [lsearch -exact [lindex $rowidlist $row] $id]
3879 if {$x < 0} break
3880 set olds [lindex $parentlist $row]
3881 set kid [lindex $displayorder $row]
3882 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3883 if {$kidx < 0} continue
3884 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3885 foreach p $olds {
3886 set px [lsearch -exact $nextrow $p]
3887 if {$px < 0} continue
3888 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3889 if {[lsearch -exact $ccross $p] >= 0} continue
3890 if {$x == $px + ($kidx < $px? -1: 1)} {
3891 lappend ccross $p
3892 } elseif {[lsearch -exact $cross $p] < 0} {
3893 lappend cross $p
3899 return [concat $ccross {{}} $cross]
3902 proc assigncolor {id} {
3903 global colormap colors nextcolor
3904 global commitrow parentlist children children curview
3906 if {[info exists colormap($id)]} return
3907 set ncolors [llength $colors]
3908 if {[info exists children($curview,$id)]} {
3909 set kids $children($curview,$id)
3910 } else {
3911 set kids {}
3913 if {[llength $kids] == 1} {
3914 set child [lindex $kids 0]
3915 if {[info exists colormap($child)]
3916 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3917 set colormap($id) $colormap($child)
3918 return
3921 set badcolors {}
3922 set origbad {}
3923 foreach x [findcrossings $id] {
3924 if {$x eq {}} {
3925 # delimiter between corner crossings and other crossings
3926 if {[llength $badcolors] >= $ncolors - 1} break
3927 set origbad $badcolors
3929 if {[info exists colormap($x)]
3930 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3931 lappend badcolors $colormap($x)
3934 if {[llength $badcolors] >= $ncolors} {
3935 set badcolors $origbad
3937 set origbad $badcolors
3938 if {[llength $badcolors] < $ncolors - 1} {
3939 foreach child $kids {
3940 if {[info exists colormap($child)]
3941 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3942 lappend badcolors $colormap($child)
3944 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3945 if {[info exists colormap($p)]
3946 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3947 lappend badcolors $colormap($p)
3951 if {[llength $badcolors] >= $ncolors} {
3952 set badcolors $origbad
3955 for {set i 0} {$i <= $ncolors} {incr i} {
3956 set c [lindex $colors $nextcolor]
3957 if {[incr nextcolor] >= $ncolors} {
3958 set nextcolor 0
3960 if {[lsearch -exact $badcolors $c]} break
3962 set colormap($id) $c
3965 proc bindline {t id} {
3966 global canv
3968 $canv bind $t <Enter> "lineenter %x %y $id"
3969 $canv bind $t <Motion> "linemotion %x %y $id"
3970 $canv bind $t <Leave> "lineleave $id"
3971 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3974 proc drawtags {id x xt y1} {
3975 global idtags idheads idotherrefs mainhead
3976 global linespc lthickness
3977 global canv commitrow rowtextx curview fgcolor bgcolor
3979 set marks {}
3980 set ntags 0
3981 set nheads 0
3982 if {[info exists idtags($id)]} {
3983 set marks $idtags($id)
3984 set ntags [llength $marks]
3986 if {[info exists idheads($id)]} {
3987 set marks [concat $marks $idheads($id)]
3988 set nheads [llength $idheads($id)]
3990 if {[info exists idotherrefs($id)]} {
3991 set marks [concat $marks $idotherrefs($id)]
3993 if {$marks eq {}} {
3994 return $xt
3997 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3998 set yt [expr {$y1 - 0.5 * $linespc}]
3999 set yb [expr {$yt + $linespc - 1}]
4000 set xvals {}
4001 set wvals {}
4002 set i -1
4003 foreach tag $marks {
4004 incr i
4005 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4006 set wid [font measure mainfontbold $tag]
4007 } else {
4008 set wid [font measure mainfont $tag]
4010 lappend xvals $xt
4011 lappend wvals $wid
4012 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4014 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4015 -width $lthickness -fill black -tags tag.$id]
4016 $canv lower $t
4017 foreach tag $marks x $xvals wid $wvals {
4018 set xl [expr {$x + $delta}]
4019 set xr [expr {$x + $delta + $wid + $lthickness}]
4020 set font mainfont
4021 if {[incr ntags -1] >= 0} {
4022 # draw a tag
4023 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4024 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4025 -width 1 -outline black -fill yellow -tags tag.$id]
4026 $canv bind $t <1> [list showtag $tag 1]
4027 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4028 } else {
4029 # draw a head or other ref
4030 if {[incr nheads -1] >= 0} {
4031 set col green
4032 if {$tag eq $mainhead} {
4033 set font mainfontbold
4035 } else {
4036 set col "#ddddff"
4038 set xl [expr {$xl - $delta/2}]
4039 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4040 -width 1 -outline black -fill $col -tags tag.$id
4041 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4042 set rwid [font measure mainfont $remoteprefix]
4043 set xi [expr {$x + 1}]
4044 set yti [expr {$yt + 1}]
4045 set xri [expr {$x + $rwid}]
4046 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4047 -width 0 -fill "#ffddaa" -tags tag.$id
4050 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4051 -font $font -tags [list tag.$id text]]
4052 if {$ntags >= 0} {
4053 $canv bind $t <1> [list showtag $tag 1]
4054 } elseif {$nheads >= 0} {
4055 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4058 return $xt
4061 proc xcoord {i level ln} {
4062 global canvx0 xspc1 xspc2
4064 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4065 if {$i > 0 && $i == $level} {
4066 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4067 } elseif {$i > $level} {
4068 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4070 return $x
4073 proc show_status {msg} {
4074 global canv fgcolor
4076 clear_display
4077 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4078 -tags text -fill $fgcolor
4081 # Insert a new commit as the child of the commit on row $row.
4082 # The new commit will be displayed on row $row and the commits
4083 # on that row and below will move down one row.
4084 proc insertrow {row newcmit} {
4085 global displayorder parentlist commitlisted children
4086 global commitrow curview rowidlist rowisopt rowfinal numcommits
4087 global numcommits
4088 global selectedline commitidx ordertok
4090 if {$row >= $numcommits} {
4091 puts "oops, inserting new row $row but only have $numcommits rows"
4092 return
4094 set p [lindex $displayorder $row]
4095 set displayorder [linsert $displayorder $row $newcmit]
4096 set parentlist [linsert $parentlist $row $p]
4097 set kids $children($curview,$p)
4098 lappend kids $newcmit
4099 set children($curview,$p) $kids
4100 set children($curview,$newcmit) {}
4101 set commitlisted [linsert $commitlisted $row 1]
4102 set l [llength $displayorder]
4103 for {set r $row} {$r < $l} {incr r} {
4104 set id [lindex $displayorder $r]
4105 set commitrow($curview,$id) $r
4107 incr commitidx($curview)
4108 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4110 if {$row < [llength $rowidlist]} {
4111 set idlist [lindex $rowidlist $row]
4112 if {$idlist ne {}} {
4113 if {[llength $kids] == 1} {
4114 set col [lsearch -exact $idlist $p]
4115 lset idlist $col $newcmit
4116 } else {
4117 set col [llength $idlist]
4118 lappend idlist $newcmit
4121 set rowidlist [linsert $rowidlist $row $idlist]
4122 set rowisopt [linsert $rowisopt $row 0]
4123 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4126 incr numcommits
4128 if {[info exists selectedline] && $selectedline >= $row} {
4129 incr selectedline
4131 redisplay
4134 # Remove a commit that was inserted with insertrow on row $row.
4135 proc removerow {row} {
4136 global displayorder parentlist commitlisted children
4137 global commitrow curview rowidlist rowisopt rowfinal numcommits
4138 global numcommits
4139 global linesegends selectedline commitidx
4141 if {$row >= $numcommits} {
4142 puts "oops, removing row $row but only have $numcommits rows"
4143 return
4145 set rp1 [expr {$row + 1}]
4146 set id [lindex $displayorder $row]
4147 set p [lindex $parentlist $row]
4148 set displayorder [lreplace $displayorder $row $row]
4149 set parentlist [lreplace $parentlist $row $row]
4150 set commitlisted [lreplace $commitlisted $row $row]
4151 set kids $children($curview,$p)
4152 set i [lsearch -exact $kids $id]
4153 if {$i >= 0} {
4154 set kids [lreplace $kids $i $i]
4155 set children($curview,$p) $kids
4157 set l [llength $displayorder]
4158 for {set r $row} {$r < $l} {incr r} {
4159 set id [lindex $displayorder $r]
4160 set commitrow($curview,$id) $r
4162 incr commitidx($curview) -1
4164 if {$row < [llength $rowidlist]} {
4165 set rowidlist [lreplace $rowidlist $row $row]
4166 set rowisopt [lreplace $rowisopt $row $row]
4167 set rowfinal [lreplace $rowfinal $row $row]
4170 incr numcommits -1
4172 if {[info exists selectedline] && $selectedline > $row} {
4173 incr selectedline -1
4175 redisplay
4178 # Don't change the text pane cursor if it is currently the hand cursor,
4179 # showing that we are over a sha1 ID link.
4180 proc settextcursor {c} {
4181 global ctext curtextcursor
4183 if {[$ctext cget -cursor] == $curtextcursor} {
4184 $ctext config -cursor $c
4186 set curtextcursor $c
4189 proc nowbusy {what {name {}}} {
4190 global isbusy busyname statusw
4192 if {[array names isbusy] eq {}} {
4193 . config -cursor watch
4194 settextcursor watch
4196 set isbusy($what) 1
4197 set busyname($what) $name
4198 if {$name ne {}} {
4199 $statusw conf -text $name
4203 proc notbusy {what} {
4204 global isbusy maincursor textcursor busyname statusw
4206 catch {
4207 unset isbusy($what)
4208 if {$busyname($what) ne {} &&
4209 [$statusw cget -text] eq $busyname($what)} {
4210 $statusw conf -text {}
4213 if {[array names isbusy] eq {}} {
4214 . config -cursor $maincursor
4215 settextcursor $textcursor
4219 proc findmatches {f} {
4220 global findtype findstring
4221 if {$findtype == [mc "Regexp"]} {
4222 set matches [regexp -indices -all -inline $findstring $f]
4223 } else {
4224 set fs $findstring
4225 if {$findtype == [mc "IgnCase"]} {
4226 set f [string tolower $f]
4227 set fs [string tolower $fs]
4229 set matches {}
4230 set i 0
4231 set l [string length $fs]
4232 while {[set j [string first $fs $f $i]] >= 0} {
4233 lappend matches [list $j [expr {$j+$l-1}]]
4234 set i [expr {$j + $l}]
4237 return $matches
4240 proc dofind {{dirn 1} {wrap 1}} {
4241 global findstring findstartline findcurline selectedline numcommits
4242 global gdttype filehighlight fh_serial find_dirn findallowwrap
4244 if {[info exists find_dirn]} {
4245 if {$find_dirn == $dirn} return
4246 stopfinding
4248 focus .
4249 if {$findstring eq {} || $numcommits == 0} return
4250 if {![info exists selectedline]} {
4251 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4252 } else {
4253 set findstartline $selectedline
4255 set findcurline $findstartline
4256 nowbusy finding [mc "Searching"]
4257 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4258 after cancel do_file_hl $fh_serial
4259 do_file_hl $fh_serial
4261 set find_dirn $dirn
4262 set findallowwrap $wrap
4263 run findmore
4266 proc stopfinding {} {
4267 global find_dirn findcurline fprogcoord
4269 if {[info exists find_dirn]} {
4270 unset find_dirn
4271 unset findcurline
4272 notbusy finding
4273 set fprogcoord 0
4274 adjustprogress
4278 proc findmore {} {
4279 global commitdata commitinfo numcommits findpattern findloc
4280 global findstartline findcurline displayorder
4281 global find_dirn gdttype fhighlights fprogcoord
4282 global findallowwrap
4284 if {![info exists find_dirn]} {
4285 return 0
4287 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4288 set l $findcurline
4289 set moretodo 0
4290 if {$find_dirn > 0} {
4291 incr l
4292 if {$l >= $numcommits} {
4293 set l 0
4295 if {$l <= $findstartline} {
4296 set lim [expr {$findstartline + 1}]
4297 } else {
4298 set lim $numcommits
4299 set moretodo $findallowwrap
4301 } else {
4302 if {$l == 0} {
4303 set l $numcommits
4305 incr l -1
4306 if {$l >= $findstartline} {
4307 set lim [expr {$findstartline - 1}]
4308 } else {
4309 set lim -1
4310 set moretodo $findallowwrap
4313 set n [expr {($lim - $l) * $find_dirn}]
4314 if {$n > 500} {
4315 set n 500
4316 set moretodo 1
4318 set found 0
4319 set domore 1
4320 if {$gdttype eq [mc "containing:"]} {
4321 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4322 set id [lindex $displayorder $l]
4323 # shouldn't happen unless git log doesn't give all the commits...
4324 if {![info exists commitdata($id)]} continue
4325 if {![doesmatch $commitdata($id)]} continue
4326 if {![info exists commitinfo($id)]} {
4327 getcommit $id
4329 set info $commitinfo($id)
4330 foreach f $info ty $fldtypes {
4331 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4332 [doesmatch $f]} {
4333 set found 1
4334 break
4337 if {$found} break
4339 } else {
4340 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4341 set id [lindex $displayorder $l]
4342 if {![info exists fhighlights($l)]} {
4343 askfilehighlight $l $id
4344 if {$domore} {
4345 set domore 0
4346 set findcurline [expr {$l - $find_dirn}]
4348 } elseif {$fhighlights($l)} {
4349 set found $domore
4350 break
4354 if {$found || ($domore && !$moretodo)} {
4355 unset findcurline
4356 unset find_dirn
4357 notbusy finding
4358 set fprogcoord 0
4359 adjustprogress
4360 if {$found} {
4361 findselectline $l
4362 } else {
4363 bell
4365 return 0
4367 if {!$domore} {
4368 flushhighlights
4369 } else {
4370 set findcurline [expr {$l - $find_dirn}]
4372 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4373 if {$n < 0} {
4374 incr n $numcommits
4376 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4377 adjustprogress
4378 return $domore
4381 proc findselectline {l} {
4382 global findloc commentend ctext findcurline markingmatches gdttype
4384 set markingmatches 1
4385 set findcurline $l
4386 selectline $l 1
4387 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4388 # highlight the matches in the comments
4389 set f [$ctext get 1.0 $commentend]
4390 set matches [findmatches $f]
4391 foreach match $matches {
4392 set start [lindex $match 0]
4393 set end [expr {[lindex $match 1] + 1}]
4394 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4397 drawvisible
4400 # mark the bits of a headline or author that match a find string
4401 proc markmatches {canv l str tag matches font row} {
4402 global selectedline
4404 set bbox [$canv bbox $tag]
4405 set x0 [lindex $bbox 0]
4406 set y0 [lindex $bbox 1]
4407 set y1 [lindex $bbox 3]
4408 foreach match $matches {
4409 set start [lindex $match 0]
4410 set end [lindex $match 1]
4411 if {$start > $end} continue
4412 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4413 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4414 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4415 [expr {$x0+$xlen+2}] $y1 \
4416 -outline {} -tags [list match$l matches] -fill yellow]
4417 $canv lower $t
4418 if {[info exists selectedline] && $row == $selectedline} {
4419 $canv raise $t secsel
4424 proc unmarkmatches {} {
4425 global markingmatches
4427 allcanvs delete matches
4428 set markingmatches 0
4429 stopfinding
4432 proc selcanvline {w x y} {
4433 global canv canvy0 ctext linespc
4434 global rowtextx
4435 set ymax [lindex [$canv cget -scrollregion] 3]
4436 if {$ymax == {}} return
4437 set yfrac [lindex [$canv yview] 0]
4438 set y [expr {$y + $yfrac * $ymax}]
4439 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4440 if {$l < 0} {
4441 set l 0
4443 if {$w eq $canv} {
4444 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4446 unmarkmatches
4447 selectline $l 1
4450 proc commit_descriptor {p} {
4451 global commitinfo
4452 if {![info exists commitinfo($p)]} {
4453 getcommit $p
4455 set l "..."
4456 if {[llength $commitinfo($p)] > 1} {
4457 set l [lindex $commitinfo($p) 0]
4459 return "$p ($l)\n"
4462 # append some text to the ctext widget, and make any SHA1 ID
4463 # that we know about be a clickable link.
4464 proc appendwithlinks {text tags} {
4465 global ctext commitrow linknum curview pendinglinks
4467 set start [$ctext index "end - 1c"]
4468 $ctext insert end $text $tags
4469 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4470 foreach l $links {
4471 set s [lindex $l 0]
4472 set e [lindex $l 1]
4473 set linkid [string range $text $s $e]
4474 incr e
4475 $ctext tag delete link$linknum
4476 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4477 setlink $linkid link$linknum
4478 incr linknum
4482 proc setlink {id lk} {
4483 global curview commitrow ctext pendinglinks commitinterest
4485 if {[info exists commitrow($curview,$id)]} {
4486 $ctext tag conf $lk -foreground blue -underline 1
4487 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4488 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4489 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4490 } else {
4491 lappend pendinglinks($id) $lk
4492 lappend commitinterest($id) {makelink %I}
4496 proc makelink {id} {
4497 global pendinglinks
4499 if {![info exists pendinglinks($id)]} return
4500 foreach lk $pendinglinks($id) {
4501 setlink $id $lk
4503 unset pendinglinks($id)
4506 proc linkcursor {w inc} {
4507 global linkentercount curtextcursor
4509 if {[incr linkentercount $inc] > 0} {
4510 $w configure -cursor hand2
4511 } else {
4512 $w configure -cursor $curtextcursor
4513 if {$linkentercount < 0} {
4514 set linkentercount 0
4519 proc viewnextline {dir} {
4520 global canv linespc
4522 $canv delete hover
4523 set ymax [lindex [$canv cget -scrollregion] 3]
4524 set wnow [$canv yview]
4525 set wtop [expr {[lindex $wnow 0] * $ymax}]
4526 set newtop [expr {$wtop + $dir * $linespc}]
4527 if {$newtop < 0} {
4528 set newtop 0
4529 } elseif {$newtop > $ymax} {
4530 set newtop $ymax
4532 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4535 # add a list of tag or branch names at position pos
4536 # returns the number of names inserted
4537 proc appendrefs {pos ids var} {
4538 global ctext commitrow linknum curview $var maxrefs
4540 if {[catch {$ctext index $pos}]} {
4541 return 0
4543 $ctext conf -state normal
4544 $ctext delete $pos "$pos lineend"
4545 set tags {}
4546 foreach id $ids {
4547 foreach tag [set $var\($id\)] {
4548 lappend tags [list $tag $id]
4551 if {[llength $tags] > $maxrefs} {
4552 $ctext insert $pos "many ([llength $tags])"
4553 } else {
4554 set tags [lsort -index 0 -decreasing $tags]
4555 set sep {}
4556 foreach ti $tags {
4557 set id [lindex $ti 1]
4558 set lk link$linknum
4559 incr linknum
4560 $ctext tag delete $lk
4561 $ctext insert $pos $sep
4562 $ctext insert $pos [lindex $ti 0] $lk
4563 setlink $id $lk
4564 set sep ", "
4567 $ctext conf -state disabled
4568 return [llength $tags]
4571 # called when we have finished computing the nearby tags
4572 proc dispneartags {delay} {
4573 global selectedline currentid showneartags tagphase
4575 if {![info exists selectedline] || !$showneartags} return
4576 after cancel dispnexttag
4577 if {$delay} {
4578 after 200 dispnexttag
4579 set tagphase -1
4580 } else {
4581 after idle dispnexttag
4582 set tagphase 0
4586 proc dispnexttag {} {
4587 global selectedline currentid showneartags tagphase ctext
4589 if {![info exists selectedline] || !$showneartags} return
4590 switch -- $tagphase {
4592 set dtags [desctags $currentid]
4593 if {$dtags ne {}} {
4594 appendrefs precedes $dtags idtags
4598 set atags [anctags $currentid]
4599 if {$atags ne {}} {
4600 appendrefs follows $atags idtags
4604 set dheads [descheads $currentid]
4605 if {$dheads ne {}} {
4606 if {[appendrefs branch $dheads idheads] > 1
4607 && [$ctext get "branch -3c"] eq "h"} {
4608 # turn "Branch" into "Branches"
4609 $ctext conf -state normal
4610 $ctext insert "branch -2c" "es"
4611 $ctext conf -state disabled
4616 if {[incr tagphase] <= 2} {
4617 after idle dispnexttag
4621 proc make_secsel {l} {
4622 global linehtag linentag linedtag canv canv2 canv3
4624 if {![info exists linehtag($l)]} return
4625 $canv delete secsel
4626 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4627 -tags secsel -fill [$canv cget -selectbackground]]
4628 $canv lower $t
4629 $canv2 delete secsel
4630 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4631 -tags secsel -fill [$canv2 cget -selectbackground]]
4632 $canv2 lower $t
4633 $canv3 delete secsel
4634 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4635 -tags secsel -fill [$canv3 cget -selectbackground]]
4636 $canv3 lower $t
4639 proc selectline {l isnew} {
4640 global canv ctext commitinfo selectedline
4641 global displayorder
4642 global canvy0 linespc parentlist children curview
4643 global currentid sha1entry
4644 global commentend idtags linknum
4645 global mergemax numcommits pending_select
4646 global cmitmode showneartags allcommits
4648 catch {unset pending_select}
4649 $canv delete hover
4650 normalline
4651 unsel_reflist
4652 stopfinding
4653 if {$l < 0 || $l >= $numcommits} return
4654 set y [expr {$canvy0 + $l * $linespc}]
4655 set ymax [lindex [$canv cget -scrollregion] 3]
4656 set ytop [expr {$y - $linespc - 1}]
4657 set ybot [expr {$y + $linespc + 1}]
4658 set wnow [$canv yview]
4659 set wtop [expr {[lindex $wnow 0] * $ymax}]
4660 set wbot [expr {[lindex $wnow 1] * $ymax}]
4661 set wh [expr {$wbot - $wtop}]
4662 set newtop $wtop
4663 if {$ytop < $wtop} {
4664 if {$ybot < $wtop} {
4665 set newtop [expr {$y - $wh / 2.0}]
4666 } else {
4667 set newtop $ytop
4668 if {$newtop > $wtop - $linespc} {
4669 set newtop [expr {$wtop - $linespc}]
4672 } elseif {$ybot > $wbot} {
4673 if {$ytop > $wbot} {
4674 set newtop [expr {$y - $wh / 2.0}]
4675 } else {
4676 set newtop [expr {$ybot - $wh}]
4677 if {$newtop < $wtop + $linespc} {
4678 set newtop [expr {$wtop + $linespc}]
4682 if {$newtop != $wtop} {
4683 if {$newtop < 0} {
4684 set newtop 0
4686 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4687 drawvisible
4690 make_secsel $l
4692 if {$isnew} {
4693 addtohistory [list selectline $l 0]
4696 set selectedline $l
4698 set id [lindex $displayorder $l]
4699 set currentid $id
4700 $sha1entry delete 0 end
4701 $sha1entry insert 0 $id
4702 $sha1entry selection from 0
4703 $sha1entry selection to end
4704 rhighlight_sel $id
4706 $ctext conf -state normal
4707 clear_ctext
4708 set linknum 0
4709 set info $commitinfo($id)
4710 set date [formatdate [lindex $info 2]]
4711 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
4712 set date [formatdate [lindex $info 4]]
4713 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
4714 if {[info exists idtags($id)]} {
4715 $ctext insert end [mc "Tags:"]
4716 foreach tag $idtags($id) {
4717 $ctext insert end " $tag"
4719 $ctext insert end "\n"
4722 set headers {}
4723 set olds [lindex $parentlist $l]
4724 if {[llength $olds] > 1} {
4725 set np 0
4726 foreach p $olds {
4727 if {$np >= $mergemax} {
4728 set tag mmax
4729 } else {
4730 set tag m$np
4732 $ctext insert end "[mc "Parent"]: " $tag
4733 appendwithlinks [commit_descriptor $p] {}
4734 incr np
4736 } else {
4737 foreach p $olds {
4738 append headers "[mc "Parent"]: [commit_descriptor $p]"
4742 foreach c $children($curview,$id) {
4743 append headers "[mc "Child"]: [commit_descriptor $c]"
4746 # make anything that looks like a SHA1 ID be a clickable link
4747 appendwithlinks $headers {}
4748 if {$showneartags} {
4749 if {![info exists allcommits]} {
4750 getallcommits
4752 $ctext insert end "[mc "Branch"]: "
4753 $ctext mark set branch "end -1c"
4754 $ctext mark gravity branch left
4755 $ctext insert end "\n[mc "Follows"]: "
4756 $ctext mark set follows "end -1c"
4757 $ctext mark gravity follows left
4758 $ctext insert end "\n[mc "Precedes"]: "
4759 $ctext mark set precedes "end -1c"
4760 $ctext mark gravity precedes left
4761 $ctext insert end "\n"
4762 dispneartags 1
4764 $ctext insert end "\n"
4765 set comment [lindex $info 5]
4766 if {[string first "\r" $comment] >= 0} {
4767 set comment [string map {"\r" "\n "} $comment]
4769 appendwithlinks $comment {comment}
4771 $ctext tag remove found 1.0 end
4772 $ctext conf -state disabled
4773 set commentend [$ctext index "end - 1c"]
4775 init_flist [mc "Comments"]
4776 if {$cmitmode eq "tree"} {
4777 gettree $id
4778 } elseif {[llength $olds] <= 1} {
4779 startdiff $id
4780 } else {
4781 mergediff $id $l
4785 proc selfirstline {} {
4786 unmarkmatches
4787 selectline 0 1
4790 proc sellastline {} {
4791 global numcommits
4792 unmarkmatches
4793 set l [expr {$numcommits - 1}]
4794 selectline $l 1
4797 proc selnextline {dir} {
4798 global selectedline
4799 focus .
4800 if {![info exists selectedline]} return
4801 set l [expr {$selectedline + $dir}]
4802 unmarkmatches
4803 selectline $l 1
4806 proc selnextpage {dir} {
4807 global canv linespc selectedline numcommits
4809 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4810 if {$lpp < 1} {
4811 set lpp 1
4813 allcanvs yview scroll [expr {$dir * $lpp}] units
4814 drawvisible
4815 if {![info exists selectedline]} return
4816 set l [expr {$selectedline + $dir * $lpp}]
4817 if {$l < 0} {
4818 set l 0
4819 } elseif {$l >= $numcommits} {
4820 set l [expr $numcommits - 1]
4822 unmarkmatches
4823 selectline $l 1
4826 proc unselectline {} {
4827 global selectedline currentid
4829 catch {unset selectedline}
4830 catch {unset currentid}
4831 allcanvs delete secsel
4832 rhighlight_none
4835 proc reselectline {} {
4836 global selectedline
4838 if {[info exists selectedline]} {
4839 selectline $selectedline 0
4843 proc addtohistory {cmd} {
4844 global history historyindex curview
4846 set elt [list $curview $cmd]
4847 if {$historyindex > 0
4848 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4849 return
4852 if {$historyindex < [llength $history]} {
4853 set history [lreplace $history $historyindex end $elt]
4854 } else {
4855 lappend history $elt
4857 incr historyindex
4858 if {$historyindex > 1} {
4859 .tf.bar.leftbut conf -state normal
4860 } else {
4861 .tf.bar.leftbut conf -state disabled
4863 .tf.bar.rightbut conf -state disabled
4866 proc godo {elt} {
4867 global curview
4869 set view [lindex $elt 0]
4870 set cmd [lindex $elt 1]
4871 if {$curview != $view} {
4872 showview $view
4874 eval $cmd
4877 proc goback {} {
4878 global history historyindex
4879 focus .
4881 if {$historyindex > 1} {
4882 incr historyindex -1
4883 godo [lindex $history [expr {$historyindex - 1}]]
4884 .tf.bar.rightbut conf -state normal
4886 if {$historyindex <= 1} {
4887 .tf.bar.leftbut conf -state disabled
4891 proc goforw {} {
4892 global history historyindex
4893 focus .
4895 if {$historyindex < [llength $history]} {
4896 set cmd [lindex $history $historyindex]
4897 incr historyindex
4898 godo $cmd
4899 .tf.bar.leftbut conf -state normal
4901 if {$historyindex >= [llength $history]} {
4902 .tf.bar.rightbut conf -state disabled
4906 proc gettree {id} {
4907 global treefilelist treeidlist diffids diffmergeid treepending
4908 global nullid nullid2
4910 set diffids $id
4911 catch {unset diffmergeid}
4912 if {![info exists treefilelist($id)]} {
4913 if {![info exists treepending]} {
4914 if {$id eq $nullid} {
4915 set cmd [list | git ls-files]
4916 } elseif {$id eq $nullid2} {
4917 set cmd [list | git ls-files --stage -t]
4918 } else {
4919 set cmd [list | git ls-tree -r $id]
4921 if {[catch {set gtf [open $cmd r]}]} {
4922 return
4924 set treepending $id
4925 set treefilelist($id) {}
4926 set treeidlist($id) {}
4927 fconfigure $gtf -blocking 0
4928 filerun $gtf [list gettreeline $gtf $id]
4930 } else {
4931 setfilelist $id
4935 proc gettreeline {gtf id} {
4936 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4938 set nl 0
4939 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4940 if {$diffids eq $nullid} {
4941 set fname $line
4942 } else {
4943 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4944 set i [string first "\t" $line]
4945 if {$i < 0} continue
4946 set sha1 [lindex $line 2]
4947 set fname [string range $line [expr {$i+1}] end]
4948 if {[string index $fname 0] eq "\""} {
4949 set fname [lindex $fname 0]
4951 lappend treeidlist($id) $sha1
4953 lappend treefilelist($id) $fname
4955 if {![eof $gtf]} {
4956 return [expr {$nl >= 1000? 2: 1}]
4958 close $gtf
4959 unset treepending
4960 if {$cmitmode ne "tree"} {
4961 if {![info exists diffmergeid]} {
4962 gettreediffs $diffids
4964 } elseif {$id ne $diffids} {
4965 gettree $diffids
4966 } else {
4967 setfilelist $id
4969 return 0
4972 proc showfile {f} {
4973 global treefilelist treeidlist diffids nullid nullid2
4974 global ctext commentend
4976 set i [lsearch -exact $treefilelist($diffids) $f]
4977 if {$i < 0} {
4978 puts "oops, $f not in list for id $diffids"
4979 return
4981 if {$diffids eq $nullid} {
4982 if {[catch {set bf [open $f r]} err]} {
4983 puts "oops, can't read $f: $err"
4984 return
4986 } else {
4987 set blob [lindex $treeidlist($diffids) $i]
4988 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4989 puts "oops, error reading blob $blob: $err"
4990 return
4993 fconfigure $bf -blocking 0
4994 filerun $bf [list getblobline $bf $diffids]
4995 $ctext config -state normal
4996 clear_ctext $commentend
4997 $ctext insert end "\n"
4998 $ctext insert end "$f\n" filesep
4999 $ctext config -state disabled
5000 $ctext yview $commentend
5001 settabs 0
5004 proc getblobline {bf id} {
5005 global diffids cmitmode ctext
5007 if {$id ne $diffids || $cmitmode ne "tree"} {
5008 catch {close $bf}
5009 return 0
5011 $ctext config -state normal
5012 set nl 0
5013 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5014 $ctext insert end "$line\n"
5016 if {[eof $bf]} {
5017 # delete last newline
5018 $ctext delete "end - 2c" "end - 1c"
5019 close $bf
5020 return 0
5022 $ctext config -state disabled
5023 return [expr {$nl >= 1000? 2: 1}]
5026 proc mergediff {id l} {
5027 global diffmergeid mdifffd
5028 global diffids
5029 global parentlist
5030 global limitdiffs viewfiles curview
5032 set diffmergeid $id
5033 set diffids $id
5034 # this doesn't seem to actually affect anything...
5035 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5036 if {$limitdiffs && $viewfiles($curview) ne {}} {
5037 set cmd [concat $cmd -- $viewfiles($curview)]
5039 if {[catch {set mdf [open $cmd r]} err]} {
5040 error_popup "[mc "Error getting merge diffs:"] $err"
5041 return
5043 fconfigure $mdf -blocking 0
5044 set mdifffd($id) $mdf
5045 set np [llength [lindex $parentlist $l]]
5046 settabs $np
5047 filerun $mdf [list getmergediffline $mdf $id $np]
5050 proc getmergediffline {mdf id np} {
5051 global diffmergeid ctext cflist mergemax
5052 global difffilestart mdifffd
5054 $ctext conf -state normal
5055 set nr 0
5056 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5057 if {![info exists diffmergeid] || $id != $diffmergeid
5058 || $mdf != $mdifffd($id)} {
5059 close $mdf
5060 return 0
5062 if {[regexp {^diff --cc (.*)} $line match fname]} {
5063 # start of a new file
5064 $ctext insert end "\n"
5065 set here [$ctext index "end - 1c"]
5066 lappend difffilestart $here
5067 add_flist [list $fname]
5068 set l [expr {(78 - [string length $fname]) / 2}]
5069 set pad [string range "----------------------------------------" 1 $l]
5070 $ctext insert end "$pad $fname $pad\n" filesep
5071 } elseif {[regexp {^@@} $line]} {
5072 $ctext insert end "$line\n" hunksep
5073 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5074 # do nothing
5075 } else {
5076 # parse the prefix - one ' ', '-' or '+' for each parent
5077 set spaces {}
5078 set minuses {}
5079 set pluses {}
5080 set isbad 0
5081 for {set j 0} {$j < $np} {incr j} {
5082 set c [string range $line $j $j]
5083 if {$c == " "} {
5084 lappend spaces $j
5085 } elseif {$c == "-"} {
5086 lappend minuses $j
5087 } elseif {$c == "+"} {
5088 lappend pluses $j
5089 } else {
5090 set isbad 1
5091 break
5094 set tags {}
5095 set num {}
5096 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5097 # line doesn't appear in result, parents in $minuses have the line
5098 set num [lindex $minuses 0]
5099 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5100 # line appears in result, parents in $pluses don't have the line
5101 lappend tags mresult
5102 set num [lindex $spaces 0]
5104 if {$num ne {}} {
5105 if {$num >= $mergemax} {
5106 set num "max"
5108 lappend tags m$num
5110 $ctext insert end "$line\n" $tags
5113 $ctext conf -state disabled
5114 if {[eof $mdf]} {
5115 close $mdf
5116 return 0
5118 return [expr {$nr >= 1000? 2: 1}]
5121 proc startdiff {ids} {
5122 global treediffs diffids treepending diffmergeid nullid nullid2
5124 settabs 1
5125 set diffids $ids
5126 catch {unset diffmergeid}
5127 if {![info exists treediffs($ids)] ||
5128 [lsearch -exact $ids $nullid] >= 0 ||
5129 [lsearch -exact $ids $nullid2] >= 0} {
5130 if {![info exists treepending]} {
5131 gettreediffs $ids
5133 } else {
5134 addtocflist $ids
5138 proc path_filter {filter name} {
5139 foreach p $filter {
5140 set l [string length $p]
5141 if {[string index $p end] eq "/"} {
5142 if {[string compare -length $l $p $name] == 0} {
5143 return 1
5145 } else {
5146 if {[string compare -length $l $p $name] == 0 &&
5147 ([string length $name] == $l ||
5148 [string index $name $l] eq "/")} {
5149 return 1
5153 return 0
5156 proc addtocflist {ids} {
5157 global treediffs
5159 add_flist $treediffs($ids)
5160 getblobdiffs $ids
5163 proc diffcmd {ids flags} {
5164 global nullid nullid2
5166 set i [lsearch -exact $ids $nullid]
5167 set j [lsearch -exact $ids $nullid2]
5168 if {$i >= 0} {
5169 if {[llength $ids] > 1 && $j < 0} {
5170 # comparing working directory with some specific revision
5171 set cmd [concat | git diff-index $flags]
5172 if {$i == 0} {
5173 lappend cmd -R [lindex $ids 1]
5174 } else {
5175 lappend cmd [lindex $ids 0]
5177 } else {
5178 # comparing working directory with index
5179 set cmd [concat | git diff-files $flags]
5180 if {$j == 1} {
5181 lappend cmd -R
5184 } elseif {$j >= 0} {
5185 set cmd [concat | git diff-index --cached $flags]
5186 if {[llength $ids] > 1} {
5187 # comparing index with specific revision
5188 if {$i == 0} {
5189 lappend cmd -R [lindex $ids 1]
5190 } else {
5191 lappend cmd [lindex $ids 0]
5193 } else {
5194 # comparing index with HEAD
5195 lappend cmd HEAD
5197 } else {
5198 set cmd [concat | git diff-tree -r $flags $ids]
5200 return $cmd
5203 proc gettreediffs {ids} {
5204 global treediff treepending
5206 set treepending $ids
5207 set treediff {}
5208 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5209 fconfigure $gdtf -blocking 0
5210 filerun $gdtf [list gettreediffline $gdtf $ids]
5213 proc gettreediffline {gdtf ids} {
5214 global treediff treediffs treepending diffids diffmergeid
5215 global cmitmode viewfiles curview limitdiffs
5217 set nr 0
5218 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5219 set i [string first "\t" $line]
5220 if {$i >= 0} {
5221 set file [string range $line [expr {$i+1}] end]
5222 if {[string index $file 0] eq "\""} {
5223 set file [lindex $file 0]
5225 lappend treediff $file
5228 if {![eof $gdtf]} {
5229 return [expr {$nr >= 1000? 2: 1}]
5231 close $gdtf
5232 if {$limitdiffs && $viewfiles($curview) ne {}} {
5233 set flist {}
5234 foreach f $treediff {
5235 if {[path_filter $viewfiles($curview) $f]} {
5236 lappend flist $f
5239 set treediffs($ids) $flist
5240 } else {
5241 set treediffs($ids) $treediff
5243 unset treepending
5244 if {$cmitmode eq "tree"} {
5245 gettree $diffids
5246 } elseif {$ids != $diffids} {
5247 if {![info exists diffmergeid]} {
5248 gettreediffs $diffids
5250 } else {
5251 addtocflist $ids
5253 return 0
5256 # empty string or positive integer
5257 proc diffcontextvalidate {v} {
5258 return [regexp {^(|[1-9][0-9]*)$} $v]
5261 proc diffcontextchange {n1 n2 op} {
5262 global diffcontextstring diffcontext
5264 if {[string is integer -strict $diffcontextstring]} {
5265 if {$diffcontextstring > 0} {
5266 set diffcontext $diffcontextstring
5267 reselectline
5272 proc getblobdiffs {ids} {
5273 global blobdifffd diffids env
5274 global diffinhdr treediffs
5275 global diffcontext
5276 global limitdiffs viewfiles curview
5278 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5279 if {$limitdiffs && $viewfiles($curview) ne {}} {
5280 set cmd [concat $cmd -- $viewfiles($curview)]
5282 if {[catch {set bdf [open $cmd r]} err]} {
5283 puts "error getting diffs: $err"
5284 return
5286 set diffinhdr 0
5287 fconfigure $bdf -blocking 0
5288 set blobdifffd($ids) $bdf
5289 filerun $bdf [list getblobdiffline $bdf $diffids]
5292 proc setinlist {var i val} {
5293 global $var
5295 while {[llength [set $var]] < $i} {
5296 lappend $var {}
5298 if {[llength [set $var]] == $i} {
5299 lappend $var $val
5300 } else {
5301 lset $var $i $val
5305 proc makediffhdr {fname ids} {
5306 global ctext curdiffstart treediffs
5308 set i [lsearch -exact $treediffs($ids) $fname]
5309 if {$i >= 0} {
5310 setinlist difffilestart $i $curdiffstart
5312 set l [expr {(78 - [string length $fname]) / 2}]
5313 set pad [string range "----------------------------------------" 1 $l]
5314 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5317 proc getblobdiffline {bdf ids} {
5318 global diffids blobdifffd ctext curdiffstart
5319 global diffnexthead diffnextnote difffilestart
5320 global diffinhdr treediffs
5322 set nr 0
5323 $ctext conf -state normal
5324 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5325 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5326 close $bdf
5327 return 0
5329 if {![string compare -length 11 "diff --git " $line]} {
5330 # trim off "diff --git "
5331 set line [string range $line 11 end]
5332 set diffinhdr 1
5333 # start of a new file
5334 $ctext insert end "\n"
5335 set curdiffstart [$ctext index "end - 1c"]
5336 $ctext insert end "\n" filesep
5337 # If the name hasn't changed the length will be odd,
5338 # the middle char will be a space, and the two bits either
5339 # side will be a/name and b/name, or "a/name" and "b/name".
5340 # If the name has changed we'll get "rename from" and
5341 # "rename to" or "copy from" and "copy to" lines following this,
5342 # and we'll use them to get the filenames.
5343 # This complexity is necessary because spaces in the filename(s)
5344 # don't get escaped.
5345 set l [string length $line]
5346 set i [expr {$l / 2}]
5347 if {!(($l & 1) && [string index $line $i] eq " " &&
5348 [string range $line 2 [expr {$i - 1}]] eq \
5349 [string range $line [expr {$i + 3}] end])} {
5350 continue
5352 # unescape if quoted and chop off the a/ from the front
5353 if {[string index $line 0] eq "\""} {
5354 set fname [string range [lindex $line 0] 2 end]
5355 } else {
5356 set fname [string range $line 2 [expr {$i - 1}]]
5358 makediffhdr $fname $ids
5360 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5361 $line match f1l f1c f2l f2c rest]} {
5362 $ctext insert end "$line\n" hunksep
5363 set diffinhdr 0
5365 } elseif {$diffinhdr} {
5366 if {![string compare -length 12 "rename from " $line]} {
5367 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5368 if {[string index $fname 0] eq "\""} {
5369 set fname [lindex $fname 0]
5371 set i [lsearch -exact $treediffs($ids) $fname]
5372 if {$i >= 0} {
5373 setinlist difffilestart $i $curdiffstart
5375 } elseif {![string compare -length 10 $line "rename to "] ||
5376 ![string compare -length 8 $line "copy to "]} {
5377 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5378 if {[string index $fname 0] eq "\""} {
5379 set fname [lindex $fname 0]
5381 makediffhdr $fname $ids
5382 } elseif {[string compare -length 3 $line "---"] == 0} {
5383 # do nothing
5384 continue
5385 } elseif {[string compare -length 3 $line "+++"] == 0} {
5386 set diffinhdr 0
5387 continue
5389 $ctext insert end "$line\n" filesep
5391 } else {
5392 set x [string range $line 0 0]
5393 if {$x == "-" || $x == "+"} {
5394 set tag [expr {$x == "+"}]
5395 $ctext insert end "$line\n" d$tag
5396 } elseif {$x == " "} {
5397 $ctext insert end "$line\n"
5398 } else {
5399 # "\ No newline at end of file",
5400 # or something else we don't recognize
5401 $ctext insert end "$line\n" hunksep
5405 $ctext conf -state disabled
5406 if {[eof $bdf]} {
5407 close $bdf
5408 return 0
5410 return [expr {$nr >= 1000? 2: 1}]
5413 proc changediffdisp {} {
5414 global ctext diffelide
5416 $ctext tag conf d0 -elide [lindex $diffelide 0]
5417 $ctext tag conf d1 -elide [lindex $diffelide 1]
5420 proc prevfile {} {
5421 global difffilestart ctext
5422 set prev [lindex $difffilestart 0]
5423 set here [$ctext index @0,0]
5424 foreach loc $difffilestart {
5425 if {[$ctext compare $loc >= $here]} {
5426 $ctext yview $prev
5427 return
5429 set prev $loc
5431 $ctext yview $prev
5434 proc nextfile {} {
5435 global difffilestart ctext
5436 set here [$ctext index @0,0]
5437 foreach loc $difffilestart {
5438 if {[$ctext compare $loc > $here]} {
5439 $ctext yview $loc
5440 return
5445 proc clear_ctext {{first 1.0}} {
5446 global ctext smarktop smarkbot
5447 global pendinglinks
5449 set l [lindex [split $first .] 0]
5450 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5451 set smarktop $l
5453 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5454 set smarkbot $l
5456 $ctext delete $first end
5457 if {$first eq "1.0"} {
5458 catch {unset pendinglinks}
5462 proc settabs {{firstab {}}} {
5463 global firsttabstop tabstop ctext have_tk85
5465 if {$firstab ne {} && $have_tk85} {
5466 set firsttabstop $firstab
5468 set w [font measure textfont "0"]
5469 if {$firsttabstop != 0} {
5470 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5471 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5472 } elseif {$have_tk85 || $tabstop != 8} {
5473 $ctext conf -tabs [expr {$tabstop * $w}]
5474 } else {
5475 $ctext conf -tabs {}
5479 proc incrsearch {name ix op} {
5480 global ctext searchstring searchdirn
5482 $ctext tag remove found 1.0 end
5483 if {[catch {$ctext index anchor}]} {
5484 # no anchor set, use start of selection, or of visible area
5485 set sel [$ctext tag ranges sel]
5486 if {$sel ne {}} {
5487 $ctext mark set anchor [lindex $sel 0]
5488 } elseif {$searchdirn eq "-forwards"} {
5489 $ctext mark set anchor @0,0
5490 } else {
5491 $ctext mark set anchor @0,[winfo height $ctext]
5494 if {$searchstring ne {}} {
5495 set here [$ctext search $searchdirn -- $searchstring anchor]
5496 if {$here ne {}} {
5497 $ctext see $here
5499 searchmarkvisible 1
5503 proc dosearch {} {
5504 global sstring ctext searchstring searchdirn
5506 focus $sstring
5507 $sstring icursor end
5508 set searchdirn -forwards
5509 if {$searchstring ne {}} {
5510 set sel [$ctext tag ranges sel]
5511 if {$sel ne {}} {
5512 set start "[lindex $sel 0] + 1c"
5513 } elseif {[catch {set start [$ctext index anchor]}]} {
5514 set start "@0,0"
5516 set match [$ctext search -count mlen -- $searchstring $start]
5517 $ctext tag remove sel 1.0 end
5518 if {$match eq {}} {
5519 bell
5520 return
5522 $ctext see $match
5523 set mend "$match + $mlen c"
5524 $ctext tag add sel $match $mend
5525 $ctext mark unset anchor
5529 proc dosearchback {} {
5530 global sstring ctext searchstring searchdirn
5532 focus $sstring
5533 $sstring icursor end
5534 set searchdirn -backwards
5535 if {$searchstring ne {}} {
5536 set sel [$ctext tag ranges sel]
5537 if {$sel ne {}} {
5538 set start [lindex $sel 0]
5539 } elseif {[catch {set start [$ctext index anchor]}]} {
5540 set start @0,[winfo height $ctext]
5542 set match [$ctext search -backwards -count ml -- $searchstring $start]
5543 $ctext tag remove sel 1.0 end
5544 if {$match eq {}} {
5545 bell
5546 return
5548 $ctext see $match
5549 set mend "$match + $ml c"
5550 $ctext tag add sel $match $mend
5551 $ctext mark unset anchor
5555 proc searchmark {first last} {
5556 global ctext searchstring
5558 set mend $first.0
5559 while {1} {
5560 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5561 if {$match eq {}} break
5562 set mend "$match + $mlen c"
5563 $ctext tag add found $match $mend
5567 proc searchmarkvisible {doall} {
5568 global ctext smarktop smarkbot
5570 set topline [lindex [split [$ctext index @0,0] .] 0]
5571 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5572 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5573 # no overlap with previous
5574 searchmark $topline $botline
5575 set smarktop $topline
5576 set smarkbot $botline
5577 } else {
5578 if {$topline < $smarktop} {
5579 searchmark $topline [expr {$smarktop-1}]
5580 set smarktop $topline
5582 if {$botline > $smarkbot} {
5583 searchmark [expr {$smarkbot+1}] $botline
5584 set smarkbot $botline
5589 proc scrolltext {f0 f1} {
5590 global searchstring
5592 .bleft.sb set $f0 $f1
5593 if {$searchstring ne {}} {
5594 searchmarkvisible 0
5598 proc setcoords {} {
5599 global linespc charspc canvx0 canvy0
5600 global xspc1 xspc2 lthickness
5602 set linespc [font metrics mainfont -linespace]
5603 set charspc [font measure mainfont "m"]
5604 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5605 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5606 set lthickness [expr {int($linespc / 9) + 1}]
5607 set xspc1(0) $linespc
5608 set xspc2 $linespc
5611 proc redisplay {} {
5612 global canv
5613 global selectedline
5615 set ymax [lindex [$canv cget -scrollregion] 3]
5616 if {$ymax eq {} || $ymax == 0} return
5617 set span [$canv yview]
5618 clear_display
5619 setcanvscroll
5620 allcanvs yview moveto [lindex $span 0]
5621 drawvisible
5622 if {[info exists selectedline]} {
5623 selectline $selectedline 0
5624 allcanvs yview moveto [lindex $span 0]
5628 proc parsefont {f n} {
5629 global fontattr
5631 set fontattr($f,family) [lindex $n 0]
5632 set s [lindex $n 1]
5633 if {$s eq {} || $s == 0} {
5634 set s 10
5635 } elseif {$s < 0} {
5636 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5638 set fontattr($f,size) $s
5639 set fontattr($f,weight) normal
5640 set fontattr($f,slant) roman
5641 foreach style [lrange $n 2 end] {
5642 switch -- $style {
5643 "normal" -
5644 "bold" {set fontattr($f,weight) $style}
5645 "roman" -
5646 "italic" {set fontattr($f,slant) $style}
5651 proc fontflags {f {isbold 0}} {
5652 global fontattr
5654 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5655 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5656 -slant $fontattr($f,slant)]
5659 proc fontname {f} {
5660 global fontattr
5662 set n [list $fontattr($f,family) $fontattr($f,size)]
5663 if {$fontattr($f,weight) eq "bold"} {
5664 lappend n "bold"
5666 if {$fontattr($f,slant) eq "italic"} {
5667 lappend n "italic"
5669 return $n
5672 proc incrfont {inc} {
5673 global mainfont textfont ctext canv phase cflist showrefstop
5674 global stopped entries fontattr
5676 unmarkmatches
5677 set s $fontattr(mainfont,size)
5678 incr s $inc
5679 if {$s < 1} {
5680 set s 1
5682 set fontattr(mainfont,size) $s
5683 font config mainfont -size $s
5684 font config mainfontbold -size $s
5685 set mainfont [fontname mainfont]
5686 set s $fontattr(textfont,size)
5687 incr s $inc
5688 if {$s < 1} {
5689 set s 1
5691 set fontattr(textfont,size) $s
5692 font config textfont -size $s
5693 font config textfontbold -size $s
5694 set textfont [fontname textfont]
5695 setcoords
5696 settabs
5697 redisplay
5700 proc clearsha1 {} {
5701 global sha1entry sha1string
5702 if {[string length $sha1string] == 40} {
5703 $sha1entry delete 0 end
5707 proc sha1change {n1 n2 op} {
5708 global sha1string currentid sha1but
5709 if {$sha1string == {}
5710 || ([info exists currentid] && $sha1string == $currentid)} {
5711 set state disabled
5712 } else {
5713 set state normal
5715 if {[$sha1but cget -state] == $state} return
5716 if {$state == "normal"} {
5717 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5718 } else {
5719 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5723 proc gotocommit {} {
5724 global sha1string currentid commitrow tagids headids
5725 global displayorder numcommits curview
5727 if {$sha1string == {}
5728 || ([info exists currentid] && $sha1string == $currentid)} return
5729 if {[info exists tagids($sha1string)]} {
5730 set id $tagids($sha1string)
5731 } elseif {[info exists headids($sha1string)]} {
5732 set id $headids($sha1string)
5733 } else {
5734 set id [string tolower $sha1string]
5735 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5736 set matches {}
5737 foreach i $displayorder {
5738 if {[string match $id* $i]} {
5739 lappend matches $i
5742 if {$matches ne {}} {
5743 if {[llength $matches] > 1} {
5744 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5745 return
5747 set id [lindex $matches 0]
5751 if {[info exists commitrow($curview,$id)]} {
5752 selectline $commitrow($curview,$id) 1
5753 return
5755 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5756 set msg [mc "SHA1 id %s is not known" $sha1string]
5757 } else {
5758 set msg [mc "Tag/Head %s is not known" $sha1string]
5760 error_popup $msg
5763 proc lineenter {x y id} {
5764 global hoverx hovery hoverid hovertimer
5765 global commitinfo canv
5767 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5768 set hoverx $x
5769 set hovery $y
5770 set hoverid $id
5771 if {[info exists hovertimer]} {
5772 after cancel $hovertimer
5774 set hovertimer [after 500 linehover]
5775 $canv delete hover
5778 proc linemotion {x y id} {
5779 global hoverx hovery hoverid hovertimer
5781 if {[info exists hoverid] && $id == $hoverid} {
5782 set hoverx $x
5783 set hovery $y
5784 if {[info exists hovertimer]} {
5785 after cancel $hovertimer
5787 set hovertimer [after 500 linehover]
5791 proc lineleave {id} {
5792 global hoverid hovertimer canv
5794 if {[info exists hoverid] && $id == $hoverid} {
5795 $canv delete hover
5796 if {[info exists hovertimer]} {
5797 after cancel $hovertimer
5798 unset hovertimer
5800 unset hoverid
5804 proc linehover {} {
5805 global hoverx hovery hoverid hovertimer
5806 global canv linespc lthickness
5807 global commitinfo
5809 set text [lindex $commitinfo($hoverid) 0]
5810 set ymax [lindex [$canv cget -scrollregion] 3]
5811 if {$ymax == {}} return
5812 set yfrac [lindex [$canv yview] 0]
5813 set x [expr {$hoverx + 2 * $linespc}]
5814 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5815 set x0 [expr {$x - 2 * $lthickness}]
5816 set y0 [expr {$y - 2 * $lthickness}]
5817 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5818 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5819 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5820 -fill \#ffff80 -outline black -width 1 -tags hover]
5821 $canv raise $t
5822 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5823 -font mainfont]
5824 $canv raise $t
5827 proc clickisonarrow {id y} {
5828 global lthickness
5830 set ranges [rowranges $id]
5831 set thresh [expr {2 * $lthickness + 6}]
5832 set n [expr {[llength $ranges] - 1}]
5833 for {set i 1} {$i < $n} {incr i} {
5834 set row [lindex $ranges $i]
5835 if {abs([yc $row] - $y) < $thresh} {
5836 return $i
5839 return {}
5842 proc arrowjump {id n y} {
5843 global canv
5845 # 1 <-> 2, 3 <-> 4, etc...
5846 set n [expr {(($n - 1) ^ 1) + 1}]
5847 set row [lindex [rowranges $id] $n]
5848 set yt [yc $row]
5849 set ymax [lindex [$canv cget -scrollregion] 3]
5850 if {$ymax eq {} || $ymax <= 0} return
5851 set view [$canv yview]
5852 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5853 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5854 if {$yfrac < 0} {
5855 set yfrac 0
5857 allcanvs yview moveto $yfrac
5860 proc lineclick {x y id isnew} {
5861 global ctext commitinfo children canv thickerline curview commitrow
5863 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5864 unmarkmatches
5865 unselectline
5866 normalline
5867 $canv delete hover
5868 # draw this line thicker than normal
5869 set thickerline $id
5870 drawlines $id
5871 if {$isnew} {
5872 set ymax [lindex [$canv cget -scrollregion] 3]
5873 if {$ymax eq {}} return
5874 set yfrac [lindex [$canv yview] 0]
5875 set y [expr {$y + $yfrac * $ymax}]
5877 set dirn [clickisonarrow $id $y]
5878 if {$dirn ne {}} {
5879 arrowjump $id $dirn $y
5880 return
5883 if {$isnew} {
5884 addtohistory [list lineclick $x $y $id 0]
5886 # fill the details pane with info about this line
5887 $ctext conf -state normal
5888 clear_ctext
5889 settabs 0
5890 $ctext insert end "[mc "Parent"]:\t"
5891 $ctext insert end $id link0
5892 setlink $id link0
5893 set info $commitinfo($id)
5894 $ctext insert end "\n\t[lindex $info 0]\n"
5895 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5896 set date [formatdate [lindex $info 2]]
5897 $ctext insert end "\t[mc "Date"]:\t$date\n"
5898 set kids $children($curview,$id)
5899 if {$kids ne {}} {
5900 $ctext insert end "\n[mc "Children"]:"
5901 set i 0
5902 foreach child $kids {
5903 incr i
5904 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5905 set info $commitinfo($child)
5906 $ctext insert end "\n\t"
5907 $ctext insert end $child link$i
5908 setlink $child link$i
5909 $ctext insert end "\n\t[lindex $info 0]"
5910 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5911 set date [formatdate [lindex $info 2]]
5912 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5915 $ctext conf -state disabled
5916 init_flist {}
5919 proc normalline {} {
5920 global thickerline
5921 if {[info exists thickerline]} {
5922 set id $thickerline
5923 unset thickerline
5924 drawlines $id
5928 proc selbyid {id} {
5929 global commitrow curview
5930 if {[info exists commitrow($curview,$id)]} {
5931 selectline $commitrow($curview,$id) 1
5935 proc mstime {} {
5936 global startmstime
5937 if {![info exists startmstime]} {
5938 set startmstime [clock clicks -milliseconds]
5940 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5943 proc rowmenu {x y id} {
5944 global rowctxmenu commitrow selectedline rowmenuid curview
5945 global nullid nullid2 fakerowmenu mainhead
5947 stopfinding
5948 set rowmenuid $id
5949 if {![info exists selectedline]
5950 || $commitrow($curview,$id) eq $selectedline} {
5951 set state disabled
5952 } else {
5953 set state normal
5955 if {$id ne $nullid && $id ne $nullid2} {
5956 set menu $rowctxmenu
5957 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
5958 } else {
5959 set menu $fakerowmenu
5961 $menu entryconfigure [mc "Diff this -> selected"] -state $state
5962 $menu entryconfigure [mc "Diff selected -> this"] -state $state
5963 $menu entryconfigure [mc "Make patch"] -state $state
5964 tk_popup $menu $x $y
5967 proc diffvssel {dirn} {
5968 global rowmenuid selectedline displayorder
5970 if {![info exists selectedline]} return
5971 if {$dirn} {
5972 set oldid [lindex $displayorder $selectedline]
5973 set newid $rowmenuid
5974 } else {
5975 set oldid $rowmenuid
5976 set newid [lindex $displayorder $selectedline]
5978 addtohistory [list doseldiff $oldid $newid]
5979 doseldiff $oldid $newid
5982 proc doseldiff {oldid newid} {
5983 global ctext
5984 global commitinfo
5986 $ctext conf -state normal
5987 clear_ctext
5988 init_flist [mc "Top"]
5989 $ctext insert end "[mc "From"] "
5990 $ctext insert end $oldid link0
5991 setlink $oldid link0
5992 $ctext insert end "\n "
5993 $ctext insert end [lindex $commitinfo($oldid) 0]
5994 $ctext insert end "\n\n[mc "To"] "
5995 $ctext insert end $newid link1
5996 setlink $newid link1
5997 $ctext insert end "\n "
5998 $ctext insert end [lindex $commitinfo($newid) 0]
5999 $ctext insert end "\n"
6000 $ctext conf -state disabled
6001 $ctext tag remove found 1.0 end
6002 startdiff [list $oldid $newid]
6005 proc mkpatch {} {
6006 global rowmenuid currentid commitinfo patchtop patchnum
6008 if {![info exists currentid]} return
6009 set oldid $currentid
6010 set oldhead [lindex $commitinfo($oldid) 0]
6011 set newid $rowmenuid
6012 set newhead [lindex $commitinfo($newid) 0]
6013 set top .patch
6014 set patchtop $top
6015 catch {destroy $top}
6016 toplevel $top
6017 label $top.title -text [mc "Generate patch"]
6018 grid $top.title - -pady 10
6019 label $top.from -text [mc "From:"]
6020 entry $top.fromsha1 -width 40 -relief flat
6021 $top.fromsha1 insert 0 $oldid
6022 $top.fromsha1 conf -state readonly
6023 grid $top.from $top.fromsha1 -sticky w
6024 entry $top.fromhead -width 60 -relief flat
6025 $top.fromhead insert 0 $oldhead
6026 $top.fromhead conf -state readonly
6027 grid x $top.fromhead -sticky w
6028 label $top.to -text [mc "To:"]
6029 entry $top.tosha1 -width 40 -relief flat
6030 $top.tosha1 insert 0 $newid
6031 $top.tosha1 conf -state readonly
6032 grid $top.to $top.tosha1 -sticky w
6033 entry $top.tohead -width 60 -relief flat
6034 $top.tohead insert 0 $newhead
6035 $top.tohead conf -state readonly
6036 grid x $top.tohead -sticky w
6037 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6038 grid $top.rev x -pady 10
6039 label $top.flab -text [mc "Output file:"]
6040 entry $top.fname -width 60
6041 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6042 incr patchnum
6043 grid $top.flab $top.fname -sticky w
6044 frame $top.buts
6045 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6046 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6047 grid $top.buts.gen $top.buts.can
6048 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6049 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6050 grid $top.buts - -pady 10 -sticky ew
6051 focus $top.fname
6054 proc mkpatchrev {} {
6055 global patchtop
6057 set oldid [$patchtop.fromsha1 get]
6058 set oldhead [$patchtop.fromhead get]
6059 set newid [$patchtop.tosha1 get]
6060 set newhead [$patchtop.tohead get]
6061 foreach e [list fromsha1 fromhead tosha1 tohead] \
6062 v [list $newid $newhead $oldid $oldhead] {
6063 $patchtop.$e conf -state normal
6064 $patchtop.$e delete 0 end
6065 $patchtop.$e insert 0 $v
6066 $patchtop.$e conf -state readonly
6070 proc mkpatchgo {} {
6071 global patchtop nullid nullid2
6073 set oldid [$patchtop.fromsha1 get]
6074 set newid [$patchtop.tosha1 get]
6075 set fname [$patchtop.fname get]
6076 set cmd [diffcmd [list $oldid $newid] -p]
6077 # trim off the initial "|"
6078 set cmd [lrange $cmd 1 end]
6079 lappend cmd >$fname &
6080 if {[catch {eval exec $cmd} err]} {
6081 error_popup "[mc "Error creating patch:"] $err"
6083 catch {destroy $patchtop}
6084 unset patchtop
6087 proc mkpatchcan {} {
6088 global patchtop
6090 catch {destroy $patchtop}
6091 unset patchtop
6094 proc mktag {} {
6095 global rowmenuid mktagtop commitinfo
6097 set top .maketag
6098 set mktagtop $top
6099 catch {destroy $top}
6100 toplevel $top
6101 label $top.title -text [mc "Create tag"]
6102 grid $top.title - -pady 10
6103 label $top.id -text [mc "ID:"]
6104 entry $top.sha1 -width 40 -relief flat
6105 $top.sha1 insert 0 $rowmenuid
6106 $top.sha1 conf -state readonly
6107 grid $top.id $top.sha1 -sticky w
6108 entry $top.head -width 60 -relief flat
6109 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6110 $top.head conf -state readonly
6111 grid x $top.head -sticky w
6112 label $top.tlab -text [mc "Tag name:"]
6113 entry $top.tag -width 60
6114 grid $top.tlab $top.tag -sticky w
6115 frame $top.buts
6116 button $top.buts.gen -text [mc "Create"] -command mktaggo
6117 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6118 grid $top.buts.gen $top.buts.can
6119 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6120 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6121 grid $top.buts - -pady 10 -sticky ew
6122 focus $top.tag
6125 proc domktag {} {
6126 global mktagtop env tagids idtags
6128 set id [$mktagtop.sha1 get]
6129 set tag [$mktagtop.tag get]
6130 if {$tag == {}} {
6131 error_popup [mc "No tag name specified"]
6132 return
6134 if {[info exists tagids($tag)]} {
6135 error_popup [mc "Tag \"%s\" already exists" $tag]
6136 return
6138 if {[catch {
6139 set dir [gitdir]
6140 set fname [file join $dir "refs/tags" $tag]
6141 set f [open $fname w]
6142 puts $f $id
6143 close $f
6144 } err]} {
6145 error_popup "[mc "Error creating tag:"] $err"
6146 return
6149 set tagids($tag) $id
6150 lappend idtags($id) $tag
6151 redrawtags $id
6152 addedtag $id
6153 dispneartags 0
6154 run refill_reflist
6157 proc redrawtags {id} {
6158 global canv linehtag commitrow idpos selectedline curview
6159 global canvxmax iddrawn
6161 if {![info exists commitrow($curview,$id)]} return
6162 if {![info exists iddrawn($id)]} return
6163 drawcommits $commitrow($curview,$id)
6164 $canv delete tag.$id
6165 set xt [eval drawtags $id $idpos($id)]
6166 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6167 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6168 set xr [expr {$xt + [font measure mainfont $text]}]
6169 if {$xr > $canvxmax} {
6170 set canvxmax $xr
6171 setcanvscroll
6173 if {[info exists selectedline]
6174 && $selectedline == $commitrow($curview,$id)} {
6175 selectline $selectedline 0
6179 proc mktagcan {} {
6180 global mktagtop
6182 catch {destroy $mktagtop}
6183 unset mktagtop
6186 proc mktaggo {} {
6187 domktag
6188 mktagcan
6191 proc writecommit {} {
6192 global rowmenuid wrcomtop commitinfo wrcomcmd
6194 set top .writecommit
6195 set wrcomtop $top
6196 catch {destroy $top}
6197 toplevel $top
6198 label $top.title -text [mc "Write commit to file"]
6199 grid $top.title - -pady 10
6200 label $top.id -text [mc "ID:"]
6201 entry $top.sha1 -width 40 -relief flat
6202 $top.sha1 insert 0 $rowmenuid
6203 $top.sha1 conf -state readonly
6204 grid $top.id $top.sha1 -sticky w
6205 entry $top.head -width 60 -relief flat
6206 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6207 $top.head conf -state readonly
6208 grid x $top.head -sticky w
6209 label $top.clab -text [mc "Command:"]
6210 entry $top.cmd -width 60 -textvariable wrcomcmd
6211 grid $top.clab $top.cmd -sticky w -pady 10
6212 label $top.flab -text [mc "Output file:"]
6213 entry $top.fname -width 60
6214 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6215 grid $top.flab $top.fname -sticky w
6216 frame $top.buts
6217 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6218 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6219 grid $top.buts.gen $top.buts.can
6220 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6221 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6222 grid $top.buts - -pady 10 -sticky ew
6223 focus $top.fname
6226 proc wrcomgo {} {
6227 global wrcomtop
6229 set id [$wrcomtop.sha1 get]
6230 set cmd "echo $id | [$wrcomtop.cmd get]"
6231 set fname [$wrcomtop.fname get]
6232 if {[catch {exec sh -c $cmd >$fname &} err]} {
6233 error_popup "[mc "Error writing commit:"] $err"
6235 catch {destroy $wrcomtop}
6236 unset wrcomtop
6239 proc wrcomcan {} {
6240 global wrcomtop
6242 catch {destroy $wrcomtop}
6243 unset wrcomtop
6246 proc mkbranch {} {
6247 global rowmenuid mkbrtop
6249 set top .makebranch
6250 catch {destroy $top}
6251 toplevel $top
6252 label $top.title -text [mc "Create new branch"]
6253 grid $top.title - -pady 10
6254 label $top.id -text [mc "ID:"]
6255 entry $top.sha1 -width 40 -relief flat
6256 $top.sha1 insert 0 $rowmenuid
6257 $top.sha1 conf -state readonly
6258 grid $top.id $top.sha1 -sticky w
6259 label $top.nlab -text [mc "Name:"]
6260 entry $top.name -width 40
6261 grid $top.nlab $top.name -sticky w
6262 frame $top.buts
6263 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6264 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6265 grid $top.buts.go $top.buts.can
6266 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6267 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6268 grid $top.buts - -pady 10 -sticky ew
6269 focus $top.name
6272 proc mkbrgo {top} {
6273 global headids idheads
6275 set name [$top.name get]
6276 set id [$top.sha1 get]
6277 if {$name eq {}} {
6278 error_popup [mc "Please specify a name for the new branch"]
6279 return
6281 catch {destroy $top}
6282 nowbusy newbranch
6283 update
6284 if {[catch {
6285 exec git branch $name $id
6286 } err]} {
6287 notbusy newbranch
6288 error_popup $err
6289 } else {
6290 set headids($name) $id
6291 lappend idheads($id) $name
6292 addedhead $id $name
6293 notbusy newbranch
6294 redrawtags $id
6295 dispneartags 0
6296 run refill_reflist
6300 proc cherrypick {} {
6301 global rowmenuid curview commitrow
6302 global mainhead
6304 set oldhead [exec git rev-parse HEAD]
6305 set dheads [descheads $rowmenuid]
6306 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6307 set ok [confirm_popup [mc "Commit %s is already\
6308 included in branch %s -- really re-apply it?" \
6309 [string range $rowmenuid 0 7] $mainhead]]
6310 if {!$ok} return
6312 nowbusy cherrypick [mc "Cherry-picking"]
6313 update
6314 # Unfortunately git-cherry-pick writes stuff to stderr even when
6315 # no error occurs, and exec takes that as an indication of error...
6316 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6317 notbusy cherrypick
6318 error_popup $err
6319 return
6321 set newhead [exec git rev-parse HEAD]
6322 if {$newhead eq $oldhead} {
6323 notbusy cherrypick
6324 error_popup [mc "No changes committed"]
6325 return
6327 addnewchild $newhead $oldhead
6328 if {[info exists commitrow($curview,$oldhead)]} {
6329 insertrow $commitrow($curview,$oldhead) $newhead
6330 if {$mainhead ne {}} {
6331 movehead $newhead $mainhead
6332 movedhead $newhead $mainhead
6334 redrawtags $oldhead
6335 redrawtags $newhead
6337 notbusy cherrypick
6340 proc resethead {} {
6341 global mainheadid mainhead rowmenuid confirm_ok resettype
6343 set confirm_ok 0
6344 set w ".confirmreset"
6345 toplevel $w
6346 wm transient $w .
6347 wm title $w [mc "Confirm reset"]
6348 message $w.m -text \
6349 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6350 -justify center -aspect 1000
6351 pack $w.m -side top -fill x -padx 20 -pady 20
6352 frame $w.f -relief sunken -border 2
6353 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6354 grid $w.f.rt -sticky w
6355 set resettype mixed
6356 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6357 -text [mc "Soft: Leave working tree and index untouched"]
6358 grid $w.f.soft -sticky w
6359 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6360 -text [mc "Mixed: Leave working tree untouched, reset index"]
6361 grid $w.f.mixed -sticky w
6362 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6363 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6364 grid $w.f.hard -sticky w
6365 pack $w.f -side top -fill x
6366 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6367 pack $w.ok -side left -fill x -padx 20 -pady 20
6368 button $w.cancel -text [mc Cancel] -command "destroy $w"
6369 pack $w.cancel -side right -fill x -padx 20 -pady 20
6370 bind $w <Visibility> "grab $w; focus $w"
6371 tkwait window $w
6372 if {!$confirm_ok} return
6373 if {[catch {set fd [open \
6374 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6375 error_popup $err
6376 } else {
6377 dohidelocalchanges
6378 filerun $fd [list readresetstat $fd]
6379 nowbusy reset [mc "Resetting"]
6383 proc readresetstat {fd} {
6384 global mainhead mainheadid showlocalchanges rprogcoord
6386 if {[gets $fd line] >= 0} {
6387 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6388 set rprogcoord [expr {1.0 * $m / $n}]
6389 adjustprogress
6391 return 1
6393 set rprogcoord 0
6394 adjustprogress
6395 notbusy reset
6396 if {[catch {close $fd} err]} {
6397 error_popup $err
6399 set oldhead $mainheadid
6400 set newhead [exec git rev-parse HEAD]
6401 if {$newhead ne $oldhead} {
6402 movehead $newhead $mainhead
6403 movedhead $newhead $mainhead
6404 set mainheadid $newhead
6405 redrawtags $oldhead
6406 redrawtags $newhead
6408 if {$showlocalchanges} {
6409 doshowlocalchanges
6411 return 0
6414 # context menu for a head
6415 proc headmenu {x y id head} {
6416 global headmenuid headmenuhead headctxmenu mainhead
6418 stopfinding
6419 set headmenuid $id
6420 set headmenuhead $head
6421 set state normal
6422 if {$head eq $mainhead} {
6423 set state disabled
6425 $headctxmenu entryconfigure 0 -state $state
6426 $headctxmenu entryconfigure 1 -state $state
6427 tk_popup $headctxmenu $x $y
6430 proc cobranch {} {
6431 global headmenuid headmenuhead mainhead headids
6432 global showlocalchanges mainheadid
6434 # check the tree is clean first??
6435 set oldmainhead $mainhead
6436 nowbusy checkout [mc "Checking out"]
6437 update
6438 dohidelocalchanges
6439 if {[catch {
6440 exec git checkout -q $headmenuhead
6441 } err]} {
6442 notbusy checkout
6443 error_popup $err
6444 } else {
6445 notbusy checkout
6446 set mainhead $headmenuhead
6447 set mainheadid $headmenuid
6448 if {[info exists headids($oldmainhead)]} {
6449 redrawtags $headids($oldmainhead)
6451 redrawtags $headmenuid
6453 if {$showlocalchanges} {
6454 dodiffindex
6458 proc rmbranch {} {
6459 global headmenuid headmenuhead mainhead
6460 global idheads
6462 set head $headmenuhead
6463 set id $headmenuid
6464 # this check shouldn't be needed any more...
6465 if {$head eq $mainhead} {
6466 error_popup [mc "Cannot delete the currently checked-out branch"]
6467 return
6469 set dheads [descheads $id]
6470 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6471 # the stuff on this branch isn't on any other branch
6472 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6473 branch.\nReally delete branch %s?" $head $head]]} return
6475 nowbusy rmbranch
6476 update
6477 if {[catch {exec git branch -D $head} err]} {
6478 notbusy rmbranch
6479 error_popup $err
6480 return
6482 removehead $id $head
6483 removedhead $id $head
6484 redrawtags $id
6485 notbusy rmbranch
6486 dispneartags 0
6487 run refill_reflist
6490 # Display a list of tags and heads
6491 proc showrefs {} {
6492 global showrefstop bgcolor fgcolor selectbgcolor
6493 global bglist fglist reflistfilter reflist maincursor
6495 set top .showrefs
6496 set showrefstop $top
6497 if {[winfo exists $top]} {
6498 raise $top
6499 refill_reflist
6500 return
6502 toplevel $top
6503 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6504 text $top.list -background $bgcolor -foreground $fgcolor \
6505 -selectbackground $selectbgcolor -font mainfont \
6506 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6507 -width 30 -height 20 -cursor $maincursor \
6508 -spacing1 1 -spacing3 1 -state disabled
6509 $top.list tag configure highlight -background $selectbgcolor
6510 lappend bglist $top.list
6511 lappend fglist $top.list
6512 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6513 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6514 grid $top.list $top.ysb -sticky nsew
6515 grid $top.xsb x -sticky ew
6516 frame $top.f
6517 label $top.f.l -text "[mc "Filter"]: "
6518 entry $top.f.e -width 20 -textvariable reflistfilter
6519 set reflistfilter "*"
6520 trace add variable reflistfilter write reflistfilter_change
6521 pack $top.f.e -side right -fill x -expand 1
6522 pack $top.f.l -side left
6523 grid $top.f - -sticky ew -pady 2
6524 button $top.close -command [list destroy $top] -text [mc "Close"]
6525 grid $top.close -
6526 grid columnconfigure $top 0 -weight 1
6527 grid rowconfigure $top 0 -weight 1
6528 bind $top.list <1> {break}
6529 bind $top.list <B1-Motion> {break}
6530 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6531 set reflist {}
6532 refill_reflist
6535 proc sel_reflist {w x y} {
6536 global showrefstop reflist headids tagids otherrefids
6538 if {![winfo exists $showrefstop]} return
6539 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6540 set ref [lindex $reflist [expr {$l-1}]]
6541 set n [lindex $ref 0]
6542 switch -- [lindex $ref 1] {
6543 "H" {selbyid $headids($n)}
6544 "T" {selbyid $tagids($n)}
6545 "o" {selbyid $otherrefids($n)}
6547 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6550 proc unsel_reflist {} {
6551 global showrefstop
6553 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6554 $showrefstop.list tag remove highlight 0.0 end
6557 proc reflistfilter_change {n1 n2 op} {
6558 global reflistfilter
6560 after cancel refill_reflist
6561 after 200 refill_reflist
6564 proc refill_reflist {} {
6565 global reflist reflistfilter showrefstop headids tagids otherrefids
6566 global commitrow curview commitinterest
6568 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6569 set refs {}
6570 foreach n [array names headids] {
6571 if {[string match $reflistfilter $n]} {
6572 if {[info exists commitrow($curview,$headids($n))]} {
6573 lappend refs [list $n H]
6574 } else {
6575 set commitinterest($headids($n)) {run refill_reflist}
6579 foreach n [array names tagids] {
6580 if {[string match $reflistfilter $n]} {
6581 if {[info exists commitrow($curview,$tagids($n))]} {
6582 lappend refs [list $n T]
6583 } else {
6584 set commitinterest($tagids($n)) {run refill_reflist}
6588 foreach n [array names otherrefids] {
6589 if {[string match $reflistfilter $n]} {
6590 if {[info exists commitrow($curview,$otherrefids($n))]} {
6591 lappend refs [list $n o]
6592 } else {
6593 set commitinterest($otherrefids($n)) {run refill_reflist}
6597 set refs [lsort -index 0 $refs]
6598 if {$refs eq $reflist} return
6600 # Update the contents of $showrefstop.list according to the
6601 # differences between $reflist (old) and $refs (new)
6602 $showrefstop.list conf -state normal
6603 $showrefstop.list insert end "\n"
6604 set i 0
6605 set j 0
6606 while {$i < [llength $reflist] || $j < [llength $refs]} {
6607 if {$i < [llength $reflist]} {
6608 if {$j < [llength $refs]} {
6609 set cmp [string compare [lindex $reflist $i 0] \
6610 [lindex $refs $j 0]]
6611 if {$cmp == 0} {
6612 set cmp [string compare [lindex $reflist $i 1] \
6613 [lindex $refs $j 1]]
6615 } else {
6616 set cmp -1
6618 } else {
6619 set cmp 1
6621 switch -- $cmp {
6622 -1 {
6623 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6624 incr i
6627 incr i
6628 incr j
6631 set l [expr {$j + 1}]
6632 $showrefstop.list image create $l.0 -align baseline \
6633 -image reficon-[lindex $refs $j 1] -padx 2
6634 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6635 incr j
6639 set reflist $refs
6640 # delete last newline
6641 $showrefstop.list delete end-2c end-1c
6642 $showrefstop.list conf -state disabled
6645 # Stuff for finding nearby tags
6646 proc getallcommits {} {
6647 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6648 global idheads idtags idotherrefs allparents tagobjid
6650 if {![info exists allcommits]} {
6651 set nextarc 0
6652 set allcommits 0
6653 set seeds {}
6654 set allcwait 0
6655 set cachedarcs 0
6656 set allccache [file join [gitdir] "gitk.cache"]
6657 if {![catch {
6658 set f [open $allccache r]
6659 set allcwait 1
6660 getcache $f
6661 }]} return
6664 if {$allcwait} {
6665 return
6667 set cmd [list | git rev-list --parents]
6668 set allcupdate [expr {$seeds ne {}}]
6669 if {!$allcupdate} {
6670 set ids "--all"
6671 } else {
6672 set refs [concat [array names idheads] [array names idtags] \
6673 [array names idotherrefs]]
6674 set ids {}
6675 set tagobjs {}
6676 foreach name [array names tagobjid] {
6677 lappend tagobjs $tagobjid($name)
6679 foreach id [lsort -unique $refs] {
6680 if {![info exists allparents($id)] &&
6681 [lsearch -exact $tagobjs $id] < 0} {
6682 lappend ids $id
6685 if {$ids ne {}} {
6686 foreach id $seeds {
6687 lappend ids "^$id"
6691 if {$ids ne {}} {
6692 set fd [open [concat $cmd $ids] r]
6693 fconfigure $fd -blocking 0
6694 incr allcommits
6695 nowbusy allcommits
6696 filerun $fd [list getallclines $fd]
6697 } else {
6698 dispneartags 0
6702 # Since most commits have 1 parent and 1 child, we group strings of
6703 # such commits into "arcs" joining branch/merge points (BMPs), which
6704 # are commits that either don't have 1 parent or don't have 1 child.
6706 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6707 # arcout(id) - outgoing arcs for BMP
6708 # arcids(a) - list of IDs on arc including end but not start
6709 # arcstart(a) - BMP ID at start of arc
6710 # arcend(a) - BMP ID at end of arc
6711 # growing(a) - arc a is still growing
6712 # arctags(a) - IDs out of arcids (excluding end) that have tags
6713 # archeads(a) - IDs out of arcids (excluding end) that have heads
6714 # The start of an arc is at the descendent end, so "incoming" means
6715 # coming from descendents, and "outgoing" means going towards ancestors.
6717 proc getallclines {fd} {
6718 global allparents allchildren idtags idheads nextarc
6719 global arcnos arcids arctags arcout arcend arcstart archeads growing
6720 global seeds allcommits cachedarcs allcupdate
6722 set nid 0
6723 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6724 set id [lindex $line 0]
6725 if {[info exists allparents($id)]} {
6726 # seen it already
6727 continue
6729 set cachedarcs 0
6730 set olds [lrange $line 1 end]
6731 set allparents($id) $olds
6732 if {![info exists allchildren($id)]} {
6733 set allchildren($id) {}
6734 set arcnos($id) {}
6735 lappend seeds $id
6736 } else {
6737 set a $arcnos($id)
6738 if {[llength $olds] == 1 && [llength $a] == 1} {
6739 lappend arcids($a) $id
6740 if {[info exists idtags($id)]} {
6741 lappend arctags($a) $id
6743 if {[info exists idheads($id)]} {
6744 lappend archeads($a) $id
6746 if {[info exists allparents($olds)]} {
6747 # seen parent already
6748 if {![info exists arcout($olds)]} {
6749 splitarc $olds
6751 lappend arcids($a) $olds
6752 set arcend($a) $olds
6753 unset growing($a)
6755 lappend allchildren($olds) $id
6756 lappend arcnos($olds) $a
6757 continue
6760 foreach a $arcnos($id) {
6761 lappend arcids($a) $id
6762 set arcend($a) $id
6763 unset growing($a)
6766 set ao {}
6767 foreach p $olds {
6768 lappend allchildren($p) $id
6769 set a [incr nextarc]
6770 set arcstart($a) $id
6771 set archeads($a) {}
6772 set arctags($a) {}
6773 set archeads($a) {}
6774 set arcids($a) {}
6775 lappend ao $a
6776 set growing($a) 1
6777 if {[info exists allparents($p)]} {
6778 # seen it already, may need to make a new branch
6779 if {![info exists arcout($p)]} {
6780 splitarc $p
6782 lappend arcids($a) $p
6783 set arcend($a) $p
6784 unset growing($a)
6786 lappend arcnos($p) $a
6788 set arcout($id) $ao
6790 if {$nid > 0} {
6791 global cached_dheads cached_dtags cached_atags
6792 catch {unset cached_dheads}
6793 catch {unset cached_dtags}
6794 catch {unset cached_atags}
6796 if {![eof $fd]} {
6797 return [expr {$nid >= 1000? 2: 1}]
6799 set cacheok 1
6800 if {[catch {
6801 fconfigure $fd -blocking 1
6802 close $fd
6803 } err]} {
6804 # got an error reading the list of commits
6805 # if we were updating, try rereading the whole thing again
6806 if {$allcupdate} {
6807 incr allcommits -1
6808 dropcache $err
6809 return
6811 error_popup "[mc "Error reading commit topology information;\
6812 branch and preceding/following tag information\
6813 will be incomplete."]\n($err)"
6814 set cacheok 0
6816 if {[incr allcommits -1] == 0} {
6817 notbusy allcommits
6818 if {$cacheok} {
6819 run savecache
6822 dispneartags 0
6823 return 0
6826 proc recalcarc {a} {
6827 global arctags archeads arcids idtags idheads
6829 set at {}
6830 set ah {}
6831 foreach id [lrange $arcids($a) 0 end-1] {
6832 if {[info exists idtags($id)]} {
6833 lappend at $id
6835 if {[info exists idheads($id)]} {
6836 lappend ah $id
6839 set arctags($a) $at
6840 set archeads($a) $ah
6843 proc splitarc {p} {
6844 global arcnos arcids nextarc arctags archeads idtags idheads
6845 global arcstart arcend arcout allparents growing
6847 set a $arcnos($p)
6848 if {[llength $a] != 1} {
6849 puts "oops splitarc called but [llength $a] arcs already"
6850 return
6852 set a [lindex $a 0]
6853 set i [lsearch -exact $arcids($a) $p]
6854 if {$i < 0} {
6855 puts "oops splitarc $p not in arc $a"
6856 return
6858 set na [incr nextarc]
6859 if {[info exists arcend($a)]} {
6860 set arcend($na) $arcend($a)
6861 } else {
6862 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6863 set j [lsearch -exact $arcnos($l) $a]
6864 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6866 set tail [lrange $arcids($a) [expr {$i+1}] end]
6867 set arcids($a) [lrange $arcids($a) 0 $i]
6868 set arcend($a) $p
6869 set arcstart($na) $p
6870 set arcout($p) $na
6871 set arcids($na) $tail
6872 if {[info exists growing($a)]} {
6873 set growing($na) 1
6874 unset growing($a)
6877 foreach id $tail {
6878 if {[llength $arcnos($id)] == 1} {
6879 set arcnos($id) $na
6880 } else {
6881 set j [lsearch -exact $arcnos($id) $a]
6882 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6886 # reconstruct tags and heads lists
6887 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6888 recalcarc $a
6889 recalcarc $na
6890 } else {
6891 set arctags($na) {}
6892 set archeads($na) {}
6896 # Update things for a new commit added that is a child of one
6897 # existing commit. Used when cherry-picking.
6898 proc addnewchild {id p} {
6899 global allparents allchildren idtags nextarc
6900 global arcnos arcids arctags arcout arcend arcstart archeads growing
6901 global seeds allcommits
6903 if {![info exists allcommits] || ![info exists arcnos($p)]} return
6904 set allparents($id) [list $p]
6905 set allchildren($id) {}
6906 set arcnos($id) {}
6907 lappend seeds $id
6908 lappend allchildren($p) $id
6909 set a [incr nextarc]
6910 set arcstart($a) $id
6911 set archeads($a) {}
6912 set arctags($a) {}
6913 set arcids($a) [list $p]
6914 set arcend($a) $p
6915 if {![info exists arcout($p)]} {
6916 splitarc $p
6918 lappend arcnos($p) $a
6919 set arcout($id) [list $a]
6922 # This implements a cache for the topology information.
6923 # The cache saves, for each arc, the start and end of the arc,
6924 # the ids on the arc, and the outgoing arcs from the end.
6925 proc readcache {f} {
6926 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6927 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6928 global allcwait
6930 set a $nextarc
6931 set lim $cachedarcs
6932 if {$lim - $a > 500} {
6933 set lim [expr {$a + 500}]
6935 if {[catch {
6936 if {$a == $lim} {
6937 # finish reading the cache and setting up arctags, etc.
6938 set line [gets $f]
6939 if {$line ne "1"} {error "bad final version"}
6940 close $f
6941 foreach id [array names idtags] {
6942 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6943 [llength $allparents($id)] == 1} {
6944 set a [lindex $arcnos($id) 0]
6945 if {$arctags($a) eq {}} {
6946 recalcarc $a
6950 foreach id [array names idheads] {
6951 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6952 [llength $allparents($id)] == 1} {
6953 set a [lindex $arcnos($id) 0]
6954 if {$archeads($a) eq {}} {
6955 recalcarc $a
6959 foreach id [lsort -unique $possible_seeds] {
6960 if {$arcnos($id) eq {}} {
6961 lappend seeds $id
6964 set allcwait 0
6965 } else {
6966 while {[incr a] <= $lim} {
6967 set line [gets $f]
6968 if {[llength $line] != 3} {error "bad line"}
6969 set s [lindex $line 0]
6970 set arcstart($a) $s
6971 lappend arcout($s) $a
6972 if {![info exists arcnos($s)]} {
6973 lappend possible_seeds $s
6974 set arcnos($s) {}
6976 set e [lindex $line 1]
6977 if {$e eq {}} {
6978 set growing($a) 1
6979 } else {
6980 set arcend($a) $e
6981 if {![info exists arcout($e)]} {
6982 set arcout($e) {}
6985 set arcids($a) [lindex $line 2]
6986 foreach id $arcids($a) {
6987 lappend allparents($s) $id
6988 set s $id
6989 lappend arcnos($id) $a
6991 if {![info exists allparents($s)]} {
6992 set allparents($s) {}
6994 set arctags($a) {}
6995 set archeads($a) {}
6997 set nextarc [expr {$a - 1}]
6999 } err]} {
7000 dropcache $err
7001 return 0
7003 if {!$allcwait} {
7004 getallcommits
7006 return $allcwait
7009 proc getcache {f} {
7010 global nextarc cachedarcs possible_seeds
7012 if {[catch {
7013 set line [gets $f]
7014 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7015 # make sure it's an integer
7016 set cachedarcs [expr {int([lindex $line 1])}]
7017 if {$cachedarcs < 0} {error "bad number of arcs"}
7018 set nextarc 0
7019 set possible_seeds {}
7020 run readcache $f
7021 } err]} {
7022 dropcache $err
7024 return 0
7027 proc dropcache {err} {
7028 global allcwait nextarc cachedarcs seeds
7030 #puts "dropping cache ($err)"
7031 foreach v {arcnos arcout arcids arcstart arcend growing \
7032 arctags archeads allparents allchildren} {
7033 global $v
7034 catch {unset $v}
7036 set allcwait 0
7037 set nextarc 0
7038 set cachedarcs 0
7039 set seeds {}
7040 getallcommits
7043 proc writecache {f} {
7044 global cachearc cachedarcs allccache
7045 global arcstart arcend arcnos arcids arcout
7047 set a $cachearc
7048 set lim $cachedarcs
7049 if {$lim - $a > 1000} {
7050 set lim [expr {$a + 1000}]
7052 if {[catch {
7053 while {[incr a] <= $lim} {
7054 if {[info exists arcend($a)]} {
7055 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7056 } else {
7057 puts $f [list $arcstart($a) {} $arcids($a)]
7060 } err]} {
7061 catch {close $f}
7062 catch {file delete $allccache}
7063 #puts "writing cache failed ($err)"
7064 return 0
7066 set cachearc [expr {$a - 1}]
7067 if {$a > $cachedarcs} {
7068 puts $f "1"
7069 close $f
7070 return 0
7072 return 1
7075 proc savecache {} {
7076 global nextarc cachedarcs cachearc allccache
7078 if {$nextarc == $cachedarcs} return
7079 set cachearc 0
7080 set cachedarcs $nextarc
7081 catch {
7082 set f [open $allccache w]
7083 puts $f [list 1 $cachedarcs]
7084 run writecache $f
7088 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7089 # or 0 if neither is true.
7090 proc anc_or_desc {a b} {
7091 global arcout arcstart arcend arcnos cached_isanc
7093 if {$arcnos($a) eq $arcnos($b)} {
7094 # Both are on the same arc(s); either both are the same BMP,
7095 # or if one is not a BMP, the other is also not a BMP or is
7096 # the BMP at end of the arc (and it only has 1 incoming arc).
7097 # Or both can be BMPs with no incoming arcs.
7098 if {$a eq $b || $arcnos($a) eq {}} {
7099 return 0
7101 # assert {[llength $arcnos($a)] == 1}
7102 set arc [lindex $arcnos($a) 0]
7103 set i [lsearch -exact $arcids($arc) $a]
7104 set j [lsearch -exact $arcids($arc) $b]
7105 if {$i < 0 || $i > $j} {
7106 return 1
7107 } else {
7108 return -1
7112 if {![info exists arcout($a)]} {
7113 set arc [lindex $arcnos($a) 0]
7114 if {[info exists arcend($arc)]} {
7115 set aend $arcend($arc)
7116 } else {
7117 set aend {}
7119 set a $arcstart($arc)
7120 } else {
7121 set aend $a
7123 if {![info exists arcout($b)]} {
7124 set arc [lindex $arcnos($b) 0]
7125 if {[info exists arcend($arc)]} {
7126 set bend $arcend($arc)
7127 } else {
7128 set bend {}
7130 set b $arcstart($arc)
7131 } else {
7132 set bend $b
7134 if {$a eq $bend} {
7135 return 1
7137 if {$b eq $aend} {
7138 return -1
7140 if {[info exists cached_isanc($a,$bend)]} {
7141 if {$cached_isanc($a,$bend)} {
7142 return 1
7145 if {[info exists cached_isanc($b,$aend)]} {
7146 if {$cached_isanc($b,$aend)} {
7147 return -1
7149 if {[info exists cached_isanc($a,$bend)]} {
7150 return 0
7154 set todo [list $a $b]
7155 set anc($a) a
7156 set anc($b) b
7157 for {set i 0} {$i < [llength $todo]} {incr i} {
7158 set x [lindex $todo $i]
7159 if {$anc($x) eq {}} {
7160 continue
7162 foreach arc $arcnos($x) {
7163 set xd $arcstart($arc)
7164 if {$xd eq $bend} {
7165 set cached_isanc($a,$bend) 1
7166 set cached_isanc($b,$aend) 0
7167 return 1
7168 } elseif {$xd eq $aend} {
7169 set cached_isanc($b,$aend) 1
7170 set cached_isanc($a,$bend) 0
7171 return -1
7173 if {![info exists anc($xd)]} {
7174 set anc($xd) $anc($x)
7175 lappend todo $xd
7176 } elseif {$anc($xd) ne $anc($x)} {
7177 set anc($xd) {}
7181 set cached_isanc($a,$bend) 0
7182 set cached_isanc($b,$aend) 0
7183 return 0
7186 # This identifies whether $desc has an ancestor that is
7187 # a growing tip of the graph and which is not an ancestor of $anc
7188 # and returns 0 if so and 1 if not.
7189 # If we subsequently discover a tag on such a growing tip, and that
7190 # turns out to be a descendent of $anc (which it could, since we
7191 # don't necessarily see children before parents), then $desc
7192 # isn't a good choice to display as a descendent tag of
7193 # $anc (since it is the descendent of another tag which is
7194 # a descendent of $anc). Similarly, $anc isn't a good choice to
7195 # display as a ancestor tag of $desc.
7197 proc is_certain {desc anc} {
7198 global arcnos arcout arcstart arcend growing problems
7200 set certain {}
7201 if {[llength $arcnos($anc)] == 1} {
7202 # tags on the same arc are certain
7203 if {$arcnos($desc) eq $arcnos($anc)} {
7204 return 1
7206 if {![info exists arcout($anc)]} {
7207 # if $anc is partway along an arc, use the start of the arc instead
7208 set a [lindex $arcnos($anc) 0]
7209 set anc $arcstart($a)
7212 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7213 set x $desc
7214 } else {
7215 set a [lindex $arcnos($desc) 0]
7216 set x $arcend($a)
7218 if {$x == $anc} {
7219 return 1
7221 set anclist [list $x]
7222 set dl($x) 1
7223 set nnh 1
7224 set ngrowanc 0
7225 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7226 set x [lindex $anclist $i]
7227 if {$dl($x)} {
7228 incr nnh -1
7230 set done($x) 1
7231 foreach a $arcout($x) {
7232 if {[info exists growing($a)]} {
7233 if {![info exists growanc($x)] && $dl($x)} {
7234 set growanc($x) 1
7235 incr ngrowanc
7237 } else {
7238 set y $arcend($a)
7239 if {[info exists dl($y)]} {
7240 if {$dl($y)} {
7241 if {!$dl($x)} {
7242 set dl($y) 0
7243 if {![info exists done($y)]} {
7244 incr nnh -1
7246 if {[info exists growanc($x)]} {
7247 incr ngrowanc -1
7249 set xl [list $y]
7250 for {set k 0} {$k < [llength $xl]} {incr k} {
7251 set z [lindex $xl $k]
7252 foreach c $arcout($z) {
7253 if {[info exists arcend($c)]} {
7254 set v $arcend($c)
7255 if {[info exists dl($v)] && $dl($v)} {
7256 set dl($v) 0
7257 if {![info exists done($v)]} {
7258 incr nnh -1
7260 if {[info exists growanc($v)]} {
7261 incr ngrowanc -1
7263 lappend xl $v
7270 } elseif {$y eq $anc || !$dl($x)} {
7271 set dl($y) 0
7272 lappend anclist $y
7273 } else {
7274 set dl($y) 1
7275 lappend anclist $y
7276 incr nnh
7281 foreach x [array names growanc] {
7282 if {$dl($x)} {
7283 return 0
7285 return 0
7287 return 1
7290 proc validate_arctags {a} {
7291 global arctags idtags
7293 set i -1
7294 set na $arctags($a)
7295 foreach id $arctags($a) {
7296 incr i
7297 if {![info exists idtags($id)]} {
7298 set na [lreplace $na $i $i]
7299 incr i -1
7302 set arctags($a) $na
7305 proc validate_archeads {a} {
7306 global archeads idheads
7308 set i -1
7309 set na $archeads($a)
7310 foreach id $archeads($a) {
7311 incr i
7312 if {![info exists idheads($id)]} {
7313 set na [lreplace $na $i $i]
7314 incr i -1
7317 set archeads($a) $na
7320 # Return the list of IDs that have tags that are descendents of id,
7321 # ignoring IDs that are descendents of IDs already reported.
7322 proc desctags {id} {
7323 global arcnos arcstart arcids arctags idtags allparents
7324 global growing cached_dtags
7326 if {![info exists allparents($id)]} {
7327 return {}
7329 set t1 [clock clicks -milliseconds]
7330 set argid $id
7331 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7332 # part-way along an arc; check that arc first
7333 set a [lindex $arcnos($id) 0]
7334 if {$arctags($a) ne {}} {
7335 validate_arctags $a
7336 set i [lsearch -exact $arcids($a) $id]
7337 set tid {}
7338 foreach t $arctags($a) {
7339 set j [lsearch -exact $arcids($a) $t]
7340 if {$j >= $i} break
7341 set tid $t
7343 if {$tid ne {}} {
7344 return $tid
7347 set id $arcstart($a)
7348 if {[info exists idtags($id)]} {
7349 return $id
7352 if {[info exists cached_dtags($id)]} {
7353 return $cached_dtags($id)
7356 set origid $id
7357 set todo [list $id]
7358 set queued($id) 1
7359 set nc 1
7360 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7361 set id [lindex $todo $i]
7362 set done($id) 1
7363 set ta [info exists hastaggedancestor($id)]
7364 if {!$ta} {
7365 incr nc -1
7367 # ignore tags on starting node
7368 if {!$ta && $i > 0} {
7369 if {[info exists idtags($id)]} {
7370 set tagloc($id) $id
7371 set ta 1
7372 } elseif {[info exists cached_dtags($id)]} {
7373 set tagloc($id) $cached_dtags($id)
7374 set ta 1
7377 foreach a $arcnos($id) {
7378 set d $arcstart($a)
7379 if {!$ta && $arctags($a) ne {}} {
7380 validate_arctags $a
7381 if {$arctags($a) ne {}} {
7382 lappend tagloc($id) [lindex $arctags($a) end]
7385 if {$ta || $arctags($a) ne {}} {
7386 set tomark [list $d]
7387 for {set j 0} {$j < [llength $tomark]} {incr j} {
7388 set dd [lindex $tomark $j]
7389 if {![info exists hastaggedancestor($dd)]} {
7390 if {[info exists done($dd)]} {
7391 foreach b $arcnos($dd) {
7392 lappend tomark $arcstart($b)
7394 if {[info exists tagloc($dd)]} {
7395 unset tagloc($dd)
7397 } elseif {[info exists queued($dd)]} {
7398 incr nc -1
7400 set hastaggedancestor($dd) 1
7404 if {![info exists queued($d)]} {
7405 lappend todo $d
7406 set queued($d) 1
7407 if {![info exists hastaggedancestor($d)]} {
7408 incr nc
7413 set tags {}
7414 foreach id [array names tagloc] {
7415 if {![info exists hastaggedancestor($id)]} {
7416 foreach t $tagloc($id) {
7417 if {[lsearch -exact $tags $t] < 0} {
7418 lappend tags $t
7423 set t2 [clock clicks -milliseconds]
7424 set loopix $i
7426 # remove tags that are descendents of other tags
7427 for {set i 0} {$i < [llength $tags]} {incr i} {
7428 set a [lindex $tags $i]
7429 for {set j 0} {$j < $i} {incr j} {
7430 set b [lindex $tags $j]
7431 set r [anc_or_desc $a $b]
7432 if {$r == 1} {
7433 set tags [lreplace $tags $j $j]
7434 incr j -1
7435 incr i -1
7436 } elseif {$r == -1} {
7437 set tags [lreplace $tags $i $i]
7438 incr i -1
7439 break
7444 if {[array names growing] ne {}} {
7445 # graph isn't finished, need to check if any tag could get
7446 # eclipsed by another tag coming later. Simply ignore any
7447 # tags that could later get eclipsed.
7448 set ctags {}
7449 foreach t $tags {
7450 if {[is_certain $t $origid]} {
7451 lappend ctags $t
7454 if {$tags eq $ctags} {
7455 set cached_dtags($origid) $tags
7456 } else {
7457 set tags $ctags
7459 } else {
7460 set cached_dtags($origid) $tags
7462 set t3 [clock clicks -milliseconds]
7463 if {0 && $t3 - $t1 >= 100} {
7464 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7465 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7467 return $tags
7470 proc anctags {id} {
7471 global arcnos arcids arcout arcend arctags idtags allparents
7472 global growing cached_atags
7474 if {![info exists allparents($id)]} {
7475 return {}
7477 set t1 [clock clicks -milliseconds]
7478 set argid $id
7479 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7480 # part-way along an arc; check that arc first
7481 set a [lindex $arcnos($id) 0]
7482 if {$arctags($a) ne {}} {
7483 validate_arctags $a
7484 set i [lsearch -exact $arcids($a) $id]
7485 foreach t $arctags($a) {
7486 set j [lsearch -exact $arcids($a) $t]
7487 if {$j > $i} {
7488 return $t
7492 if {![info exists arcend($a)]} {
7493 return {}
7495 set id $arcend($a)
7496 if {[info exists idtags($id)]} {
7497 return $id
7500 if {[info exists cached_atags($id)]} {
7501 return $cached_atags($id)
7504 set origid $id
7505 set todo [list $id]
7506 set queued($id) 1
7507 set taglist {}
7508 set nc 1
7509 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7510 set id [lindex $todo $i]
7511 set done($id) 1
7512 set td [info exists hastaggeddescendent($id)]
7513 if {!$td} {
7514 incr nc -1
7516 # ignore tags on starting node
7517 if {!$td && $i > 0} {
7518 if {[info exists idtags($id)]} {
7519 set tagloc($id) $id
7520 set td 1
7521 } elseif {[info exists cached_atags($id)]} {
7522 set tagloc($id) $cached_atags($id)
7523 set td 1
7526 foreach a $arcout($id) {
7527 if {!$td && $arctags($a) ne {}} {
7528 validate_arctags $a
7529 if {$arctags($a) ne {}} {
7530 lappend tagloc($id) [lindex $arctags($a) 0]
7533 if {![info exists arcend($a)]} continue
7534 set d $arcend($a)
7535 if {$td || $arctags($a) ne {}} {
7536 set tomark [list $d]
7537 for {set j 0} {$j < [llength $tomark]} {incr j} {
7538 set dd [lindex $tomark $j]
7539 if {![info exists hastaggeddescendent($dd)]} {
7540 if {[info exists done($dd)]} {
7541 foreach b $arcout($dd) {
7542 if {[info exists arcend($b)]} {
7543 lappend tomark $arcend($b)
7546 if {[info exists tagloc($dd)]} {
7547 unset tagloc($dd)
7549 } elseif {[info exists queued($dd)]} {
7550 incr nc -1
7552 set hastaggeddescendent($dd) 1
7556 if {![info exists queued($d)]} {
7557 lappend todo $d
7558 set queued($d) 1
7559 if {![info exists hastaggeddescendent($d)]} {
7560 incr nc
7565 set t2 [clock clicks -milliseconds]
7566 set loopix $i
7567 set tags {}
7568 foreach id [array names tagloc] {
7569 if {![info exists hastaggeddescendent($id)]} {
7570 foreach t $tagloc($id) {
7571 if {[lsearch -exact $tags $t] < 0} {
7572 lappend tags $t
7578 # remove tags that are ancestors of other tags
7579 for {set i 0} {$i < [llength $tags]} {incr i} {
7580 set a [lindex $tags $i]
7581 for {set j 0} {$j < $i} {incr j} {
7582 set b [lindex $tags $j]
7583 set r [anc_or_desc $a $b]
7584 if {$r == -1} {
7585 set tags [lreplace $tags $j $j]
7586 incr j -1
7587 incr i -1
7588 } elseif {$r == 1} {
7589 set tags [lreplace $tags $i $i]
7590 incr i -1
7591 break
7596 if {[array names growing] ne {}} {
7597 # graph isn't finished, need to check if any tag could get
7598 # eclipsed by another tag coming later. Simply ignore any
7599 # tags that could later get eclipsed.
7600 set ctags {}
7601 foreach t $tags {
7602 if {[is_certain $origid $t]} {
7603 lappend ctags $t
7606 if {$tags eq $ctags} {
7607 set cached_atags($origid) $tags
7608 } else {
7609 set tags $ctags
7611 } else {
7612 set cached_atags($origid) $tags
7614 set t3 [clock clicks -milliseconds]
7615 if {0 && $t3 - $t1 >= 100} {
7616 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7617 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7619 return $tags
7622 # Return the list of IDs that have heads that are descendents of id,
7623 # including id itself if it has a head.
7624 proc descheads {id} {
7625 global arcnos arcstart arcids archeads idheads cached_dheads
7626 global allparents
7628 if {![info exists allparents($id)]} {
7629 return {}
7631 set aret {}
7632 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7633 # part-way along an arc; check it first
7634 set a [lindex $arcnos($id) 0]
7635 if {$archeads($a) ne {}} {
7636 validate_archeads $a
7637 set i [lsearch -exact $arcids($a) $id]
7638 foreach t $archeads($a) {
7639 set j [lsearch -exact $arcids($a) $t]
7640 if {$j > $i} break
7641 lappend aret $t
7644 set id $arcstart($a)
7646 set origid $id
7647 set todo [list $id]
7648 set seen($id) 1
7649 set ret {}
7650 for {set i 0} {$i < [llength $todo]} {incr i} {
7651 set id [lindex $todo $i]
7652 if {[info exists cached_dheads($id)]} {
7653 set ret [concat $ret $cached_dheads($id)]
7654 } else {
7655 if {[info exists idheads($id)]} {
7656 lappend ret $id
7658 foreach a $arcnos($id) {
7659 if {$archeads($a) ne {}} {
7660 validate_archeads $a
7661 if {$archeads($a) ne {}} {
7662 set ret [concat $ret $archeads($a)]
7665 set d $arcstart($a)
7666 if {![info exists seen($d)]} {
7667 lappend todo $d
7668 set seen($d) 1
7673 set ret [lsort -unique $ret]
7674 set cached_dheads($origid) $ret
7675 return [concat $ret $aret]
7678 proc addedtag {id} {
7679 global arcnos arcout cached_dtags cached_atags
7681 if {![info exists arcnos($id)]} return
7682 if {![info exists arcout($id)]} {
7683 recalcarc [lindex $arcnos($id) 0]
7685 catch {unset cached_dtags}
7686 catch {unset cached_atags}
7689 proc addedhead {hid head} {
7690 global arcnos arcout cached_dheads
7692 if {![info exists arcnos($hid)]} return
7693 if {![info exists arcout($hid)]} {
7694 recalcarc [lindex $arcnos($hid) 0]
7696 catch {unset cached_dheads}
7699 proc removedhead {hid head} {
7700 global cached_dheads
7702 catch {unset cached_dheads}
7705 proc movedhead {hid head} {
7706 global arcnos arcout cached_dheads
7708 if {![info exists arcnos($hid)]} return
7709 if {![info exists arcout($hid)]} {
7710 recalcarc [lindex $arcnos($hid) 0]
7712 catch {unset cached_dheads}
7715 proc changedrefs {} {
7716 global cached_dheads cached_dtags cached_atags
7717 global arctags archeads arcnos arcout idheads idtags
7719 foreach id [concat [array names idheads] [array names idtags]] {
7720 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7721 set a [lindex $arcnos($id) 0]
7722 if {![info exists donearc($a)]} {
7723 recalcarc $a
7724 set donearc($a) 1
7728 catch {unset cached_dtags}
7729 catch {unset cached_atags}
7730 catch {unset cached_dheads}
7733 proc rereadrefs {} {
7734 global idtags idheads idotherrefs mainhead
7736 set refids [concat [array names idtags] \
7737 [array names idheads] [array names idotherrefs]]
7738 foreach id $refids {
7739 if {![info exists ref($id)]} {
7740 set ref($id) [listrefs $id]
7743 set oldmainhead $mainhead
7744 readrefs
7745 changedrefs
7746 set refids [lsort -unique [concat $refids [array names idtags] \
7747 [array names idheads] [array names idotherrefs]]]
7748 foreach id $refids {
7749 set v [listrefs $id]
7750 if {![info exists ref($id)] || $ref($id) != $v ||
7751 ($id eq $oldmainhead && $id ne $mainhead) ||
7752 ($id eq $mainhead && $id ne $oldmainhead)} {
7753 redrawtags $id
7756 run refill_reflist
7759 proc listrefs {id} {
7760 global idtags idheads idotherrefs
7762 set x {}
7763 if {[info exists idtags($id)]} {
7764 set x $idtags($id)
7766 set y {}
7767 if {[info exists idheads($id)]} {
7768 set y $idheads($id)
7770 set z {}
7771 if {[info exists idotherrefs($id)]} {
7772 set z $idotherrefs($id)
7774 return [list $x $y $z]
7777 proc showtag {tag isnew} {
7778 global ctext tagcontents tagids linknum tagobjid
7780 if {$isnew} {
7781 addtohistory [list showtag $tag 0]
7783 $ctext conf -state normal
7784 clear_ctext
7785 settabs 0
7786 set linknum 0
7787 if {![info exists tagcontents($tag)]} {
7788 catch {
7789 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7792 if {[info exists tagcontents($tag)]} {
7793 set text $tagcontents($tag)
7794 } else {
7795 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
7797 appendwithlinks $text {}
7798 $ctext conf -state disabled
7799 init_flist {}
7802 proc doquit {} {
7803 global stopped
7804 set stopped 100
7805 savestuff .
7806 destroy .
7809 proc mkfontdisp {font top which} {
7810 global fontattr fontpref $font
7812 set fontpref($font) [set $font]
7813 button $top.${font}but -text $which -font optionfont \
7814 -command [list choosefont $font $which]
7815 label $top.$font -relief flat -font $font \
7816 -text $fontattr($font,family) -justify left
7817 grid x $top.${font}but $top.$font -sticky w
7820 proc choosefont {font which} {
7821 global fontparam fontlist fonttop fontattr
7823 set fontparam(which) $which
7824 set fontparam(font) $font
7825 set fontparam(family) [font actual $font -family]
7826 set fontparam(size) $fontattr($font,size)
7827 set fontparam(weight) $fontattr($font,weight)
7828 set fontparam(slant) $fontattr($font,slant)
7829 set top .gitkfont
7830 set fonttop $top
7831 if {![winfo exists $top]} {
7832 font create sample
7833 eval font config sample [font actual $font]
7834 toplevel $top
7835 wm title $top [mc "Gitk font chooser"]
7836 label $top.l -textvariable fontparam(which)
7837 pack $top.l -side top
7838 set fontlist [lsort [font families]]
7839 frame $top.f
7840 listbox $top.f.fam -listvariable fontlist \
7841 -yscrollcommand [list $top.f.sb set]
7842 bind $top.f.fam <<ListboxSelect>> selfontfam
7843 scrollbar $top.f.sb -command [list $top.f.fam yview]
7844 pack $top.f.sb -side right -fill y
7845 pack $top.f.fam -side left -fill both -expand 1
7846 pack $top.f -side top -fill both -expand 1
7847 frame $top.g
7848 spinbox $top.g.size -from 4 -to 40 -width 4 \
7849 -textvariable fontparam(size) \
7850 -validatecommand {string is integer -strict %s}
7851 checkbutton $top.g.bold -padx 5 \
7852 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7853 -variable fontparam(weight) -onvalue bold -offvalue normal
7854 checkbutton $top.g.ital -padx 5 \
7855 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7856 -variable fontparam(slant) -onvalue italic -offvalue roman
7857 pack $top.g.size $top.g.bold $top.g.ital -side left
7858 pack $top.g -side top
7859 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7860 -background white
7861 $top.c create text 100 25 -anchor center -text $which -font sample \
7862 -fill black -tags text
7863 bind $top.c <Configure> [list centertext $top.c]
7864 pack $top.c -side top -fill x
7865 frame $top.buts
7866 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7867 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7868 grid $top.buts.ok $top.buts.can
7869 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7870 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7871 pack $top.buts -side bottom -fill x
7872 trace add variable fontparam write chg_fontparam
7873 } else {
7874 raise $top
7875 $top.c itemconf text -text $which
7877 set i [lsearch -exact $fontlist $fontparam(family)]
7878 if {$i >= 0} {
7879 $top.f.fam selection set $i
7880 $top.f.fam see $i
7884 proc centertext {w} {
7885 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7888 proc fontok {} {
7889 global fontparam fontpref prefstop
7891 set f $fontparam(font)
7892 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7893 if {$fontparam(weight) eq "bold"} {
7894 lappend fontpref($f) "bold"
7896 if {$fontparam(slant) eq "italic"} {
7897 lappend fontpref($f) "italic"
7899 set w $prefstop.$f
7900 $w conf -text $fontparam(family) -font $fontpref($f)
7902 fontcan
7905 proc fontcan {} {
7906 global fonttop fontparam
7908 if {[info exists fonttop]} {
7909 catch {destroy $fonttop}
7910 catch {font delete sample}
7911 unset fonttop
7912 unset fontparam
7916 proc selfontfam {} {
7917 global fonttop fontparam
7919 set i [$fonttop.f.fam curselection]
7920 if {$i ne {}} {
7921 set fontparam(family) [$fonttop.f.fam get $i]
7925 proc chg_fontparam {v sub op} {
7926 global fontparam
7928 font config sample -$sub $fontparam($sub)
7931 proc doprefs {} {
7932 global maxwidth maxgraphpct
7933 global oldprefs prefstop showneartags showlocalchanges
7934 global bgcolor fgcolor ctext diffcolors selectbgcolor
7935 global tabstop limitdiffs
7937 set top .gitkprefs
7938 set prefstop $top
7939 if {[winfo exists $top]} {
7940 raise $top
7941 return
7943 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7944 limitdiffs tabstop} {
7945 set oldprefs($v) [set $v]
7947 toplevel $top
7948 wm title $top [mc "Gitk preferences"]
7949 label $top.ldisp -text [mc "Commit list display options"]
7950 grid $top.ldisp - -sticky w -pady 10
7951 label $top.spacer -text " "
7952 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7953 -font optionfont
7954 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7955 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7956 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7957 -font optionfont
7958 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7959 grid x $top.maxpctl $top.maxpct -sticky w
7960 frame $top.showlocal
7961 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7962 checkbutton $top.showlocal.b -variable showlocalchanges
7963 pack $top.showlocal.b $top.showlocal.l -side left
7964 grid x $top.showlocal -sticky w
7966 label $top.ddisp -text [mc "Diff display options"]
7967 grid $top.ddisp - -sticky w -pady 10
7968 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7969 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7970 grid x $top.tabstopl $top.tabstop -sticky w
7971 frame $top.ntag
7972 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7973 checkbutton $top.ntag.b -variable showneartags
7974 pack $top.ntag.b $top.ntag.l -side left
7975 grid x $top.ntag -sticky w
7976 frame $top.ldiff
7977 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7978 checkbutton $top.ldiff.b -variable limitdiffs
7979 pack $top.ldiff.b $top.ldiff.l -side left
7980 grid x $top.ldiff -sticky w
7982 label $top.cdisp -text [mc "Colors: press to choose"]
7983 grid $top.cdisp - -sticky w -pady 10
7984 label $top.bg -padx 40 -relief sunk -background $bgcolor
7985 button $top.bgbut -text [mc "Background"] -font optionfont \
7986 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7987 grid x $top.bgbut $top.bg -sticky w
7988 label $top.fg -padx 40 -relief sunk -background $fgcolor
7989 button $top.fgbut -text [mc "Foreground"] -font optionfont \
7990 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7991 grid x $top.fgbut $top.fg -sticky w
7992 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7993 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
7994 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7995 [list $ctext tag conf d0 -foreground]]
7996 grid x $top.diffoldbut $top.diffold -sticky w
7997 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7998 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
7999 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8000 [list $ctext tag conf d1 -foreground]]
8001 grid x $top.diffnewbut $top.diffnew -sticky w
8002 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8003 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8004 -command [list choosecolor diffcolors 2 $top.hunksep \
8005 "diff hunk header" \
8006 [list $ctext tag conf hunksep -foreground]]
8007 grid x $top.hunksepbut $top.hunksep -sticky w
8008 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8009 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8010 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8011 grid x $top.selbgbut $top.selbgsep -sticky w
8013 label $top.cfont -text [mc "Fonts: press to choose"]
8014 grid $top.cfont - -sticky w -pady 10
8015 mkfontdisp mainfont $top [mc "Main font"]
8016 mkfontdisp textfont $top [mc "Diff display font"]
8017 mkfontdisp uifont $top [mc "User interface font"]
8019 frame $top.buts
8020 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8021 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8022 grid $top.buts.ok $top.buts.can
8023 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8024 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8025 grid $top.buts - - -pady 10 -sticky ew
8026 bind $top <Visibility> "focus $top.buts.ok"
8029 proc choosecolor {v vi w x cmd} {
8030 global $v
8032 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8033 -title [mc "Gitk: choose color for %s" $x]]
8034 if {$c eq {}} return
8035 $w conf -background $c
8036 lset $v $vi $c
8037 eval $cmd $c
8040 proc setselbg {c} {
8041 global bglist cflist
8042 foreach w $bglist {
8043 $w configure -selectbackground $c
8045 $cflist tag configure highlight \
8046 -background [$cflist cget -selectbackground]
8047 allcanvs itemconf secsel -fill $c
8050 proc setbg {c} {
8051 global bglist
8053 foreach w $bglist {
8054 $w conf -background $c
8058 proc setfg {c} {
8059 global fglist canv
8061 foreach w $fglist {
8062 $w conf -foreground $c
8064 allcanvs itemconf text -fill $c
8065 $canv itemconf circle -outline $c
8068 proc prefscan {} {
8069 global oldprefs prefstop
8071 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8072 limitdiffs tabstop} {
8073 global $v
8074 set $v $oldprefs($v)
8076 catch {destroy $prefstop}
8077 unset prefstop
8078 fontcan
8081 proc prefsok {} {
8082 global maxwidth maxgraphpct
8083 global oldprefs prefstop showneartags showlocalchanges
8084 global fontpref mainfont textfont uifont
8085 global limitdiffs treediffs
8087 catch {destroy $prefstop}
8088 unset prefstop
8089 fontcan
8090 set fontchanged 0
8091 if {$mainfont ne $fontpref(mainfont)} {
8092 set mainfont $fontpref(mainfont)
8093 parsefont mainfont $mainfont
8094 eval font configure mainfont [fontflags mainfont]
8095 eval font configure mainfontbold [fontflags mainfont 1]
8096 setcoords
8097 set fontchanged 1
8099 if {$textfont ne $fontpref(textfont)} {
8100 set textfont $fontpref(textfont)
8101 parsefont textfont $textfont
8102 eval font configure textfont [fontflags textfont]
8103 eval font configure textfontbold [fontflags textfont 1]
8105 if {$uifont ne $fontpref(uifont)} {
8106 set uifont $fontpref(uifont)
8107 parsefont uifont $uifont
8108 eval font configure uifont [fontflags uifont]
8110 settabs
8111 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8112 if {$showlocalchanges} {
8113 doshowlocalchanges
8114 } else {
8115 dohidelocalchanges
8118 if {$limitdiffs != $oldprefs(limitdiffs)} {
8119 # treediffs elements are limited by path
8120 catch {unset treediffs}
8122 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8123 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8124 redisplay
8125 } elseif {$showneartags != $oldprefs(showneartags) ||
8126 $limitdiffs != $oldprefs(limitdiffs)} {
8127 reselectline
8131 proc formatdate {d} {
8132 global datetimeformat
8133 if {$d ne {}} {
8134 set d [clock format $d -format $datetimeformat]
8136 return $d
8139 # This list of encoding names and aliases is distilled from
8140 # http://www.iana.org/assignments/character-sets.
8141 # Not all of them are supported by Tcl.
8142 set encoding_aliases {
8143 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8144 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8145 { ISO-10646-UTF-1 csISO10646UTF1 }
8146 { ISO_646.basic:1983 ref csISO646basic1983 }
8147 { INVARIANT csINVARIANT }
8148 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8149 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8150 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8151 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8152 { NATS-DANO iso-ir-9-1 csNATSDANO }
8153 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8154 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8155 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8156 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8157 { ISO-2022-KR csISO2022KR }
8158 { EUC-KR csEUCKR }
8159 { ISO-2022-JP csISO2022JP }
8160 { ISO-2022-JP-2 csISO2022JP2 }
8161 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8162 csISO13JISC6220jp }
8163 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8164 { IT iso-ir-15 ISO646-IT csISO15Italian }
8165 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8166 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8167 { greek7-old iso-ir-18 csISO18Greek7Old }
8168 { latin-greek iso-ir-19 csISO19LatinGreek }
8169 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8170 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8171 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8172 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8173 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8174 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8175 { INIS iso-ir-49 csISO49INIS }
8176 { INIS-8 iso-ir-50 csISO50INIS8 }
8177 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8178 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8179 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8180 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8181 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8182 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8183 csISO60Norwegian1 }
8184 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8185 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8186 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8187 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8188 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8189 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8190 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8191 { greek7 iso-ir-88 csISO88Greek7 }
8192 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8193 { iso-ir-90 csISO90 }
8194 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8195 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8196 csISO92JISC62991984b }
8197 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8198 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8199 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8200 csISO95JIS62291984handadd }
8201 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8202 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8203 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8204 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8205 CP819 csISOLatin1 }
8206 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8207 { T.61-7bit iso-ir-102 csISO102T617bit }
8208 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8209 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8210 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8211 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8212 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8213 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8214 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8215 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8216 arabic csISOLatinArabic }
8217 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8218 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8219 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8220 greek greek8 csISOLatinGreek }
8221 { T.101-G2 iso-ir-128 csISO128T101G2 }
8222 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8223 csISOLatinHebrew }
8224 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8225 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8226 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8227 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8228 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8229 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8230 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8231 csISOLatinCyrillic }
8232 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8233 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8234 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8235 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8236 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8237 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8238 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8239 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8240 { ISO_10367-box iso-ir-155 csISO10367Box }
8241 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8242 { latin-lap lap iso-ir-158 csISO158Lap }
8243 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8244 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8245 { us-dk csUSDK }
8246 { dk-us csDKUS }
8247 { JIS_X0201 X0201 csHalfWidthKatakana }
8248 { KSC5636 ISO646-KR csKSC5636 }
8249 { ISO-10646-UCS-2 csUnicode }
8250 { ISO-10646-UCS-4 csUCS4 }
8251 { DEC-MCS dec csDECMCS }
8252 { hp-roman8 roman8 r8 csHPRoman8 }
8253 { macintosh mac csMacintosh }
8254 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8255 csIBM037 }
8256 { IBM038 EBCDIC-INT cp038 csIBM038 }
8257 { IBM273 CP273 csIBM273 }
8258 { IBM274 EBCDIC-BE CP274 csIBM274 }
8259 { IBM275 EBCDIC-BR cp275 csIBM275 }
8260 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8261 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8262 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8263 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8264 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8265 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8266 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8267 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8268 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8269 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8270 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8271 { IBM437 cp437 437 csPC8CodePage437 }
8272 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8273 { IBM775 cp775 csPC775Baltic }
8274 { IBM850 cp850 850 csPC850Multilingual }
8275 { IBM851 cp851 851 csIBM851 }
8276 { IBM852 cp852 852 csPCp852 }
8277 { IBM855 cp855 855 csIBM855 }
8278 { IBM857 cp857 857 csIBM857 }
8279 { IBM860 cp860 860 csIBM860 }
8280 { IBM861 cp861 861 cp-is csIBM861 }
8281 { IBM862 cp862 862 csPC862LatinHebrew }
8282 { IBM863 cp863 863 csIBM863 }
8283 { IBM864 cp864 csIBM864 }
8284 { IBM865 cp865 865 csIBM865 }
8285 { IBM866 cp866 866 csIBM866 }
8286 { IBM868 CP868 cp-ar csIBM868 }
8287 { IBM869 cp869 869 cp-gr csIBM869 }
8288 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8289 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8290 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8291 { IBM891 cp891 csIBM891 }
8292 { IBM903 cp903 csIBM903 }
8293 { IBM904 cp904 904 csIBBM904 }
8294 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8295 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8296 { IBM1026 CP1026 csIBM1026 }
8297 { EBCDIC-AT-DE csIBMEBCDICATDE }
8298 { EBCDIC-AT-DE-A csEBCDICATDEA }
8299 { EBCDIC-CA-FR csEBCDICCAFR }
8300 { EBCDIC-DK-NO csEBCDICDKNO }
8301 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8302 { EBCDIC-FI-SE csEBCDICFISE }
8303 { EBCDIC-FI-SE-A csEBCDICFISEA }
8304 { EBCDIC-FR csEBCDICFR }
8305 { EBCDIC-IT csEBCDICIT }
8306 { EBCDIC-PT csEBCDICPT }
8307 { EBCDIC-ES csEBCDICES }
8308 { EBCDIC-ES-A csEBCDICESA }
8309 { EBCDIC-ES-S csEBCDICESS }
8310 { EBCDIC-UK csEBCDICUK }
8311 { EBCDIC-US csEBCDICUS }
8312 { UNKNOWN-8BIT csUnknown8BiT }
8313 { MNEMONIC csMnemonic }
8314 { MNEM csMnem }
8315 { VISCII csVISCII }
8316 { VIQR csVIQR }
8317 { KOI8-R csKOI8R }
8318 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8319 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8320 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8321 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8322 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8323 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8324 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8325 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8326 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8327 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8328 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8329 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8330 { IBM1047 IBM-1047 }
8331 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8332 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8333 { UNICODE-1-1 csUnicode11 }
8334 { CESU-8 csCESU-8 }
8335 { BOCU-1 csBOCU-1 }
8336 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8337 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8338 l8 }
8339 { ISO-8859-15 ISO_8859-15 Latin-9 }
8340 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8341 { GBK CP936 MS936 windows-936 }
8342 { JIS_Encoding csJISEncoding }
8343 { Shift_JIS MS_Kanji csShiftJIS }
8344 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8345 EUC-JP }
8346 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8347 { ISO-10646-UCS-Basic csUnicodeASCII }
8348 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8349 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8350 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8351 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8352 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8353 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8354 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8355 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8356 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8357 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8358 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8359 { Ventura-US csVenturaUS }
8360 { Ventura-International csVenturaInternational }
8361 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8362 { PC8-Turkish csPC8Turkish }
8363 { IBM-Symbols csIBMSymbols }
8364 { IBM-Thai csIBMThai }
8365 { HP-Legal csHPLegal }
8366 { HP-Pi-font csHPPiFont }
8367 { HP-Math8 csHPMath8 }
8368 { Adobe-Symbol-Encoding csHPPSMath }
8369 { HP-DeskTop csHPDesktop }
8370 { Ventura-Math csVenturaMath }
8371 { Microsoft-Publishing csMicrosoftPublishing }
8372 { Windows-31J csWindows31J }
8373 { GB2312 csGB2312 }
8374 { Big5 csBig5 }
8377 proc tcl_encoding {enc} {
8378 global encoding_aliases
8379 set names [encoding names]
8380 set lcnames [string tolower $names]
8381 set enc [string tolower $enc]
8382 set i [lsearch -exact $lcnames $enc]
8383 if {$i < 0} {
8384 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8385 if {[regsub {^iso[-_]} $enc iso encx]} {
8386 set i [lsearch -exact $lcnames $encx]
8389 if {$i < 0} {
8390 foreach l $encoding_aliases {
8391 set ll [string tolower $l]
8392 if {[lsearch -exact $ll $enc] < 0} continue
8393 # look through the aliases for one that tcl knows about
8394 foreach e $ll {
8395 set i [lsearch -exact $lcnames $e]
8396 if {$i < 0} {
8397 if {[regsub {^iso[-_]} $e iso ex]} {
8398 set i [lsearch -exact $lcnames $ex]
8401 if {$i >= 0} break
8403 break
8406 if {$i >= 0} {
8407 return [lindex $names $i]
8409 return {}
8412 # First check that Tcl/Tk is recent enough
8413 if {[catch {package require Tk 8.4} err]} {
8414 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8415 Gitk requires at least Tcl/Tk 8.4."]
8416 exit 1
8419 # defaults...
8420 set datemode 0
8421 set wrcomcmd "git diff-tree --stdin -p --pretty"
8423 set gitencoding {}
8424 catch {
8425 set gitencoding [exec git config --get i18n.commitencoding]
8427 if {$gitencoding == ""} {
8428 set gitencoding "utf-8"
8430 set tclencoding [tcl_encoding $gitencoding]
8431 if {$tclencoding == {}} {
8432 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8435 set mainfont {Helvetica 9}
8436 set textfont {Courier 9}
8437 set uifont {Helvetica 9 bold}
8438 set tabstop 8
8439 set findmergefiles 0
8440 set maxgraphpct 50
8441 set maxwidth 16
8442 set revlistorder 0
8443 set fastdate 0
8444 set uparrowlen 5
8445 set downarrowlen 5
8446 set mingaplen 100
8447 set cmitmode "patch"
8448 set wrapcomment "none"
8449 set showneartags 1
8450 set maxrefs 20
8451 set maxlinelen 200
8452 set showlocalchanges 1
8453 set limitdiffs 1
8454 set datetimeformat "%Y-%m-%d %H:%M:%S"
8456 set colors {green red blue magenta darkgrey brown orange}
8457 set bgcolor white
8458 set fgcolor black
8459 set diffcolors {red "#00a000" blue}
8460 set diffcontext 3
8461 set selectbgcolor gray85
8463 ## For msgcat loading, first locate the installation location.
8464 if { [info exists ::env(GITK_MSGSDIR)] } {
8465 ## Msgsdir was manually set in the environment.
8466 set gitk_msgsdir $::env(GITK_MSGSDIR)
8467 } else {
8468 ## Let's guess the prefix from argv0.
8469 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8470 set gitk_libdir [file join $gitk_prefix share gitk lib]
8471 set gitk_msgsdir [file join $gitk_libdir msgs]
8472 unset gitk_prefix
8475 ## Internationalization (i18n) through msgcat and gettext. See
8476 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8477 package require msgcat
8478 namespace import ::msgcat::mc
8479 ## And eventually load the actual message catalog
8480 ::msgcat::mcload $gitk_msgsdir
8482 catch {source ~/.gitk}
8484 font create optionfont -family sans-serif -size -12
8486 parsefont mainfont $mainfont
8487 eval font create mainfont [fontflags mainfont]
8488 eval font create mainfontbold [fontflags mainfont 1]
8490 parsefont textfont $textfont
8491 eval font create textfont [fontflags textfont]
8492 eval font create textfontbold [fontflags textfont 1]
8494 parsefont uifont $uifont
8495 eval font create uifont [fontflags uifont]
8497 setoptions
8499 # check that we can find a .git directory somewhere...
8500 if {[catch {set gitdir [gitdir]}]} {
8501 show_error {} . [mc "Cannot find a git repository here."]
8502 exit 1
8504 if {![file isdirectory $gitdir]} {
8505 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8506 exit 1
8509 set mergeonly 0
8510 set revtreeargs {}
8511 set cmdline_files {}
8512 set i 0
8513 foreach arg $argv {
8514 switch -- $arg {
8515 "" { }
8516 "-d" { set datemode 1 }
8517 "--merge" {
8518 set mergeonly 1
8519 lappend revtreeargs $arg
8521 "--" {
8522 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8523 break
8525 default {
8526 lappend revtreeargs $arg
8529 incr i
8532 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8533 # no -- on command line, but some arguments (other than -d)
8534 if {[catch {
8535 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8536 set cmdline_files [split $f "\n"]
8537 set n [llength $cmdline_files]
8538 set revtreeargs [lrange $revtreeargs 0 end-$n]
8539 # Unfortunately git rev-parse doesn't produce an error when
8540 # something is both a revision and a filename. To be consistent
8541 # with git log and git rev-list, check revtreeargs for filenames.
8542 foreach arg $revtreeargs {
8543 if {[file exists $arg]} {
8544 show_error {} . [mc "Ambiguous argument '%s': both revision\
8545 and filename" $arg]
8546 exit 1
8549 } err]} {
8550 # unfortunately we get both stdout and stderr in $err,
8551 # so look for "fatal:".
8552 set i [string first "fatal:" $err]
8553 if {$i > 0} {
8554 set err [string range $err [expr {$i + 6}] end]
8556 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8557 exit 1
8561 if {$mergeonly} {
8562 # find the list of unmerged files
8563 set mlist {}
8564 set nr_unmerged 0
8565 if {[catch {
8566 set fd [open "| git ls-files -u" r]
8567 } err]} {
8568 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8569 exit 1
8571 while {[gets $fd line] >= 0} {
8572 set i [string first "\t" $line]
8573 if {$i < 0} continue
8574 set fname [string range $line [expr {$i+1}] end]
8575 if {[lsearch -exact $mlist $fname] >= 0} continue
8576 incr nr_unmerged
8577 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8578 lappend mlist $fname
8581 catch {close $fd}
8582 if {$mlist eq {}} {
8583 if {$nr_unmerged == 0} {
8584 show_error {} . [mc "No files selected: --merge specified but\
8585 no files are unmerged."]
8586 } else {
8587 show_error {} . [mc "No files selected: --merge specified but\
8588 no unmerged files are within file limit."]
8590 exit 1
8592 set cmdline_files $mlist
8595 set nullid "0000000000000000000000000000000000000000"
8596 set nullid2 "0000000000000000000000000000000000000001"
8598 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8600 set runq {}
8601 set history {}
8602 set historyindex 0
8603 set fh_serial 0
8604 set nhl_names {}
8605 set highlight_paths {}
8606 set findpattern {}
8607 set searchdirn -forwards
8608 set boldrows {}
8609 set boldnamerows {}
8610 set diffelide {0 0}
8611 set markingmatches 0
8612 set linkentercount 0
8613 set need_redisplay 0
8614 set nrows_drawn 0
8615 set firsttabstop 0
8617 set nextviewnum 1
8618 set curview 0
8619 set selectedview 0
8620 set selectedhlview [mc "None"]
8621 set highlight_related [mc "None"]
8622 set highlight_files {}
8623 set viewfiles(0) {}
8624 set viewperm(0) 0
8625 set viewargs(0) {}
8627 set cmdlineok 0
8628 set stopped 0
8629 set stuffsaved 0
8630 set patchnum 0
8631 set localirow -1
8632 set localfrow -1
8633 set lserial 0
8634 setcoords
8635 makewindow
8636 # wait for the window to become visible
8637 tkwait visibility .
8638 wm title . "[file tail $argv0]: [file tail [pwd]]"
8639 readrefs
8641 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8642 # create a view for the files/dirs specified on the command line
8643 set curview 1
8644 set selectedview 1
8645 set nextviewnum 2
8646 set viewname(1) [mc "Command line"]
8647 set viewfiles(1) $cmdline_files
8648 set viewargs(1) $revtreeargs
8649 set viewperm(1) 0
8650 addviewmenu 1
8651 .bar.view entryconf [mc "Edit view..."] -state normal
8652 .bar.view entryconf [mc "Delete view"] -state normal
8655 if {[info exists permviews]} {
8656 foreach v $permviews {
8657 set n $nextviewnum
8658 incr nextviewnum
8659 set viewname($n) [lindex $v 0]
8660 set viewfiles($n) [lindex $v 1]
8661 set viewargs($n) [lindex $v 2]
8662 set viewperm($n) 1
8663 addviewmenu $n
8666 getcommits