[PATCH] gitk: Add checkbutton to ignore space changes
[alt-git.git] / gitk
blobdab9df067eb1f575002ae2123e60869bfe5e7d7f
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 ignorespace
636 global maincursor textcursor curtextcursor
637 global rowctxmenu fakerowmenu mergemax wrapcomment
638 global highlight_files gdttype
639 global searchstring sstring
640 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
641 global headctxmenu progresscanv progressitem progresscoords statusw
642 global fprogitem fprogcoord lastprogupdate progupdatepending
643 global rprogitem rprogcoord
644 global have_tk85
646 menu .bar
647 .bar add cascade -label [mc "File"] -menu .bar.file
648 menu .bar.file
649 .bar.file add command -label [mc "Update"] -command updatecommits
650 .bar.file add command -label [mc "Reread references"] -command rereadrefs
651 .bar.file add command -label [mc "List references"] -command showrefs
652 .bar.file add command -label [mc "Quit"] -command doquit
653 menu .bar.edit
654 .bar add cascade -label [mc "Edit"] -menu .bar.edit
655 .bar.edit add command -label [mc "Preferences"] -command doprefs
657 menu .bar.view
658 .bar add cascade -label [mc "View"] -menu .bar.view
659 .bar.view add command -label [mc "New view..."] -command {newview 0}
660 .bar.view add command -label [mc "Edit view..."] -command editview \
661 -state disabled
662 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
663 .bar.view add separator
664 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
665 -variable selectedview -value 0
667 menu .bar.help
668 .bar add cascade -label [mc "Help"] -menu .bar.help
669 .bar.help add command -label [mc "About gitk"] -command about
670 .bar.help add command -label [mc "Key bindings"] -command keys
671 .bar.help configure
672 . configure -menu .bar
674 # the gui has upper and lower half, parts of a paned window.
675 panedwindow .ctop -orient vertical
677 # possibly use assumed geometry
678 if {![info exists geometry(pwsash0)]} {
679 set geometry(topheight) [expr {15 * $linespc}]
680 set geometry(topwidth) [expr {80 * $charspc}]
681 set geometry(botheight) [expr {15 * $linespc}]
682 set geometry(botwidth) [expr {50 * $charspc}]
683 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
684 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
687 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
688 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
689 frame .tf.histframe
690 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
692 # create three canvases
693 set cscroll .tf.histframe.csb
694 set canv .tf.histframe.pwclist.canv
695 canvas $canv \
696 -selectbackground $selectbgcolor \
697 -background $bgcolor -bd 0 \
698 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
699 .tf.histframe.pwclist add $canv
700 set canv2 .tf.histframe.pwclist.canv2
701 canvas $canv2 \
702 -selectbackground $selectbgcolor \
703 -background $bgcolor -bd 0 -yscrollincr $linespc
704 .tf.histframe.pwclist add $canv2
705 set canv3 .tf.histframe.pwclist.canv3
706 canvas $canv3 \
707 -selectbackground $selectbgcolor \
708 -background $bgcolor -bd 0 -yscrollincr $linespc
709 .tf.histframe.pwclist add $canv3
710 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
711 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
713 # a scroll bar to rule them
714 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
715 pack $cscroll -side right -fill y
716 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
717 lappend bglist $canv $canv2 $canv3
718 pack .tf.histframe.pwclist -fill both -expand 1 -side left
720 # we have two button bars at bottom of top frame. Bar 1
721 frame .tf.bar
722 frame .tf.lbar -height 15
724 set sha1entry .tf.bar.sha1
725 set entries $sha1entry
726 set sha1but .tf.bar.sha1label
727 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
728 -command gotocommit -width 8
729 $sha1but conf -disabledforeground [$sha1but cget -foreground]
730 pack .tf.bar.sha1label -side left
731 entry $sha1entry -width 40 -font textfont -textvariable sha1string
732 trace add variable sha1string write sha1change
733 pack $sha1entry -side left -pady 2
735 image create bitmap bm-left -data {
736 #define left_width 16
737 #define left_height 16
738 static unsigned char left_bits[] = {
739 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
740 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
741 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
743 image create bitmap bm-right -data {
744 #define right_width 16
745 #define right_height 16
746 static unsigned char right_bits[] = {
747 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
748 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
749 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
751 button .tf.bar.leftbut -image bm-left -command goback \
752 -state disabled -width 26
753 pack .tf.bar.leftbut -side left -fill y
754 button .tf.bar.rightbut -image bm-right -command goforw \
755 -state disabled -width 26
756 pack .tf.bar.rightbut -side left -fill y
758 # Status label and progress bar
759 set statusw .tf.bar.status
760 label $statusw -width 15 -relief sunken
761 pack $statusw -side left -padx 5
762 set h [expr {[font metrics uifont -linespace] + 2}]
763 set progresscanv .tf.bar.progress
764 canvas $progresscanv -relief sunken -height $h -borderwidth 2
765 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
766 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
767 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
768 pack $progresscanv -side right -expand 1 -fill x
769 set progresscoords {0 0}
770 set fprogcoord 0
771 set rprogcoord 0
772 bind $progresscanv <Configure> adjustprogress
773 set lastprogupdate [clock clicks -milliseconds]
774 set progupdatepending 0
776 # build up the bottom bar of upper window
777 label .tf.lbar.flabel -text "[mc "Find"] "
778 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
779 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
780 label .tf.lbar.flab2 -text " [mc "commit"] "
781 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
782 -side left -fill y
783 set gdttype [mc "containing:"]
784 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
785 [mc "containing:"] \
786 [mc "touching paths:"] \
787 [mc "adding/removing string:"]]
788 trace add variable gdttype write gdttype_change
789 pack .tf.lbar.gdttype -side left -fill y
791 set findstring {}
792 set fstring .tf.lbar.findstring
793 lappend entries $fstring
794 entry $fstring -width 30 -font textfont -textvariable findstring
795 trace add variable findstring write find_change
796 set findtype [mc "Exact"]
797 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
798 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
799 trace add variable findtype write findcom_change
800 set findloc [mc "All fields"]
801 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
802 [mc "Comments"] [mc "Author"] [mc "Committer"]
803 trace add variable findloc write find_change
804 pack .tf.lbar.findloc -side right
805 pack .tf.lbar.findtype -side right
806 pack $fstring -side left -expand 1 -fill x
808 # Finish putting the upper half of the viewer together
809 pack .tf.lbar -in .tf -side bottom -fill x
810 pack .tf.bar -in .tf -side bottom -fill x
811 pack .tf.histframe -fill both -side top -expand 1
812 .ctop add .tf
813 .ctop paneconfigure .tf -height $geometry(topheight)
814 .ctop paneconfigure .tf -width $geometry(topwidth)
816 # now build up the bottom
817 panedwindow .pwbottom -orient horizontal
819 # lower left, a text box over search bar, scroll bar to the right
820 # if we know window height, then that will set the lower text height, otherwise
821 # we set lower text height which will drive window height
822 if {[info exists geometry(main)]} {
823 frame .bleft -width $geometry(botwidth)
824 } else {
825 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
827 frame .bleft.top
828 frame .bleft.mid
830 button .bleft.top.search -text [mc "Search"] -command dosearch
831 pack .bleft.top.search -side left -padx 5
832 set sstring .bleft.top.sstring
833 entry $sstring -width 20 -font textfont -textvariable searchstring
834 lappend entries $sstring
835 trace add variable searchstring write incrsearch
836 pack $sstring -side left -expand 1 -fill x
837 radiobutton .bleft.mid.diff -text [mc "Diff"] \
838 -command changediffdisp -variable diffelide -value {0 0}
839 radiobutton .bleft.mid.old -text [mc "Old version"] \
840 -command changediffdisp -variable diffelide -value {0 1}
841 radiobutton .bleft.mid.new -text [mc "New version"] \
842 -command changediffdisp -variable diffelide -value {1 0}
843 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
844 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
845 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
846 -from 1 -increment 1 -to 10000000 \
847 -validate all -validatecommand "diffcontextvalidate %P" \
848 -textvariable diffcontextstring
849 .bleft.mid.diffcontext set $diffcontext
850 trace add variable diffcontextstring write diffcontextchange
851 lappend entries .bleft.mid.diffcontext
852 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
853 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
854 -command changeignorespace -variable ignorespace
855 pack .bleft.mid.ignspace -side left -padx 5
856 set ctext .bleft.ctext
857 text $ctext -background $bgcolor -foreground $fgcolor \
858 -state disabled -font textfont \
859 -yscrollcommand scrolltext -wrap none
860 if {$have_tk85} {
861 $ctext conf -tabstyle wordprocessor
863 scrollbar .bleft.sb -command "$ctext yview"
864 pack .bleft.top -side top -fill x
865 pack .bleft.mid -side top -fill x
866 pack .bleft.sb -side right -fill y
867 pack $ctext -side left -fill both -expand 1
868 lappend bglist $ctext
869 lappend fglist $ctext
871 $ctext tag conf comment -wrap $wrapcomment
872 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
873 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
874 $ctext tag conf d0 -fore [lindex $diffcolors 0]
875 $ctext tag conf d1 -fore [lindex $diffcolors 1]
876 $ctext tag conf m0 -fore red
877 $ctext tag conf m1 -fore blue
878 $ctext tag conf m2 -fore green
879 $ctext tag conf m3 -fore purple
880 $ctext tag conf m4 -fore brown
881 $ctext tag conf m5 -fore "#009090"
882 $ctext tag conf m6 -fore magenta
883 $ctext tag conf m7 -fore "#808000"
884 $ctext tag conf m8 -fore "#009000"
885 $ctext tag conf m9 -fore "#ff0080"
886 $ctext tag conf m10 -fore cyan
887 $ctext tag conf m11 -fore "#b07070"
888 $ctext tag conf m12 -fore "#70b0f0"
889 $ctext tag conf m13 -fore "#70f0b0"
890 $ctext tag conf m14 -fore "#f0b070"
891 $ctext tag conf m15 -fore "#ff70b0"
892 $ctext tag conf mmax -fore darkgrey
893 set mergemax 16
894 $ctext tag conf mresult -font textfontbold
895 $ctext tag conf msep -font textfontbold
896 $ctext tag conf found -back yellow
898 .pwbottom add .bleft
899 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
901 # lower right
902 frame .bright
903 frame .bright.mode
904 radiobutton .bright.mode.patch -text [mc "Patch"] \
905 -command reselectline -variable cmitmode -value "patch"
906 radiobutton .bright.mode.tree -text [mc "Tree"] \
907 -command reselectline -variable cmitmode -value "tree"
908 grid .bright.mode.patch .bright.mode.tree -sticky ew
909 pack .bright.mode -side top -fill x
910 set cflist .bright.cfiles
911 set indent [font measure mainfont "nn"]
912 text $cflist \
913 -selectbackground $selectbgcolor \
914 -background $bgcolor -foreground $fgcolor \
915 -font mainfont \
916 -tabs [list $indent [expr {2 * $indent}]] \
917 -yscrollcommand ".bright.sb set" \
918 -cursor [. cget -cursor] \
919 -spacing1 1 -spacing3 1
920 lappend bglist $cflist
921 lappend fglist $cflist
922 scrollbar .bright.sb -command "$cflist yview"
923 pack .bright.sb -side right -fill y
924 pack $cflist -side left -fill both -expand 1
925 $cflist tag configure highlight \
926 -background [$cflist cget -selectbackground]
927 $cflist tag configure bold -font mainfontbold
929 .pwbottom add .bright
930 .ctop add .pwbottom
932 # restore window position if known
933 if {[info exists geometry(main)]} {
934 wm geometry . "$geometry(main)"
937 if {[tk windowingsystem] eq {aqua}} {
938 set M1B M1
939 } else {
940 set M1B Control
943 bind .pwbottom <Configure> {resizecdetpanes %W %w}
944 pack .ctop -fill both -expand 1
945 bindall <1> {selcanvline %W %x %y}
946 #bindall <B1-Motion> {selcanvline %W %x %y}
947 if {[tk windowingsystem] == "win32"} {
948 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
949 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
950 } else {
951 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
952 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
953 if {[tk windowingsystem] eq "aqua"} {
954 bindall <MouseWheel> {
955 set delta [expr {- (%D)}]
956 allcanvs yview scroll $delta units
960 bindall <2> "canvscan mark %W %x %y"
961 bindall <B2-Motion> "canvscan dragto %W %x %y"
962 bindkey <Home> selfirstline
963 bindkey <End> sellastline
964 bind . <Key-Up> "selnextline -1"
965 bind . <Key-Down> "selnextline 1"
966 bind . <Shift-Key-Up> "dofind -1 0"
967 bind . <Shift-Key-Down> "dofind 1 0"
968 bindkey <Key-Right> "goforw"
969 bindkey <Key-Left> "goback"
970 bind . <Key-Prior> "selnextpage -1"
971 bind . <Key-Next> "selnextpage 1"
972 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
973 bind . <$M1B-End> "allcanvs yview moveto 1.0"
974 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
975 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
976 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
977 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
978 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
979 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
980 bindkey <Key-space> "$ctext yview scroll 1 pages"
981 bindkey p "selnextline -1"
982 bindkey n "selnextline 1"
983 bindkey z "goback"
984 bindkey x "goforw"
985 bindkey i "selnextline -1"
986 bindkey k "selnextline 1"
987 bindkey j "goback"
988 bindkey l "goforw"
989 bindkey b "$ctext yview scroll -1 pages"
990 bindkey d "$ctext yview scroll 18 units"
991 bindkey u "$ctext yview scroll -18 units"
992 bindkey / {dofind 1 1}
993 bindkey <Key-Return> {dofind 1 1}
994 bindkey ? {dofind -1 1}
995 bindkey f nextfile
996 bindkey <F5> updatecommits
997 bind . <$M1B-q> doquit
998 bind . <$M1B-f> {dofind 1 1}
999 bind . <$M1B-g> {dofind 1 0}
1000 bind . <$M1B-r> dosearchback
1001 bind . <$M1B-s> dosearch
1002 bind . <$M1B-equal> {incrfont 1}
1003 bind . <$M1B-plus> {incrfont 1}
1004 bind . <$M1B-KP_Add> {incrfont 1}
1005 bind . <$M1B-minus> {incrfont -1}
1006 bind . <$M1B-KP_Subtract> {incrfont -1}
1007 wm protocol . WM_DELETE_WINDOW doquit
1008 bind . <Button-1> "click %W"
1009 bind $fstring <Key-Return> {dofind 1 1}
1010 bind $sha1entry <Key-Return> gotocommit
1011 bind $sha1entry <<PasteSelection>> clearsha1
1012 bind $cflist <1> {sel_flist %W %x %y; break}
1013 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1014 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1015 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1017 set maincursor [. cget -cursor]
1018 set textcursor [$ctext cget -cursor]
1019 set curtextcursor $textcursor
1021 set rowctxmenu .rowctxmenu
1022 menu $rowctxmenu -tearoff 0
1023 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1024 -command {diffvssel 0}
1025 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1026 -command {diffvssel 1}
1027 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1028 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1029 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1030 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1031 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1032 -command cherrypick
1033 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1034 -command resethead
1036 set fakerowmenu .fakerowmenu
1037 menu $fakerowmenu -tearoff 0
1038 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1039 -command {diffvssel 0}
1040 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1041 -command {diffvssel 1}
1042 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1043 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1044 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1045 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1047 set headctxmenu .headctxmenu
1048 menu $headctxmenu -tearoff 0
1049 $headctxmenu add command -label [mc "Check out this branch"] \
1050 -command cobranch
1051 $headctxmenu add command -label [mc "Remove this branch"] \
1052 -command rmbranch
1054 global flist_menu
1055 set flist_menu .flistctxmenu
1056 menu $flist_menu -tearoff 0
1057 $flist_menu add command -label [mc "Highlight this too"] \
1058 -command {flist_hl 0}
1059 $flist_menu add command -label [mc "Highlight this only"] \
1060 -command {flist_hl 1}
1063 # Windows sends all mouse wheel events to the current focused window, not
1064 # the one where the mouse hovers, so bind those events here and redirect
1065 # to the correct window
1066 proc windows_mousewheel_redirector {W X Y D} {
1067 global canv canv2 canv3
1068 set w [winfo containing -displayof $W $X $Y]
1069 if {$w ne ""} {
1070 set u [expr {$D < 0 ? 5 : -5}]
1071 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1072 allcanvs yview scroll $u units
1073 } else {
1074 catch {
1075 $w yview scroll $u units
1081 # mouse-2 makes all windows scan vertically, but only the one
1082 # the cursor is in scans horizontally
1083 proc canvscan {op w x y} {
1084 global canv canv2 canv3
1085 foreach c [list $canv $canv2 $canv3] {
1086 if {$c == $w} {
1087 $c scan $op $x $y
1088 } else {
1089 $c scan $op 0 $y
1094 proc scrollcanv {cscroll f0 f1} {
1095 $cscroll set $f0 $f1
1096 drawfrac $f0 $f1
1097 flushhighlights
1100 # when we make a key binding for the toplevel, make sure
1101 # it doesn't get triggered when that key is pressed in the
1102 # find string entry widget.
1103 proc bindkey {ev script} {
1104 global entries
1105 bind . $ev $script
1106 set escript [bind Entry $ev]
1107 if {$escript == {}} {
1108 set escript [bind Entry <Key>]
1110 foreach e $entries {
1111 bind $e $ev "$escript; break"
1115 # set the focus back to the toplevel for any click outside
1116 # the entry widgets
1117 proc click {w} {
1118 global ctext entries
1119 foreach e [concat $entries $ctext] {
1120 if {$w == $e} return
1122 focus .
1125 # Adjust the progress bar for a change in requested extent or canvas size
1126 proc adjustprogress {} {
1127 global progresscanv progressitem progresscoords
1128 global fprogitem fprogcoord lastprogupdate progupdatepending
1129 global rprogitem rprogcoord
1131 set w [expr {[winfo width $progresscanv] - 4}]
1132 set x0 [expr {$w * [lindex $progresscoords 0]}]
1133 set x1 [expr {$w * [lindex $progresscoords 1]}]
1134 set h [winfo height $progresscanv]
1135 $progresscanv coords $progressitem $x0 0 $x1 $h
1136 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1137 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1138 set now [clock clicks -milliseconds]
1139 if {$now >= $lastprogupdate + 100} {
1140 set progupdatepending 0
1141 update
1142 } elseif {!$progupdatepending} {
1143 set progupdatepending 1
1144 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1148 proc doprogupdate {} {
1149 global lastprogupdate progupdatepending
1151 if {$progupdatepending} {
1152 set progupdatepending 0
1153 set lastprogupdate [clock clicks -milliseconds]
1154 update
1158 proc savestuff {w} {
1159 global canv canv2 canv3 mainfont textfont uifont tabstop
1160 global stuffsaved findmergefiles maxgraphpct
1161 global maxwidth showneartags showlocalchanges
1162 global viewname viewfiles viewargs viewperm nextviewnum
1163 global cmitmode wrapcomment datetimeformat limitdiffs
1164 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1166 if {$stuffsaved} return
1167 if {![winfo viewable .]} return
1168 catch {
1169 set f [open "~/.gitk-new" w]
1170 puts $f [list set mainfont $mainfont]
1171 puts $f [list set textfont $textfont]
1172 puts $f [list set uifont $uifont]
1173 puts $f [list set tabstop $tabstop]
1174 puts $f [list set findmergefiles $findmergefiles]
1175 puts $f [list set maxgraphpct $maxgraphpct]
1176 puts $f [list set maxwidth $maxwidth]
1177 puts $f [list set cmitmode $cmitmode]
1178 puts $f [list set wrapcomment $wrapcomment]
1179 puts $f [list set showneartags $showneartags]
1180 puts $f [list set showlocalchanges $showlocalchanges]
1181 puts $f [list set datetimeformat $datetimeformat]
1182 puts $f [list set limitdiffs $limitdiffs]
1183 puts $f [list set bgcolor $bgcolor]
1184 puts $f [list set fgcolor $fgcolor]
1185 puts $f [list set colors $colors]
1186 puts $f [list set diffcolors $diffcolors]
1187 puts $f [list set diffcontext $diffcontext]
1188 puts $f [list set selectbgcolor $selectbgcolor]
1190 puts $f "set geometry(main) [wm geometry .]"
1191 puts $f "set geometry(topwidth) [winfo width .tf]"
1192 puts $f "set geometry(topheight) [winfo height .tf]"
1193 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1194 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1195 puts $f "set geometry(botwidth) [winfo width .bleft]"
1196 puts $f "set geometry(botheight) [winfo height .bleft]"
1198 puts -nonewline $f "set permviews {"
1199 for {set v 0} {$v < $nextviewnum} {incr v} {
1200 if {$viewperm($v)} {
1201 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1204 puts $f "}"
1205 close $f
1206 file rename -force "~/.gitk-new" "~/.gitk"
1208 set stuffsaved 1
1211 proc resizeclistpanes {win w} {
1212 global oldwidth
1213 if {[info exists oldwidth($win)]} {
1214 set s0 [$win sash coord 0]
1215 set s1 [$win sash coord 1]
1216 if {$w < 60} {
1217 set sash0 [expr {int($w/2 - 2)}]
1218 set sash1 [expr {int($w*5/6 - 2)}]
1219 } else {
1220 set factor [expr {1.0 * $w / $oldwidth($win)}]
1221 set sash0 [expr {int($factor * [lindex $s0 0])}]
1222 set sash1 [expr {int($factor * [lindex $s1 0])}]
1223 if {$sash0 < 30} {
1224 set sash0 30
1226 if {$sash1 < $sash0 + 20} {
1227 set sash1 [expr {$sash0 + 20}]
1229 if {$sash1 > $w - 10} {
1230 set sash1 [expr {$w - 10}]
1231 if {$sash0 > $sash1 - 20} {
1232 set sash0 [expr {$sash1 - 20}]
1236 $win sash place 0 $sash0 [lindex $s0 1]
1237 $win sash place 1 $sash1 [lindex $s1 1]
1239 set oldwidth($win) $w
1242 proc resizecdetpanes {win w} {
1243 global oldwidth
1244 if {[info exists oldwidth($win)]} {
1245 set s0 [$win sash coord 0]
1246 if {$w < 60} {
1247 set sash0 [expr {int($w*3/4 - 2)}]
1248 } else {
1249 set factor [expr {1.0 * $w / $oldwidth($win)}]
1250 set sash0 [expr {int($factor * [lindex $s0 0])}]
1251 if {$sash0 < 45} {
1252 set sash0 45
1254 if {$sash0 > $w - 15} {
1255 set sash0 [expr {$w - 15}]
1258 $win sash place 0 $sash0 [lindex $s0 1]
1260 set oldwidth($win) $w
1263 proc allcanvs args {
1264 global canv canv2 canv3
1265 eval $canv $args
1266 eval $canv2 $args
1267 eval $canv3 $args
1270 proc bindall {event action} {
1271 global canv canv2 canv3
1272 bind $canv $event $action
1273 bind $canv2 $event $action
1274 bind $canv3 $event $action
1277 proc about {} {
1278 global uifont
1279 set w .about
1280 if {[winfo exists $w]} {
1281 raise $w
1282 return
1284 toplevel $w
1285 wm title $w [mc "About gitk"]
1286 message $w.m -text [mc "
1287 Gitk - a commit viewer for git
1289 Copyright © 2005-2006 Paul Mackerras
1291 Use and redistribute under the terms of the GNU General Public License"] \
1292 -justify center -aspect 400 -border 2 -bg white -relief groove
1293 pack $w.m -side top -fill x -padx 2 -pady 2
1294 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1295 pack $w.ok -side bottom
1296 bind $w <Visibility> "focus $w.ok"
1297 bind $w <Key-Escape> "destroy $w"
1298 bind $w <Key-Return> "destroy $w"
1301 proc keys {} {
1302 set w .keys
1303 if {[winfo exists $w]} {
1304 raise $w
1305 return
1307 if {[tk windowingsystem] eq {aqua}} {
1308 set M1T Cmd
1309 } else {
1310 set M1T Ctrl
1312 toplevel $w
1313 wm title $w [mc "Gitk key bindings"]
1314 message $w.m -text "
1315 [mc "Gitk key bindings:"]
1317 [mc "<%s-Q> Quit" $M1T]
1318 [mc "<Home> Move to first commit"]
1319 [mc "<End> Move to last commit"]
1320 [mc "<Up>, p, i Move up one commit"]
1321 [mc "<Down>, n, k Move down one commit"]
1322 [mc "<Left>, z, j Go back in history list"]
1323 [mc "<Right>, x, l Go forward in history list"]
1324 [mc "<PageUp> Move up one page in commit list"]
1325 [mc "<PageDown> Move down one page in commit list"]
1326 [mc "<%s-Home> Scroll to top of commit list" $M1T]
1327 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
1328 [mc "<%s-Up> Scroll commit list up one line" $M1T]
1329 [mc "<%s-Down> Scroll commit list down one line" $M1T]
1330 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
1331 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
1332 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
1333 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
1334 [mc "<Delete>, b Scroll diff view up one page"]
1335 [mc "<Backspace> Scroll diff view up one page"]
1336 [mc "<Space> Scroll diff view down one page"]
1337 [mc "u Scroll diff view up 18 lines"]
1338 [mc "d Scroll diff view down 18 lines"]
1339 [mc "<%s-F> Find" $M1T]
1340 [mc "<%s-G> Move to next find hit" $M1T]
1341 [mc "<Return> Move to next find hit"]
1342 [mc "/ Move to next find hit, or redo find"]
1343 [mc "? Move to previous find hit"]
1344 [mc "f Scroll diff view to next file"]
1345 [mc "<%s-S> Search for next hit in diff view" $M1T]
1346 [mc "<%s-R> Search for previous hit in diff view" $M1T]
1347 [mc "<%s-KP+> Increase font size" $M1T]
1348 [mc "<%s-plus> Increase font size" $M1T]
1349 [mc "<%s-KP-> Decrease font size" $M1T]
1350 [mc "<%s-minus> Decrease font size" $M1T]
1351 [mc "<F5> Update"]
1353 -justify left -bg white -border 2 -relief groove
1354 pack $w.m -side top -fill both -padx 2 -pady 2
1355 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1356 pack $w.ok -side bottom
1357 bind $w <Visibility> "focus $w.ok"
1358 bind $w <Key-Escape> "destroy $w"
1359 bind $w <Key-Return> "destroy $w"
1362 # Procedures for manipulating the file list window at the
1363 # bottom right of the overall window.
1365 proc treeview {w l openlevs} {
1366 global treecontents treediropen treeheight treeparent treeindex
1368 set ix 0
1369 set treeindex() 0
1370 set lev 0
1371 set prefix {}
1372 set prefixend -1
1373 set prefendstack {}
1374 set htstack {}
1375 set ht 0
1376 set treecontents() {}
1377 $w conf -state normal
1378 foreach f $l {
1379 while {[string range $f 0 $prefixend] ne $prefix} {
1380 if {$lev <= $openlevs} {
1381 $w mark set e:$treeindex($prefix) "end -1c"
1382 $w mark gravity e:$treeindex($prefix) left
1384 set treeheight($prefix) $ht
1385 incr ht [lindex $htstack end]
1386 set htstack [lreplace $htstack end end]
1387 set prefixend [lindex $prefendstack end]
1388 set prefendstack [lreplace $prefendstack end end]
1389 set prefix [string range $prefix 0 $prefixend]
1390 incr lev -1
1392 set tail [string range $f [expr {$prefixend+1}] end]
1393 while {[set slash [string first "/" $tail]] >= 0} {
1394 lappend htstack $ht
1395 set ht 0
1396 lappend prefendstack $prefixend
1397 incr prefixend [expr {$slash + 1}]
1398 set d [string range $tail 0 $slash]
1399 lappend treecontents($prefix) $d
1400 set oldprefix $prefix
1401 append prefix $d
1402 set treecontents($prefix) {}
1403 set treeindex($prefix) [incr ix]
1404 set treeparent($prefix) $oldprefix
1405 set tail [string range $tail [expr {$slash+1}] end]
1406 if {$lev <= $openlevs} {
1407 set ht 1
1408 set treediropen($prefix) [expr {$lev < $openlevs}]
1409 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1410 $w mark set d:$ix "end -1c"
1411 $w mark gravity d:$ix left
1412 set str "\n"
1413 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1414 $w insert end $str
1415 $w image create end -align center -image $bm -padx 1 \
1416 -name a:$ix
1417 $w insert end $d [highlight_tag $prefix]
1418 $w mark set s:$ix "end -1c"
1419 $w mark gravity s:$ix left
1421 incr lev
1423 if {$tail ne {}} {
1424 if {$lev <= $openlevs} {
1425 incr ht
1426 set str "\n"
1427 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1428 $w insert end $str
1429 $w insert end $tail [highlight_tag $f]
1431 lappend treecontents($prefix) $tail
1434 while {$htstack ne {}} {
1435 set treeheight($prefix) $ht
1436 incr ht [lindex $htstack end]
1437 set htstack [lreplace $htstack end end]
1438 set prefixend [lindex $prefendstack end]
1439 set prefendstack [lreplace $prefendstack end end]
1440 set prefix [string range $prefix 0 $prefixend]
1442 $w conf -state disabled
1445 proc linetoelt {l} {
1446 global treeheight treecontents
1448 set y 2
1449 set prefix {}
1450 while {1} {
1451 foreach e $treecontents($prefix) {
1452 if {$y == $l} {
1453 return "$prefix$e"
1455 set n 1
1456 if {[string index $e end] eq "/"} {
1457 set n $treeheight($prefix$e)
1458 if {$y + $n > $l} {
1459 append prefix $e
1460 incr y
1461 break
1464 incr y $n
1469 proc highlight_tree {y prefix} {
1470 global treeheight treecontents cflist
1472 foreach e $treecontents($prefix) {
1473 set path $prefix$e
1474 if {[highlight_tag $path] ne {}} {
1475 $cflist tag add bold $y.0 "$y.0 lineend"
1477 incr y
1478 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1479 set y [highlight_tree $y $path]
1482 return $y
1485 proc treeclosedir {w dir} {
1486 global treediropen treeheight treeparent treeindex
1488 set ix $treeindex($dir)
1489 $w conf -state normal
1490 $w delete s:$ix e:$ix
1491 set treediropen($dir) 0
1492 $w image configure a:$ix -image tri-rt
1493 $w conf -state disabled
1494 set n [expr {1 - $treeheight($dir)}]
1495 while {$dir ne {}} {
1496 incr treeheight($dir) $n
1497 set dir $treeparent($dir)
1501 proc treeopendir {w dir} {
1502 global treediropen treeheight treeparent treecontents treeindex
1504 set ix $treeindex($dir)
1505 $w conf -state normal
1506 $w image configure a:$ix -image tri-dn
1507 $w mark set e:$ix s:$ix
1508 $w mark gravity e:$ix right
1509 set lev 0
1510 set str "\n"
1511 set n [llength $treecontents($dir)]
1512 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1513 incr lev
1514 append str "\t"
1515 incr treeheight($x) $n
1517 foreach e $treecontents($dir) {
1518 set de $dir$e
1519 if {[string index $e end] eq "/"} {
1520 set iy $treeindex($de)
1521 $w mark set d:$iy e:$ix
1522 $w mark gravity d:$iy left
1523 $w insert e:$ix $str
1524 set treediropen($de) 0
1525 $w image create e:$ix -align center -image tri-rt -padx 1 \
1526 -name a:$iy
1527 $w insert e:$ix $e [highlight_tag $de]
1528 $w mark set s:$iy e:$ix
1529 $w mark gravity s:$iy left
1530 set treeheight($de) 1
1531 } else {
1532 $w insert e:$ix $str
1533 $w insert e:$ix $e [highlight_tag $de]
1536 $w mark gravity e:$ix left
1537 $w conf -state disabled
1538 set treediropen($dir) 1
1539 set top [lindex [split [$w index @0,0] .] 0]
1540 set ht [$w cget -height]
1541 set l [lindex [split [$w index s:$ix] .] 0]
1542 if {$l < $top} {
1543 $w yview $l.0
1544 } elseif {$l + $n + 1 > $top + $ht} {
1545 set top [expr {$l + $n + 2 - $ht}]
1546 if {$l < $top} {
1547 set top $l
1549 $w yview $top.0
1553 proc treeclick {w x y} {
1554 global treediropen cmitmode ctext cflist cflist_top
1556 if {$cmitmode ne "tree"} return
1557 if {![info exists cflist_top]} return
1558 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1559 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1560 $cflist tag add highlight $l.0 "$l.0 lineend"
1561 set cflist_top $l
1562 if {$l == 1} {
1563 $ctext yview 1.0
1564 return
1566 set e [linetoelt $l]
1567 if {[string index $e end] ne "/"} {
1568 showfile $e
1569 } elseif {$treediropen($e)} {
1570 treeclosedir $w $e
1571 } else {
1572 treeopendir $w $e
1576 proc setfilelist {id} {
1577 global treefilelist cflist
1579 treeview $cflist $treefilelist($id) 0
1582 image create bitmap tri-rt -background black -foreground blue -data {
1583 #define tri-rt_width 13
1584 #define tri-rt_height 13
1585 static unsigned char tri-rt_bits[] = {
1586 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1587 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1588 0x00, 0x00};
1589 } -maskdata {
1590 #define tri-rt-mask_width 13
1591 #define tri-rt-mask_height 13
1592 static unsigned char tri-rt-mask_bits[] = {
1593 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1594 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1595 0x08, 0x00};
1597 image create bitmap tri-dn -background black -foreground blue -data {
1598 #define tri-dn_width 13
1599 #define tri-dn_height 13
1600 static unsigned char tri-dn_bits[] = {
1601 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1602 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1603 0x00, 0x00};
1604 } -maskdata {
1605 #define tri-dn-mask_width 13
1606 #define tri-dn-mask_height 13
1607 static unsigned char tri-dn-mask_bits[] = {
1608 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1609 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1610 0x00, 0x00};
1613 image create bitmap reficon-T -background black -foreground yellow -data {
1614 #define tagicon_width 13
1615 #define tagicon_height 9
1616 static unsigned char tagicon_bits[] = {
1617 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1618 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1619 } -maskdata {
1620 #define tagicon-mask_width 13
1621 #define tagicon-mask_height 9
1622 static unsigned char tagicon-mask_bits[] = {
1623 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1624 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1626 set rectdata {
1627 #define headicon_width 13
1628 #define headicon_height 9
1629 static unsigned char headicon_bits[] = {
1630 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1631 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1633 set rectmask {
1634 #define headicon-mask_width 13
1635 #define headicon-mask_height 9
1636 static unsigned char headicon-mask_bits[] = {
1637 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1638 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1640 image create bitmap reficon-H -background black -foreground green \
1641 -data $rectdata -maskdata $rectmask
1642 image create bitmap reficon-o -background black -foreground "#ddddff" \
1643 -data $rectdata -maskdata $rectmask
1645 proc init_flist {first} {
1646 global cflist cflist_top selectedline difffilestart
1648 $cflist conf -state normal
1649 $cflist delete 0.0 end
1650 if {$first ne {}} {
1651 $cflist insert end $first
1652 set cflist_top 1
1653 $cflist tag add highlight 1.0 "1.0 lineend"
1654 } else {
1655 catch {unset cflist_top}
1657 $cflist conf -state disabled
1658 set difffilestart {}
1661 proc highlight_tag {f} {
1662 global highlight_paths
1664 foreach p $highlight_paths {
1665 if {[string match $p $f]} {
1666 return "bold"
1669 return {}
1672 proc highlight_filelist {} {
1673 global cmitmode cflist
1675 $cflist conf -state normal
1676 if {$cmitmode ne "tree"} {
1677 set end [lindex [split [$cflist index end] .] 0]
1678 for {set l 2} {$l < $end} {incr l} {
1679 set line [$cflist get $l.0 "$l.0 lineend"]
1680 if {[highlight_tag $line] ne {}} {
1681 $cflist tag add bold $l.0 "$l.0 lineend"
1684 } else {
1685 highlight_tree 2 {}
1687 $cflist conf -state disabled
1690 proc unhighlight_filelist {} {
1691 global cflist
1693 $cflist conf -state normal
1694 $cflist tag remove bold 1.0 end
1695 $cflist conf -state disabled
1698 proc add_flist {fl} {
1699 global cflist
1701 $cflist conf -state normal
1702 foreach f $fl {
1703 $cflist insert end "\n"
1704 $cflist insert end $f [highlight_tag $f]
1706 $cflist conf -state disabled
1709 proc sel_flist {w x y} {
1710 global ctext difffilestart cflist cflist_top cmitmode
1712 if {$cmitmode eq "tree"} return
1713 if {![info exists cflist_top]} return
1714 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1715 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1716 $cflist tag add highlight $l.0 "$l.0 lineend"
1717 set cflist_top $l
1718 if {$l == 1} {
1719 $ctext yview 1.0
1720 } else {
1721 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1725 proc pop_flist_menu {w X Y x y} {
1726 global ctext cflist cmitmode flist_menu flist_menu_file
1727 global treediffs diffids
1729 stopfinding
1730 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1731 if {$l <= 1} return
1732 if {$cmitmode eq "tree"} {
1733 set e [linetoelt $l]
1734 if {[string index $e end] eq "/"} return
1735 } else {
1736 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1738 set flist_menu_file $e
1739 tk_popup $flist_menu $X $Y
1742 proc flist_hl {only} {
1743 global flist_menu_file findstring gdttype
1745 set x [shellquote $flist_menu_file]
1746 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1747 set findstring $x
1748 } else {
1749 append findstring " " $x
1751 set gdttype [mc "touching paths:"]
1754 # Functions for adding and removing shell-type quoting
1756 proc shellquote {str} {
1757 if {![string match "*\['\"\\ \t]*" $str]} {
1758 return $str
1760 if {![string match "*\['\"\\]*" $str]} {
1761 return "\"$str\""
1763 if {![string match "*'*" $str]} {
1764 return "'$str'"
1766 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1769 proc shellarglist {l} {
1770 set str {}
1771 foreach a $l {
1772 if {$str ne {}} {
1773 append str " "
1775 append str [shellquote $a]
1777 return $str
1780 proc shelldequote {str} {
1781 set ret {}
1782 set used -1
1783 while {1} {
1784 incr used
1785 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1786 append ret [string range $str $used end]
1787 set used [string length $str]
1788 break
1790 set first [lindex $first 0]
1791 set ch [string index $str $first]
1792 if {$first > $used} {
1793 append ret [string range $str $used [expr {$first - 1}]]
1794 set used $first
1796 if {$ch eq " " || $ch eq "\t"} break
1797 incr used
1798 if {$ch eq "'"} {
1799 set first [string first "'" $str $used]
1800 if {$first < 0} {
1801 error "unmatched single-quote"
1803 append ret [string range $str $used [expr {$first - 1}]]
1804 set used $first
1805 continue
1807 if {$ch eq "\\"} {
1808 if {$used >= [string length $str]} {
1809 error "trailing backslash"
1811 append ret [string index $str $used]
1812 continue
1814 # here ch == "\""
1815 while {1} {
1816 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1817 error "unmatched double-quote"
1819 set first [lindex $first 0]
1820 set ch [string index $str $first]
1821 if {$first > $used} {
1822 append ret [string range $str $used [expr {$first - 1}]]
1823 set used $first
1825 if {$ch eq "\""} break
1826 incr used
1827 append ret [string index $str $used]
1828 incr used
1831 return [list $used $ret]
1834 proc shellsplit {str} {
1835 set l {}
1836 while {1} {
1837 set str [string trimleft $str]
1838 if {$str eq {}} break
1839 set dq [shelldequote $str]
1840 set n [lindex $dq 0]
1841 set word [lindex $dq 1]
1842 set str [string range $str $n end]
1843 lappend l $word
1845 return $l
1848 # Code to implement multiple views
1850 proc newview {ishighlight} {
1851 global nextviewnum newviewname newviewperm newishighlight
1852 global newviewargs revtreeargs
1854 set newishighlight $ishighlight
1855 set top .gitkview
1856 if {[winfo exists $top]} {
1857 raise $top
1858 return
1860 set newviewname($nextviewnum) "View $nextviewnum"
1861 set newviewperm($nextviewnum) 0
1862 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1863 vieweditor $top $nextviewnum [mc "Gitk view definition"]
1866 proc editview {} {
1867 global curview
1868 global viewname viewperm newviewname newviewperm
1869 global viewargs newviewargs
1871 set top .gitkvedit-$curview
1872 if {[winfo exists $top]} {
1873 raise $top
1874 return
1876 set newviewname($curview) $viewname($curview)
1877 set newviewperm($curview) $viewperm($curview)
1878 set newviewargs($curview) [shellarglist $viewargs($curview)]
1879 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1882 proc vieweditor {top n title} {
1883 global newviewname newviewperm viewfiles bgcolor
1885 toplevel $top
1886 wm title $top $title
1887 label $top.nl -text [mc "Name"]
1888 entry $top.name -width 20 -textvariable newviewname($n)
1889 grid $top.nl $top.name -sticky w -pady 5
1890 checkbutton $top.perm -text [mc "Remember this view"] \
1891 -variable newviewperm($n)
1892 grid $top.perm - -pady 5 -sticky w
1893 message $top.al -aspect 1000 \
1894 -text [mc "Commits to include (arguments to git rev-list):"]
1895 grid $top.al - -sticky w -pady 5
1896 entry $top.args -width 50 -textvariable newviewargs($n) \
1897 -background $bgcolor
1898 grid $top.args - -sticky ew -padx 5
1899 message $top.l -aspect 1000 \
1900 -text [mc "Enter files and directories to include, one per line:"]
1901 grid $top.l - -sticky w
1902 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1903 if {[info exists viewfiles($n)]} {
1904 foreach f $viewfiles($n) {
1905 $top.t insert end $f
1906 $top.t insert end "\n"
1908 $top.t delete {end - 1c} end
1909 $top.t mark set insert 0.0
1911 grid $top.t - -sticky ew -padx 5
1912 frame $top.buts
1913 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1914 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1915 grid $top.buts.ok $top.buts.can
1916 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1917 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1918 grid $top.buts - -pady 10 -sticky ew
1919 focus $top.t
1922 proc doviewmenu {m first cmd op argv} {
1923 set nmenu [$m index end]
1924 for {set i $first} {$i <= $nmenu} {incr i} {
1925 if {[$m entrycget $i -command] eq $cmd} {
1926 eval $m $op $i $argv
1927 break
1932 proc allviewmenus {n op args} {
1933 # global viewhlmenu
1935 doviewmenu .bar.view 5 [list showview $n] $op $args
1936 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1939 proc newviewok {top n} {
1940 global nextviewnum newviewperm newviewname newishighlight
1941 global viewname viewfiles viewperm selectedview curview
1942 global viewargs newviewargs viewhlmenu
1944 if {[catch {
1945 set newargs [shellsplit $newviewargs($n)]
1946 } err]} {
1947 error_popup "[mc "Error in commit selection arguments:"] $err"
1948 wm raise $top
1949 focus $top
1950 return
1952 set files {}
1953 foreach f [split [$top.t get 0.0 end] "\n"] {
1954 set ft [string trim $f]
1955 if {$ft ne {}} {
1956 lappend files $ft
1959 if {![info exists viewfiles($n)]} {
1960 # creating a new view
1961 incr nextviewnum
1962 set viewname($n) $newviewname($n)
1963 set viewperm($n) $newviewperm($n)
1964 set viewfiles($n) $files
1965 set viewargs($n) $newargs
1966 addviewmenu $n
1967 if {!$newishighlight} {
1968 run showview $n
1969 } else {
1970 run addvhighlight $n
1972 } else {
1973 # editing an existing view
1974 set viewperm($n) $newviewperm($n)
1975 if {$newviewname($n) ne $viewname($n)} {
1976 set viewname($n) $newviewname($n)
1977 doviewmenu .bar.view 5 [list showview $n] \
1978 entryconf [list -label $viewname($n)]
1979 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1980 # entryconf [list -label $viewname($n) -value $viewname($n)]
1982 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1983 set viewfiles($n) $files
1984 set viewargs($n) $newargs
1985 if {$curview == $n} {
1986 run updatecommits
1990 catch {destroy $top}
1993 proc delview {} {
1994 global curview viewdata viewperm hlview selectedhlview
1996 if {$curview == 0} return
1997 if {[info exists hlview] && $hlview == $curview} {
1998 set selectedhlview [mc "None"]
1999 unset hlview
2001 allviewmenus $curview delete
2002 set viewdata($curview) {}
2003 set viewperm($curview) 0
2004 showview 0
2007 proc addviewmenu {n} {
2008 global viewname viewhlmenu
2010 .bar.view add radiobutton -label $viewname($n) \
2011 -command [list showview $n] -variable selectedview -value $n
2012 #$viewhlmenu add radiobutton -label $viewname($n) \
2013 # -command [list addvhighlight $n] -variable selectedhlview
2016 proc flatten {var} {
2017 global $var
2019 set ret {}
2020 foreach i [array names $var] {
2021 lappend ret $i [set $var\($i\)]
2023 return $ret
2026 proc unflatten {var l} {
2027 global $var
2029 catch {unset $var}
2030 foreach {i v} $l {
2031 set $var\($i\) $v
2035 proc showview {n} {
2036 global curview viewdata viewfiles
2037 global displayorder parentlist rowidlist rowisopt rowfinal
2038 global colormap rowtextx commitrow nextcolor canvxmax
2039 global numcommits commitlisted
2040 global selectedline currentid canv canvy0
2041 global treediffs
2042 global pending_select phase
2043 global commitidx
2044 global commfd
2045 global selectedview selectfirst
2046 global vparentlist vdisporder vcmitlisted
2047 global hlview selectedhlview commitinterest
2049 if {$n == $curview} return
2050 set selid {}
2051 if {[info exists selectedline]} {
2052 set selid $currentid
2053 set y [yc $selectedline]
2054 set ymax [lindex [$canv cget -scrollregion] 3]
2055 set span [$canv yview]
2056 set ytop [expr {[lindex $span 0] * $ymax}]
2057 set ybot [expr {[lindex $span 1] * $ymax}]
2058 if {$ytop < $y && $y < $ybot} {
2059 set yscreen [expr {$y - $ytop}]
2060 } else {
2061 set yscreen [expr {($ybot - $ytop) / 2}]
2063 } elseif {[info exists pending_select]} {
2064 set selid $pending_select
2065 unset pending_select
2067 unselectline
2068 normalline
2069 if {$curview >= 0} {
2070 set vparentlist($curview) $parentlist
2071 set vdisporder($curview) $displayorder
2072 set vcmitlisted($curview) $commitlisted
2073 if {$phase ne {} ||
2074 ![info exists viewdata($curview)] ||
2075 [lindex $viewdata($curview) 0] ne {}} {
2076 set viewdata($curview) \
2077 [list $phase $rowidlist $rowisopt $rowfinal]
2080 catch {unset treediffs}
2081 clear_display
2082 if {[info exists hlview] && $hlview == $n} {
2083 unset hlview
2084 set selectedhlview [mc "None"]
2086 catch {unset commitinterest}
2088 set curview $n
2089 set selectedview $n
2090 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2091 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2093 run refill_reflist
2094 if {![info exists viewdata($n)]} {
2095 if {$selid ne {}} {
2096 set pending_select $selid
2098 getcommits
2099 return
2102 set v $viewdata($n)
2103 set phase [lindex $v 0]
2104 set displayorder $vdisporder($n)
2105 set parentlist $vparentlist($n)
2106 set commitlisted $vcmitlisted($n)
2107 set rowidlist [lindex $v 1]
2108 set rowisopt [lindex $v 2]
2109 set rowfinal [lindex $v 3]
2110 set numcommits $commitidx($n)
2112 catch {unset colormap}
2113 catch {unset rowtextx}
2114 set nextcolor 0
2115 set canvxmax [$canv cget -width]
2116 set curview $n
2117 set row 0
2118 setcanvscroll
2119 set yf 0
2120 set row {}
2121 set selectfirst 0
2122 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2123 set row $commitrow($n,$selid)
2124 # try to get the selected row in the same position on the screen
2125 set ymax [lindex [$canv cget -scrollregion] 3]
2126 set ytop [expr {[yc $row] - $yscreen}]
2127 if {$ytop < 0} {
2128 set ytop 0
2130 set yf [expr {$ytop * 1.0 / $ymax}]
2132 allcanvs yview moveto $yf
2133 drawvisible
2134 if {$row ne {}} {
2135 selectline $row 0
2136 } elseif {$selid ne {}} {
2137 set pending_select $selid
2138 } else {
2139 set row [first_real_row]
2140 if {$row < $numcommits} {
2141 selectline $row 0
2142 } else {
2143 set selectfirst 1
2146 if {$phase ne {}} {
2147 if {$phase eq "getcommits"} {
2148 show_status [mc "Reading commits..."]
2150 run chewcommits $n
2151 } elseif {$numcommits == 0} {
2152 show_status [mc "No commits selected"]
2156 # Stuff relating to the highlighting facility
2158 proc ishighlighted {row} {
2159 global vhighlights fhighlights nhighlights rhighlights
2161 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2162 return $nhighlights($row)
2164 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2165 return $vhighlights($row)
2167 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2168 return $fhighlights($row)
2170 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2171 return $rhighlights($row)
2173 return 0
2176 proc bolden {row font} {
2177 global canv linehtag selectedline boldrows
2179 lappend boldrows $row
2180 $canv itemconf $linehtag($row) -font $font
2181 if {[info exists selectedline] && $row == $selectedline} {
2182 $canv delete secsel
2183 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2184 -outline {{}} -tags secsel \
2185 -fill [$canv cget -selectbackground]]
2186 $canv lower $t
2190 proc bolden_name {row font} {
2191 global canv2 linentag selectedline boldnamerows
2193 lappend boldnamerows $row
2194 $canv2 itemconf $linentag($row) -font $font
2195 if {[info exists selectedline] && $row == $selectedline} {
2196 $canv2 delete secsel
2197 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2198 -outline {{}} -tags secsel \
2199 -fill [$canv2 cget -selectbackground]]
2200 $canv2 lower $t
2204 proc unbolden {} {
2205 global boldrows
2207 set stillbold {}
2208 foreach row $boldrows {
2209 if {![ishighlighted $row]} {
2210 bolden $row mainfont
2211 } else {
2212 lappend stillbold $row
2215 set boldrows $stillbold
2218 proc addvhighlight {n} {
2219 global hlview curview viewdata vhl_done vhighlights commitidx
2221 if {[info exists hlview]} {
2222 delvhighlight
2224 set hlview $n
2225 if {$n != $curview && ![info exists viewdata($n)]} {
2226 set viewdata($n) [list getcommits {{}} 0 0 0]
2227 set vparentlist($n) {}
2228 set vdisporder($n) {}
2229 set vcmitlisted($n) {}
2230 start_rev_list $n
2232 set vhl_done $commitidx($hlview)
2233 if {$vhl_done > 0} {
2234 drawvisible
2238 proc delvhighlight {} {
2239 global hlview vhighlights
2241 if {![info exists hlview]} return
2242 unset hlview
2243 catch {unset vhighlights}
2244 unbolden
2247 proc vhighlightmore {} {
2248 global hlview vhl_done commitidx vhighlights
2249 global displayorder vdisporder curview
2251 set max $commitidx($hlview)
2252 if {$hlview == $curview} {
2253 set disp $displayorder
2254 } else {
2255 set disp $vdisporder($hlview)
2257 set vr [visiblerows]
2258 set r0 [lindex $vr 0]
2259 set r1 [lindex $vr 1]
2260 for {set i $vhl_done} {$i < $max} {incr i} {
2261 set id [lindex $disp $i]
2262 if {[info exists commitrow($curview,$id)]} {
2263 set row $commitrow($curview,$id)
2264 if {$r0 <= $row && $row <= $r1} {
2265 if {![highlighted $row]} {
2266 bolden $row mainfontbold
2268 set vhighlights($row) 1
2272 set vhl_done $max
2275 proc askvhighlight {row id} {
2276 global hlview vhighlights commitrow iddrawn
2278 if {[info exists commitrow($hlview,$id)]} {
2279 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2280 bolden $row mainfontbold
2282 set vhighlights($row) 1
2283 } else {
2284 set vhighlights($row) 0
2288 proc hfiles_change {} {
2289 global highlight_files filehighlight fhighlights fh_serial
2290 global highlight_paths gdttype
2292 if {[info exists filehighlight]} {
2293 # delete previous highlights
2294 catch {close $filehighlight}
2295 unset filehighlight
2296 catch {unset fhighlights}
2297 unbolden
2298 unhighlight_filelist
2300 set highlight_paths {}
2301 after cancel do_file_hl $fh_serial
2302 incr fh_serial
2303 if {$highlight_files ne {}} {
2304 after 300 do_file_hl $fh_serial
2308 proc gdttype_change {name ix op} {
2309 global gdttype highlight_files findstring findpattern
2311 stopfinding
2312 if {$findstring ne {}} {
2313 if {$gdttype eq [mc "containing:"]} {
2314 if {$highlight_files ne {}} {
2315 set highlight_files {}
2316 hfiles_change
2318 findcom_change
2319 } else {
2320 if {$findpattern ne {}} {
2321 set findpattern {}
2322 findcom_change
2324 set highlight_files $findstring
2325 hfiles_change
2327 drawvisible
2329 # enable/disable findtype/findloc menus too
2332 proc find_change {name ix op} {
2333 global gdttype findstring highlight_files
2335 stopfinding
2336 if {$gdttype eq [mc "containing:"]} {
2337 findcom_change
2338 } else {
2339 if {$highlight_files ne $findstring} {
2340 set highlight_files $findstring
2341 hfiles_change
2344 drawvisible
2347 proc findcom_change args {
2348 global nhighlights boldnamerows
2349 global findpattern findtype findstring gdttype
2351 stopfinding
2352 # delete previous highlights, if any
2353 foreach row $boldnamerows {
2354 bolden_name $row mainfont
2356 set boldnamerows {}
2357 catch {unset nhighlights}
2358 unbolden
2359 unmarkmatches
2360 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2361 set findpattern {}
2362 } elseif {$findtype eq [mc "Regexp"]} {
2363 set findpattern $findstring
2364 } else {
2365 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2366 $findstring]
2367 set findpattern "*$e*"
2371 proc makepatterns {l} {
2372 set ret {}
2373 foreach e $l {
2374 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2375 if {[string index $ee end] eq "/"} {
2376 lappend ret "$ee*"
2377 } else {
2378 lappend ret $ee
2379 lappend ret "$ee/*"
2382 return $ret
2385 proc do_file_hl {serial} {
2386 global highlight_files filehighlight highlight_paths gdttype fhl_list
2388 if {$gdttype eq [mc "touching paths:"]} {
2389 if {[catch {set paths [shellsplit $highlight_files]}]} return
2390 set highlight_paths [makepatterns $paths]
2391 highlight_filelist
2392 set gdtargs [concat -- $paths]
2393 } elseif {$gdttype eq [mc "adding/removing string:"]} {
2394 set gdtargs [list "-S$highlight_files"]
2395 } else {
2396 # must be "containing:", i.e. we're searching commit info
2397 return
2399 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2400 set filehighlight [open $cmd r+]
2401 fconfigure $filehighlight -blocking 0
2402 filerun $filehighlight readfhighlight
2403 set fhl_list {}
2404 drawvisible
2405 flushhighlights
2408 proc flushhighlights {} {
2409 global filehighlight fhl_list
2411 if {[info exists filehighlight]} {
2412 lappend fhl_list {}
2413 puts $filehighlight ""
2414 flush $filehighlight
2418 proc askfilehighlight {row id} {
2419 global filehighlight fhighlights fhl_list
2421 lappend fhl_list $id
2422 set fhighlights($row) -1
2423 puts $filehighlight $id
2426 proc readfhighlight {} {
2427 global filehighlight fhighlights commitrow curview iddrawn
2428 global fhl_list find_dirn
2430 if {![info exists filehighlight]} {
2431 return 0
2433 set nr 0
2434 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2435 set line [string trim $line]
2436 set i [lsearch -exact $fhl_list $line]
2437 if {$i < 0} continue
2438 for {set j 0} {$j < $i} {incr j} {
2439 set id [lindex $fhl_list $j]
2440 if {[info exists commitrow($curview,$id)]} {
2441 set fhighlights($commitrow($curview,$id)) 0
2444 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2445 if {$line eq {}} continue
2446 if {![info exists commitrow($curview,$line)]} continue
2447 set row $commitrow($curview,$line)
2448 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2449 bolden $row mainfontbold
2451 set fhighlights($row) 1
2453 if {[eof $filehighlight]} {
2454 # strange...
2455 puts "oops, git diff-tree died"
2456 catch {close $filehighlight}
2457 unset filehighlight
2458 return 0
2460 if {[info exists find_dirn]} {
2461 run findmore
2463 return 1
2466 proc doesmatch {f} {
2467 global findtype findpattern
2469 if {$findtype eq [mc "Regexp"]} {
2470 return [regexp $findpattern $f]
2471 } elseif {$findtype eq [mc "IgnCase"]} {
2472 return [string match -nocase $findpattern $f]
2473 } else {
2474 return [string match $findpattern $f]
2478 proc askfindhighlight {row id} {
2479 global nhighlights commitinfo iddrawn
2480 global findloc
2481 global markingmatches
2483 if {![info exists commitinfo($id)]} {
2484 getcommit $id
2486 set info $commitinfo($id)
2487 set isbold 0
2488 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2489 foreach f $info ty $fldtypes {
2490 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2491 [doesmatch $f]} {
2492 if {$ty eq [mc "Author"]} {
2493 set isbold 2
2494 break
2496 set isbold 1
2499 if {$isbold && [info exists iddrawn($id)]} {
2500 if {![ishighlighted $row]} {
2501 bolden $row mainfontbold
2502 if {$isbold > 1} {
2503 bolden_name $row mainfontbold
2506 if {$markingmatches} {
2507 markrowmatches $row $id
2510 set nhighlights($row) $isbold
2513 proc markrowmatches {row id} {
2514 global canv canv2 linehtag linentag commitinfo findloc
2516 set headline [lindex $commitinfo($id) 0]
2517 set author [lindex $commitinfo($id) 1]
2518 $canv delete match$row
2519 $canv2 delete match$row
2520 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2521 set m [findmatches $headline]
2522 if {$m ne {}} {
2523 markmatches $canv $row $headline $linehtag($row) $m \
2524 [$canv itemcget $linehtag($row) -font] $row
2527 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2528 set m [findmatches $author]
2529 if {$m ne {}} {
2530 markmatches $canv2 $row $author $linentag($row) $m \
2531 [$canv2 itemcget $linentag($row) -font] $row
2536 proc vrel_change {name ix op} {
2537 global highlight_related
2539 rhighlight_none
2540 if {$highlight_related ne [mc "None"]} {
2541 run drawvisible
2545 # prepare for testing whether commits are descendents or ancestors of a
2546 proc rhighlight_sel {a} {
2547 global descendent desc_todo ancestor anc_todo
2548 global highlight_related rhighlights
2550 catch {unset descendent}
2551 set desc_todo [list $a]
2552 catch {unset ancestor}
2553 set anc_todo [list $a]
2554 if {$highlight_related ne [mc "None"]} {
2555 rhighlight_none
2556 run drawvisible
2560 proc rhighlight_none {} {
2561 global rhighlights
2563 catch {unset rhighlights}
2564 unbolden
2567 proc is_descendent {a} {
2568 global curview children commitrow descendent desc_todo
2570 set v $curview
2571 set la $commitrow($v,$a)
2572 set todo $desc_todo
2573 set leftover {}
2574 set done 0
2575 for {set i 0} {$i < [llength $todo]} {incr i} {
2576 set do [lindex $todo $i]
2577 if {$commitrow($v,$do) < $la} {
2578 lappend leftover $do
2579 continue
2581 foreach nk $children($v,$do) {
2582 if {![info exists descendent($nk)]} {
2583 set descendent($nk) 1
2584 lappend todo $nk
2585 if {$nk eq $a} {
2586 set done 1
2590 if {$done} {
2591 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2592 return
2595 set descendent($a) 0
2596 set desc_todo $leftover
2599 proc is_ancestor {a} {
2600 global curview parentlist commitrow ancestor anc_todo
2602 set v $curview
2603 set la $commitrow($v,$a)
2604 set todo $anc_todo
2605 set leftover {}
2606 set done 0
2607 for {set i 0} {$i < [llength $todo]} {incr i} {
2608 set do [lindex $todo $i]
2609 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2610 lappend leftover $do
2611 continue
2613 foreach np [lindex $parentlist $commitrow($v,$do)] {
2614 if {![info exists ancestor($np)]} {
2615 set ancestor($np) 1
2616 lappend todo $np
2617 if {$np eq $a} {
2618 set done 1
2622 if {$done} {
2623 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2624 return
2627 set ancestor($a) 0
2628 set anc_todo $leftover
2631 proc askrelhighlight {row id} {
2632 global descendent highlight_related iddrawn rhighlights
2633 global selectedline ancestor
2635 if {![info exists selectedline]} return
2636 set isbold 0
2637 if {$highlight_related eq [mc "Descendant"] ||
2638 $highlight_related eq [mc "Not descendant"]} {
2639 if {![info exists descendent($id)]} {
2640 is_descendent $id
2642 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2643 set isbold 1
2645 } elseif {$highlight_related eq [mc "Ancestor"] ||
2646 $highlight_related eq [mc "Not ancestor"]} {
2647 if {![info exists ancestor($id)]} {
2648 is_ancestor $id
2650 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2651 set isbold 1
2654 if {[info exists iddrawn($id)]} {
2655 if {$isbold && ![ishighlighted $row]} {
2656 bolden $row mainfontbold
2659 set rhighlights($row) $isbold
2662 # Graph layout functions
2664 proc shortids {ids} {
2665 set res {}
2666 foreach id $ids {
2667 if {[llength $id] > 1} {
2668 lappend res [shortids $id]
2669 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2670 lappend res [string range $id 0 7]
2671 } else {
2672 lappend res $id
2675 return $res
2678 proc ntimes {n o} {
2679 set ret {}
2680 set o [list $o]
2681 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2682 if {($n & $mask) != 0} {
2683 set ret [concat $ret $o]
2685 set o [concat $o $o]
2687 return $ret
2690 # Work out where id should go in idlist so that order-token
2691 # values increase from left to right
2692 proc idcol {idlist id {i 0}} {
2693 global ordertok curview
2695 set t $ordertok($curview,$id)
2696 if {$i >= [llength $idlist] ||
2697 $t < $ordertok($curview,[lindex $idlist $i])} {
2698 if {$i > [llength $idlist]} {
2699 set i [llength $idlist]
2701 while {[incr i -1] >= 0 &&
2702 $t < $ordertok($curview,[lindex $idlist $i])} {}
2703 incr i
2704 } else {
2705 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2706 while {[incr i] < [llength $idlist] &&
2707 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2710 return $i
2713 proc initlayout {} {
2714 global rowidlist rowisopt rowfinal displayorder commitlisted
2715 global numcommits canvxmax canv
2716 global nextcolor
2717 global parentlist
2718 global colormap rowtextx
2719 global selectfirst
2721 set numcommits 0
2722 set displayorder {}
2723 set commitlisted {}
2724 set parentlist {}
2725 set nextcolor 0
2726 set rowidlist {}
2727 set rowisopt {}
2728 set rowfinal {}
2729 set canvxmax [$canv cget -width]
2730 catch {unset colormap}
2731 catch {unset rowtextx}
2732 set selectfirst 1
2735 proc setcanvscroll {} {
2736 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2738 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2739 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2740 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2741 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2744 proc visiblerows {} {
2745 global canv numcommits linespc
2747 set ymax [lindex [$canv cget -scrollregion] 3]
2748 if {$ymax eq {} || $ymax == 0} return
2749 set f [$canv yview]
2750 set y0 [expr {int([lindex $f 0] * $ymax)}]
2751 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2752 if {$r0 < 0} {
2753 set r0 0
2755 set y1 [expr {int([lindex $f 1] * $ymax)}]
2756 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2757 if {$r1 >= $numcommits} {
2758 set r1 [expr {$numcommits - 1}]
2760 return [list $r0 $r1]
2763 proc layoutmore {} {
2764 global commitidx viewcomplete numcommits
2765 global uparrowlen downarrowlen mingaplen curview
2767 set show $commitidx($curview)
2768 if {$show > $numcommits || $viewcomplete($curview)} {
2769 showstuff $show $viewcomplete($curview)
2773 proc showstuff {canshow last} {
2774 global numcommits commitrow pending_select selectedline curview
2775 global mainheadid displayorder selectfirst
2776 global lastscrollset commitinterest
2778 if {$numcommits == 0} {
2779 global phase
2780 set phase "incrdraw"
2781 allcanvs delete all
2783 set r0 $numcommits
2784 set prev $numcommits
2785 set numcommits $canshow
2786 set t [clock clicks -milliseconds]
2787 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2788 set lastscrollset $t
2789 setcanvscroll
2791 set rows [visiblerows]
2792 set r1 [lindex $rows 1]
2793 if {$r1 >= $canshow} {
2794 set r1 [expr {$canshow - 1}]
2796 if {$r0 <= $r1} {
2797 drawcommits $r0 $r1
2799 if {[info exists pending_select] &&
2800 [info exists commitrow($curview,$pending_select)] &&
2801 $commitrow($curview,$pending_select) < $numcommits} {
2802 selectline $commitrow($curview,$pending_select) 1
2804 if {$selectfirst} {
2805 if {[info exists selectedline] || [info exists pending_select]} {
2806 set selectfirst 0
2807 } else {
2808 set l [first_real_row]
2809 selectline $l 1
2810 set selectfirst 0
2815 proc doshowlocalchanges {} {
2816 global curview mainheadid phase commitrow
2818 if {[info exists commitrow($curview,$mainheadid)] &&
2819 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2820 dodiffindex
2821 } elseif {$phase ne {}} {
2822 lappend commitinterest($mainheadid) {}
2826 proc dohidelocalchanges {} {
2827 global localfrow localirow lserial
2829 if {$localfrow >= 0} {
2830 removerow $localfrow
2831 set localfrow -1
2832 if {$localirow > 0} {
2833 incr localirow -1
2836 if {$localirow >= 0} {
2837 removerow $localirow
2838 set localirow -1
2840 incr lserial
2843 # spawn off a process to do git diff-index --cached HEAD
2844 proc dodiffindex {} {
2845 global localirow localfrow lserial showlocalchanges
2847 if {!$showlocalchanges} return
2848 incr lserial
2849 set localfrow -1
2850 set localirow -1
2851 set fd [open "|git diff-index --cached HEAD" r]
2852 fconfigure $fd -blocking 0
2853 filerun $fd [list readdiffindex $fd $lserial]
2856 proc readdiffindex {fd serial} {
2857 global localirow commitrow mainheadid nullid2 curview
2858 global commitinfo commitdata lserial
2860 set isdiff 1
2861 if {[gets $fd line] < 0} {
2862 if {![eof $fd]} {
2863 return 1
2865 set isdiff 0
2867 # we only need to see one line and we don't really care what it says...
2868 close $fd
2870 # now see if there are any local changes not checked in to the index
2871 if {$serial == $lserial} {
2872 set fd [open "|git diff-files" r]
2873 fconfigure $fd -blocking 0
2874 filerun $fd [list readdifffiles $fd $serial]
2877 if {$isdiff && $serial == $lserial && $localirow == -1} {
2878 # add the line for the changes in the index to the graph
2879 set localirow $commitrow($curview,$mainheadid)
2880 set hl [mc "Local changes checked in to index but not committed"]
2881 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2882 set commitdata($nullid2) "\n $hl\n"
2883 insertrow $localirow $nullid2
2885 return 0
2888 proc readdifffiles {fd serial} {
2889 global localirow localfrow commitrow mainheadid nullid curview
2890 global commitinfo commitdata lserial
2892 set isdiff 1
2893 if {[gets $fd line] < 0} {
2894 if {![eof $fd]} {
2895 return 1
2897 set isdiff 0
2899 # we only need to see one line and we don't really care what it says...
2900 close $fd
2902 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2903 # add the line for the local diff to the graph
2904 if {$localirow >= 0} {
2905 set localfrow $localirow
2906 incr localirow
2907 } else {
2908 set localfrow $commitrow($curview,$mainheadid)
2910 set hl [mc "Local uncommitted changes, not checked in to index"]
2911 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2912 set commitdata($nullid) "\n $hl\n"
2913 insertrow $localfrow $nullid
2915 return 0
2918 proc nextuse {id row} {
2919 global commitrow curview children
2921 if {[info exists children($curview,$id)]} {
2922 foreach kid $children($curview,$id) {
2923 if {![info exists commitrow($curview,$kid)]} {
2924 return -1
2926 if {$commitrow($curview,$kid) > $row} {
2927 return $commitrow($curview,$kid)
2931 if {[info exists commitrow($curview,$id)]} {
2932 return $commitrow($curview,$id)
2934 return -1
2937 proc prevuse {id row} {
2938 global commitrow curview children
2940 set ret -1
2941 if {[info exists children($curview,$id)]} {
2942 foreach kid $children($curview,$id) {
2943 if {![info exists commitrow($curview,$kid)]} break
2944 if {$commitrow($curview,$kid) < $row} {
2945 set ret $commitrow($curview,$kid)
2949 return $ret
2952 proc make_idlist {row} {
2953 global displayorder parentlist uparrowlen downarrowlen mingaplen
2954 global commitidx curview ordertok children commitrow
2956 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2957 if {$r < 0} {
2958 set r 0
2960 set ra [expr {$row - $downarrowlen}]
2961 if {$ra < 0} {
2962 set ra 0
2964 set rb [expr {$row + $uparrowlen}]
2965 if {$rb > $commitidx($curview)} {
2966 set rb $commitidx($curview)
2968 set ids {}
2969 for {} {$r < $ra} {incr r} {
2970 set nextid [lindex $displayorder [expr {$r + 1}]]
2971 foreach p [lindex $parentlist $r] {
2972 if {$p eq $nextid} continue
2973 set rn [nextuse $p $r]
2974 if {$rn >= $row &&
2975 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2976 lappend ids [list $ordertok($curview,$p) $p]
2980 for {} {$r < $row} {incr r} {
2981 set nextid [lindex $displayorder [expr {$r + 1}]]
2982 foreach p [lindex $parentlist $r] {
2983 if {$p eq $nextid} continue
2984 set rn [nextuse $p $r]
2985 if {$rn < 0 || $rn >= $row} {
2986 lappend ids [list $ordertok($curview,$p) $p]
2990 set id [lindex $displayorder $row]
2991 lappend ids [list $ordertok($curview,$id) $id]
2992 while {$r < $rb} {
2993 foreach p [lindex $parentlist $r] {
2994 set firstkid [lindex $children($curview,$p) 0]
2995 if {$commitrow($curview,$firstkid) < $row} {
2996 lappend ids [list $ordertok($curview,$p) $p]
2999 incr r
3000 set id [lindex $displayorder $r]
3001 if {$id ne {}} {
3002 set firstkid [lindex $children($curview,$id) 0]
3003 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3004 lappend ids [list $ordertok($curview,$id) $id]
3008 set idlist {}
3009 foreach idx [lsort -unique $ids] {
3010 lappend idlist [lindex $idx 1]
3012 return $idlist
3015 proc rowsequal {a b} {
3016 while {[set i [lsearch -exact $a {}]] >= 0} {
3017 set a [lreplace $a $i $i]
3019 while {[set i [lsearch -exact $b {}]] >= 0} {
3020 set b [lreplace $b $i $i]
3022 return [expr {$a eq $b}]
3025 proc makeupline {id row rend col} {
3026 global rowidlist uparrowlen downarrowlen mingaplen
3028 for {set r $rend} {1} {set r $rstart} {
3029 set rstart [prevuse $id $r]
3030 if {$rstart < 0} return
3031 if {$rstart < $row} break
3033 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3034 set rstart [expr {$rend - $uparrowlen - 1}]
3036 for {set r $rstart} {[incr r] <= $row} {} {
3037 set idlist [lindex $rowidlist $r]
3038 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3039 set col [idcol $idlist $id $col]
3040 lset rowidlist $r [linsert $idlist $col $id]
3041 changedrow $r
3046 proc layoutrows {row endrow} {
3047 global rowidlist rowisopt rowfinal displayorder
3048 global uparrowlen downarrowlen maxwidth mingaplen
3049 global children parentlist
3050 global commitidx viewcomplete curview commitrow
3052 set idlist {}
3053 if {$row > 0} {
3054 set rm1 [expr {$row - 1}]
3055 foreach id [lindex $rowidlist $rm1] {
3056 if {$id ne {}} {
3057 lappend idlist $id
3060 set final [lindex $rowfinal $rm1]
3062 for {} {$row < $endrow} {incr row} {
3063 set rm1 [expr {$row - 1}]
3064 if {$rm1 < 0 || $idlist eq {}} {
3065 set idlist [make_idlist $row]
3066 set final 1
3067 } else {
3068 set id [lindex $displayorder $rm1]
3069 set col [lsearch -exact $idlist $id]
3070 set idlist [lreplace $idlist $col $col]
3071 foreach p [lindex $parentlist $rm1] {
3072 if {[lsearch -exact $idlist $p] < 0} {
3073 set col [idcol $idlist $p $col]
3074 set idlist [linsert $idlist $col $p]
3075 # if not the first child, we have to insert a line going up
3076 if {$id ne [lindex $children($curview,$p) 0]} {
3077 makeupline $p $rm1 $row $col
3081 set id [lindex $displayorder $row]
3082 if {$row > $downarrowlen} {
3083 set termrow [expr {$row - $downarrowlen - 1}]
3084 foreach p [lindex $parentlist $termrow] {
3085 set i [lsearch -exact $idlist $p]
3086 if {$i < 0} continue
3087 set nr [nextuse $p $termrow]
3088 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3089 set idlist [lreplace $idlist $i $i]
3093 set col [lsearch -exact $idlist $id]
3094 if {$col < 0} {
3095 set col [idcol $idlist $id]
3096 set idlist [linsert $idlist $col $id]
3097 if {$children($curview,$id) ne {}} {
3098 makeupline $id $rm1 $row $col
3101 set r [expr {$row + $uparrowlen - 1}]
3102 if {$r < $commitidx($curview)} {
3103 set x $col
3104 foreach p [lindex $parentlist $r] {
3105 if {[lsearch -exact $idlist $p] >= 0} continue
3106 set fk [lindex $children($curview,$p) 0]
3107 if {$commitrow($curview,$fk) < $row} {
3108 set x [idcol $idlist $p $x]
3109 set idlist [linsert $idlist $x $p]
3112 if {[incr r] < $commitidx($curview)} {
3113 set p [lindex $displayorder $r]
3114 if {[lsearch -exact $idlist $p] < 0} {
3115 set fk [lindex $children($curview,$p) 0]
3116 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3117 set x [idcol $idlist $p $x]
3118 set idlist [linsert $idlist $x $p]
3124 if {$final && !$viewcomplete($curview) &&
3125 $row + $uparrowlen + $mingaplen + $downarrowlen
3126 >= $commitidx($curview)} {
3127 set final 0
3129 set l [llength $rowidlist]
3130 if {$row == $l} {
3131 lappend rowidlist $idlist
3132 lappend rowisopt 0
3133 lappend rowfinal $final
3134 } elseif {$row < $l} {
3135 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3136 lset rowidlist $row $idlist
3137 changedrow $row
3139 lset rowfinal $row $final
3140 } else {
3141 set pad [ntimes [expr {$row - $l}] {}]
3142 set rowidlist [concat $rowidlist $pad]
3143 lappend rowidlist $idlist
3144 set rowfinal [concat $rowfinal $pad]
3145 lappend rowfinal $final
3146 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3149 return $row
3152 proc changedrow {row} {
3153 global displayorder iddrawn rowisopt need_redisplay
3155 set l [llength $rowisopt]
3156 if {$row < $l} {
3157 lset rowisopt $row 0
3158 if {$row + 1 < $l} {
3159 lset rowisopt [expr {$row + 1}] 0
3160 if {$row + 2 < $l} {
3161 lset rowisopt [expr {$row + 2}] 0
3165 set id [lindex $displayorder $row]
3166 if {[info exists iddrawn($id)]} {
3167 set need_redisplay 1
3171 proc insert_pad {row col npad} {
3172 global rowidlist
3174 set pad [ntimes $npad {}]
3175 set idlist [lindex $rowidlist $row]
3176 set bef [lrange $idlist 0 [expr {$col - 1}]]
3177 set aft [lrange $idlist $col end]
3178 set i [lsearch -exact $aft {}]
3179 if {$i > 0} {
3180 set aft [lreplace $aft $i $i]
3182 lset rowidlist $row [concat $bef $pad $aft]
3183 changedrow $row
3186 proc optimize_rows {row col endrow} {
3187 global rowidlist rowisopt displayorder curview children
3189 if {$row < 1} {
3190 set row 1
3192 for {} {$row < $endrow} {incr row; set col 0} {
3193 if {[lindex $rowisopt $row]} continue
3194 set haspad 0
3195 set y0 [expr {$row - 1}]
3196 set ym [expr {$row - 2}]
3197 set idlist [lindex $rowidlist $row]
3198 set previdlist [lindex $rowidlist $y0]
3199 if {$idlist eq {} || $previdlist eq {}} continue
3200 if {$ym >= 0} {
3201 set pprevidlist [lindex $rowidlist $ym]
3202 if {$pprevidlist eq {}} continue
3203 } else {
3204 set pprevidlist {}
3206 set x0 -1
3207 set xm -1
3208 for {} {$col < [llength $idlist]} {incr col} {
3209 set id [lindex $idlist $col]
3210 if {[lindex $previdlist $col] eq $id} continue
3211 if {$id eq {}} {
3212 set haspad 1
3213 continue
3215 set x0 [lsearch -exact $previdlist $id]
3216 if {$x0 < 0} continue
3217 set z [expr {$x0 - $col}]
3218 set isarrow 0
3219 set z0 {}
3220 if {$ym >= 0} {
3221 set xm [lsearch -exact $pprevidlist $id]
3222 if {$xm >= 0} {
3223 set z0 [expr {$xm - $x0}]
3226 if {$z0 eq {}} {
3227 # if row y0 is the first child of $id then it's not an arrow
3228 if {[lindex $children($curview,$id) 0] ne
3229 [lindex $displayorder $y0]} {
3230 set isarrow 1
3233 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3234 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3235 set isarrow 1
3237 # Looking at lines from this row to the previous row,
3238 # make them go straight up if they end in an arrow on
3239 # the previous row; otherwise make them go straight up
3240 # or at 45 degrees.
3241 if {$z < -1 || ($z < 0 && $isarrow)} {
3242 # Line currently goes left too much;
3243 # insert pads in the previous row, then optimize it
3244 set npad [expr {-1 - $z + $isarrow}]
3245 insert_pad $y0 $x0 $npad
3246 if {$y0 > 0} {
3247 optimize_rows $y0 $x0 $row
3249 set previdlist [lindex $rowidlist $y0]
3250 set x0 [lsearch -exact $previdlist $id]
3251 set z [expr {$x0 - $col}]
3252 if {$z0 ne {}} {
3253 set pprevidlist [lindex $rowidlist $ym]
3254 set xm [lsearch -exact $pprevidlist $id]
3255 set z0 [expr {$xm - $x0}]
3257 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3258 # Line currently goes right too much;
3259 # insert pads in this line
3260 set npad [expr {$z - 1 + $isarrow}]
3261 insert_pad $row $col $npad
3262 set idlist [lindex $rowidlist $row]
3263 incr col $npad
3264 set z [expr {$x0 - $col}]
3265 set haspad 1
3267 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3268 # this line links to its first child on row $row-2
3269 set id [lindex $displayorder $ym]
3270 set xc [lsearch -exact $pprevidlist $id]
3271 if {$xc >= 0} {
3272 set z0 [expr {$xc - $x0}]
3275 # avoid lines jigging left then immediately right
3276 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3277 insert_pad $y0 $x0 1
3278 incr x0
3279 optimize_rows $y0 $x0 $row
3280 set previdlist [lindex $rowidlist $y0]
3283 if {!$haspad} {
3284 # Find the first column that doesn't have a line going right
3285 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3286 set id [lindex $idlist $col]
3287 if {$id eq {}} break
3288 set x0 [lsearch -exact $previdlist $id]
3289 if {$x0 < 0} {
3290 # check if this is the link to the first child
3291 set kid [lindex $displayorder $y0]
3292 if {[lindex $children($curview,$id) 0] eq $kid} {
3293 # it is, work out offset to child
3294 set x0 [lsearch -exact $previdlist $kid]
3297 if {$x0 <= $col} break
3299 # Insert a pad at that column as long as it has a line and
3300 # isn't the last column
3301 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3302 set idlist [linsert $idlist $col {}]
3303 lset rowidlist $row $idlist
3304 changedrow $row
3310 proc xc {row col} {
3311 global canvx0 linespc
3312 return [expr {$canvx0 + $col * $linespc}]
3315 proc yc {row} {
3316 global canvy0 linespc
3317 return [expr {$canvy0 + $row * $linespc}]
3320 proc linewidth {id} {
3321 global thickerline lthickness
3323 set wid $lthickness
3324 if {[info exists thickerline] && $id eq $thickerline} {
3325 set wid [expr {2 * $lthickness}]
3327 return $wid
3330 proc rowranges {id} {
3331 global commitrow curview children uparrowlen downarrowlen
3332 global rowidlist
3334 set kids $children($curview,$id)
3335 if {$kids eq {}} {
3336 return {}
3338 set ret {}
3339 lappend kids $id
3340 foreach child $kids {
3341 if {![info exists commitrow($curview,$child)]} break
3342 set row $commitrow($curview,$child)
3343 if {![info exists prev]} {
3344 lappend ret [expr {$row + 1}]
3345 } else {
3346 if {$row <= $prevrow} {
3347 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3349 # see if the line extends the whole way from prevrow to row
3350 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3351 [lsearch -exact [lindex $rowidlist \
3352 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3353 # it doesn't, see where it ends
3354 set r [expr {$prevrow + $downarrowlen}]
3355 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3356 while {[incr r -1] > $prevrow &&
3357 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3358 } else {
3359 while {[incr r] <= $row &&
3360 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3361 incr r -1
3363 lappend ret $r
3364 # see where it starts up again
3365 set r [expr {$row - $uparrowlen}]
3366 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3367 while {[incr r] < $row &&
3368 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3369 } else {
3370 while {[incr r -1] >= $prevrow &&
3371 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3372 incr r
3374 lappend ret $r
3377 if {$child eq $id} {
3378 lappend ret $row
3380 set prev $id
3381 set prevrow $row
3383 return $ret
3386 proc drawlineseg {id row endrow arrowlow} {
3387 global rowidlist displayorder iddrawn linesegs
3388 global canv colormap linespc curview maxlinelen parentlist
3390 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3391 set le [expr {$row + 1}]
3392 set arrowhigh 1
3393 while {1} {
3394 set c [lsearch -exact [lindex $rowidlist $le] $id]
3395 if {$c < 0} {
3396 incr le -1
3397 break
3399 lappend cols $c
3400 set x [lindex $displayorder $le]
3401 if {$x eq $id} {
3402 set arrowhigh 0
3403 break
3405 if {[info exists iddrawn($x)] || $le == $endrow} {
3406 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3407 if {$c >= 0} {
3408 lappend cols $c
3409 set arrowhigh 0
3411 break
3413 incr le
3415 if {$le <= $row} {
3416 return $row
3419 set lines {}
3420 set i 0
3421 set joinhigh 0
3422 if {[info exists linesegs($id)]} {
3423 set lines $linesegs($id)
3424 foreach li $lines {
3425 set r0 [lindex $li 0]
3426 if {$r0 > $row} {
3427 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3428 set joinhigh 1
3430 break
3432 incr i
3435 set joinlow 0
3436 if {$i > 0} {
3437 set li [lindex $lines [expr {$i-1}]]
3438 set r1 [lindex $li 1]
3439 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3440 set joinlow 1
3444 set x [lindex $cols [expr {$le - $row}]]
3445 set xp [lindex $cols [expr {$le - 1 - $row}]]
3446 set dir [expr {$xp - $x}]
3447 if {$joinhigh} {
3448 set ith [lindex $lines $i 2]
3449 set coords [$canv coords $ith]
3450 set ah [$canv itemcget $ith -arrow]
3451 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3452 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3453 if {$x2 ne {} && $x - $x2 == $dir} {
3454 set coords [lrange $coords 0 end-2]
3456 } else {
3457 set coords [list [xc $le $x] [yc $le]]
3459 if {$joinlow} {
3460 set itl [lindex $lines [expr {$i-1}] 2]
3461 set al [$canv itemcget $itl -arrow]
3462 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3463 } elseif {$arrowlow} {
3464 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3465 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3466 set arrowlow 0
3469 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3470 for {set y $le} {[incr y -1] > $row} {} {
3471 set x $xp
3472 set xp [lindex $cols [expr {$y - 1 - $row}]]
3473 set ndir [expr {$xp - $x}]
3474 if {$dir != $ndir || $xp < 0} {
3475 lappend coords [xc $y $x] [yc $y]
3477 set dir $ndir
3479 if {!$joinlow} {
3480 if {$xp < 0} {
3481 # join parent line to first child
3482 set ch [lindex $displayorder $row]
3483 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3484 if {$xc < 0} {
3485 puts "oops: drawlineseg: child $ch not on row $row"
3486 } elseif {$xc != $x} {
3487 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3488 set d [expr {int(0.5 * $linespc)}]
3489 set x1 [xc $row $x]
3490 if {$xc < $x} {
3491 set x2 [expr {$x1 - $d}]
3492 } else {
3493 set x2 [expr {$x1 + $d}]
3495 set y2 [yc $row]
3496 set y1 [expr {$y2 + $d}]
3497 lappend coords $x1 $y1 $x2 $y2
3498 } elseif {$xc < $x - 1} {
3499 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3500 } elseif {$xc > $x + 1} {
3501 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3503 set x $xc
3505 lappend coords [xc $row $x] [yc $row]
3506 } else {
3507 set xn [xc $row $xp]
3508 set yn [yc $row]
3509 lappend coords $xn $yn
3511 if {!$joinhigh} {
3512 assigncolor $id
3513 set t [$canv create line $coords -width [linewidth $id] \
3514 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3515 $canv lower $t
3516 bindline $t $id
3517 set lines [linsert $lines $i [list $row $le $t]]
3518 } else {
3519 $canv coords $ith $coords
3520 if {$arrow ne $ah} {
3521 $canv itemconf $ith -arrow $arrow
3523 lset lines $i 0 $row
3525 } else {
3526 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3527 set ndir [expr {$xo - $xp}]
3528 set clow [$canv coords $itl]
3529 if {$dir == $ndir} {
3530 set clow [lrange $clow 2 end]
3532 set coords [concat $coords $clow]
3533 if {!$joinhigh} {
3534 lset lines [expr {$i-1}] 1 $le
3535 } else {
3536 # coalesce two pieces
3537 $canv delete $ith
3538 set b [lindex $lines [expr {$i-1}] 0]
3539 set e [lindex $lines $i 1]
3540 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3542 $canv coords $itl $coords
3543 if {$arrow ne $al} {
3544 $canv itemconf $itl -arrow $arrow
3548 set linesegs($id) $lines
3549 return $le
3552 proc drawparentlinks {id row} {
3553 global rowidlist canv colormap curview parentlist
3554 global idpos linespc
3556 set rowids [lindex $rowidlist $row]
3557 set col [lsearch -exact $rowids $id]
3558 if {$col < 0} return
3559 set olds [lindex $parentlist $row]
3560 set row2 [expr {$row + 1}]
3561 set x [xc $row $col]
3562 set y [yc $row]
3563 set y2 [yc $row2]
3564 set d [expr {int(0.5 * $linespc)}]
3565 set ymid [expr {$y + $d}]
3566 set ids [lindex $rowidlist $row2]
3567 # rmx = right-most X coord used
3568 set rmx 0
3569 foreach p $olds {
3570 set i [lsearch -exact $ids $p]
3571 if {$i < 0} {
3572 puts "oops, parent $p of $id not in list"
3573 continue
3575 set x2 [xc $row2 $i]
3576 if {$x2 > $rmx} {
3577 set rmx $x2
3579 set j [lsearch -exact $rowids $p]
3580 if {$j < 0} {
3581 # drawlineseg will do this one for us
3582 continue
3584 assigncolor $p
3585 # should handle duplicated parents here...
3586 set coords [list $x $y]
3587 if {$i != $col} {
3588 # if attaching to a vertical segment, draw a smaller
3589 # slant for visual distinctness
3590 if {$i == $j} {
3591 if {$i < $col} {
3592 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3593 } else {
3594 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3596 } elseif {$i < $col && $i < $j} {
3597 # segment slants towards us already
3598 lappend coords [xc $row $j] $y
3599 } else {
3600 if {$i < $col - 1} {
3601 lappend coords [expr {$x2 + $linespc}] $y
3602 } elseif {$i > $col + 1} {
3603 lappend coords [expr {$x2 - $linespc}] $y
3605 lappend coords $x2 $y2
3607 } else {
3608 lappend coords $x2 $y2
3610 set t [$canv create line $coords -width [linewidth $p] \
3611 -fill $colormap($p) -tags lines.$p]
3612 $canv lower $t
3613 bindline $t $p
3615 if {$rmx > [lindex $idpos($id) 1]} {
3616 lset idpos($id) 1 $rmx
3617 redrawtags $id
3621 proc drawlines {id} {
3622 global canv
3624 $canv itemconf lines.$id -width [linewidth $id]
3627 proc drawcmittext {id row col} {
3628 global linespc canv canv2 canv3 canvy0 fgcolor curview
3629 global commitlisted commitinfo rowidlist parentlist
3630 global rowtextx idpos idtags idheads idotherrefs
3631 global linehtag linentag linedtag selectedline
3632 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3634 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3635 set listed [lindex $commitlisted $row]
3636 if {$id eq $nullid} {
3637 set ofill red
3638 } elseif {$id eq $nullid2} {
3639 set ofill green
3640 } else {
3641 set ofill [expr {$listed != 0? "blue": "white"}]
3643 set x [xc $row $col]
3644 set y [yc $row]
3645 set orad [expr {$linespc / 3}]
3646 if {$listed <= 1} {
3647 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3648 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3649 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3650 } elseif {$listed == 2} {
3651 # triangle pointing left for left-side commits
3652 set t [$canv create polygon \
3653 [expr {$x - $orad}] $y \
3654 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3655 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3656 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3657 } else {
3658 # triangle pointing right for right-side commits
3659 set t [$canv create polygon \
3660 [expr {$x + $orad - 1}] $y \
3661 [expr {$x - $orad}] [expr {$y - $orad}] \
3662 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3663 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3665 $canv raise $t
3666 $canv bind $t <1> {selcanvline {} %x %y}
3667 set rmx [llength [lindex $rowidlist $row]]
3668 set olds [lindex $parentlist $row]
3669 if {$olds ne {}} {
3670 set nextids [lindex $rowidlist [expr {$row + 1}]]
3671 foreach p $olds {
3672 set i [lsearch -exact $nextids $p]
3673 if {$i > $rmx} {
3674 set rmx $i
3678 set xt [xc $row $rmx]
3679 set rowtextx($row) $xt
3680 set idpos($id) [list $x $xt $y]
3681 if {[info exists idtags($id)] || [info exists idheads($id)]
3682 || [info exists idotherrefs($id)]} {
3683 set xt [drawtags $id $x $xt $y]
3685 set headline [lindex $commitinfo($id) 0]
3686 set name [lindex $commitinfo($id) 1]
3687 set date [lindex $commitinfo($id) 2]
3688 set date [formatdate $date]
3689 set font mainfont
3690 set nfont mainfont
3691 set isbold [ishighlighted $row]
3692 if {$isbold > 0} {
3693 lappend boldrows $row
3694 set font mainfontbold
3695 if {$isbold > 1} {
3696 lappend boldnamerows $row
3697 set nfont mainfontbold
3700 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3701 -text $headline -font $font -tags text]
3702 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3703 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3704 -text $name -font $nfont -tags text]
3705 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3706 -text $date -font mainfont -tags text]
3707 if {[info exists selectedline] && $selectedline == $row} {
3708 make_secsel $row
3710 set xr [expr {$xt + [font measure $font $headline]}]
3711 if {$xr > $canvxmax} {
3712 set canvxmax $xr
3713 setcanvscroll
3717 proc drawcmitrow {row} {
3718 global displayorder rowidlist nrows_drawn
3719 global iddrawn markingmatches
3720 global commitinfo parentlist numcommits
3721 global filehighlight fhighlights findpattern nhighlights
3722 global hlview vhighlights
3723 global highlight_related rhighlights
3725 if {$row >= $numcommits} return
3727 set id [lindex $displayorder $row]
3728 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3729 askvhighlight $row $id
3731 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3732 askfilehighlight $row $id
3734 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3735 askfindhighlight $row $id
3737 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3738 askrelhighlight $row $id
3740 if {![info exists iddrawn($id)]} {
3741 set col [lsearch -exact [lindex $rowidlist $row] $id]
3742 if {$col < 0} {
3743 puts "oops, row $row id $id not in list"
3744 return
3746 if {![info exists commitinfo($id)]} {
3747 getcommit $id
3749 assigncolor $id
3750 drawcmittext $id $row $col
3751 set iddrawn($id) 1
3752 incr nrows_drawn
3754 if {$markingmatches} {
3755 markrowmatches $row $id
3759 proc drawcommits {row {endrow {}}} {
3760 global numcommits iddrawn displayorder curview need_redisplay
3761 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3763 if {$row < 0} {
3764 set row 0
3766 if {$endrow eq {}} {
3767 set endrow $row
3769 if {$endrow >= $numcommits} {
3770 set endrow [expr {$numcommits - 1}]
3773 set rl1 [expr {$row - $downarrowlen - 3}]
3774 if {$rl1 < 0} {
3775 set rl1 0
3777 set ro1 [expr {$row - 3}]
3778 if {$ro1 < 0} {
3779 set ro1 0
3781 set r2 [expr {$endrow + $uparrowlen + 3}]
3782 if {$r2 > $numcommits} {
3783 set r2 $numcommits
3785 for {set r $rl1} {$r < $r2} {incr r} {
3786 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3787 if {$rl1 < $r} {
3788 layoutrows $rl1 $r
3790 set rl1 [expr {$r + 1}]
3793 if {$rl1 < $r} {
3794 layoutrows $rl1 $r
3796 optimize_rows $ro1 0 $r2
3797 if {$need_redisplay || $nrows_drawn > 2000} {
3798 clear_display
3799 drawvisible
3802 # make the lines join to already-drawn rows either side
3803 set r [expr {$row - 1}]
3804 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3805 set r $row
3807 set er [expr {$endrow + 1}]
3808 if {$er >= $numcommits ||
3809 ![info exists iddrawn([lindex $displayorder $er])]} {
3810 set er $endrow
3812 for {} {$r <= $er} {incr r} {
3813 set id [lindex $displayorder $r]
3814 set wasdrawn [info exists iddrawn($id)]
3815 drawcmitrow $r
3816 if {$r == $er} break
3817 set nextid [lindex $displayorder [expr {$r + 1}]]
3818 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3819 drawparentlinks $id $r
3821 set rowids [lindex $rowidlist $r]
3822 foreach lid $rowids {
3823 if {$lid eq {}} continue
3824 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3825 if {$lid eq $id} {
3826 # see if this is the first child of any of its parents
3827 foreach p [lindex $parentlist $r] {
3828 if {[lsearch -exact $rowids $p] < 0} {
3829 # make this line extend up to the child
3830 set lineend($p) [drawlineseg $p $r $er 0]
3833 } else {
3834 set lineend($lid) [drawlineseg $lid $r $er 1]
3840 proc drawfrac {f0 f1} {
3841 global canv linespc
3843 set ymax [lindex [$canv cget -scrollregion] 3]
3844 if {$ymax eq {} || $ymax == 0} return
3845 set y0 [expr {int($f0 * $ymax)}]
3846 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3847 set y1 [expr {int($f1 * $ymax)}]
3848 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3849 drawcommits $row $endrow
3852 proc drawvisible {} {
3853 global canv
3854 eval drawfrac [$canv yview]
3857 proc clear_display {} {
3858 global iddrawn linesegs need_redisplay nrows_drawn
3859 global vhighlights fhighlights nhighlights rhighlights
3861 allcanvs delete all
3862 catch {unset iddrawn}
3863 catch {unset linesegs}
3864 catch {unset vhighlights}
3865 catch {unset fhighlights}
3866 catch {unset nhighlights}
3867 catch {unset rhighlights}
3868 set need_redisplay 0
3869 set nrows_drawn 0
3872 proc findcrossings {id} {
3873 global rowidlist parentlist numcommits displayorder
3875 set cross {}
3876 set ccross {}
3877 foreach {s e} [rowranges $id] {
3878 if {$e >= $numcommits} {
3879 set e [expr {$numcommits - 1}]
3881 if {$e <= $s} continue
3882 for {set row $e} {[incr row -1] >= $s} {} {
3883 set x [lsearch -exact [lindex $rowidlist $row] $id]
3884 if {$x < 0} break
3885 set olds [lindex $parentlist $row]
3886 set kid [lindex $displayorder $row]
3887 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3888 if {$kidx < 0} continue
3889 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3890 foreach p $olds {
3891 set px [lsearch -exact $nextrow $p]
3892 if {$px < 0} continue
3893 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3894 if {[lsearch -exact $ccross $p] >= 0} continue
3895 if {$x == $px + ($kidx < $px? -1: 1)} {
3896 lappend ccross $p
3897 } elseif {[lsearch -exact $cross $p] < 0} {
3898 lappend cross $p
3904 return [concat $ccross {{}} $cross]
3907 proc assigncolor {id} {
3908 global colormap colors nextcolor
3909 global commitrow parentlist children children curview
3911 if {[info exists colormap($id)]} return
3912 set ncolors [llength $colors]
3913 if {[info exists children($curview,$id)]} {
3914 set kids $children($curview,$id)
3915 } else {
3916 set kids {}
3918 if {[llength $kids] == 1} {
3919 set child [lindex $kids 0]
3920 if {[info exists colormap($child)]
3921 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3922 set colormap($id) $colormap($child)
3923 return
3926 set badcolors {}
3927 set origbad {}
3928 foreach x [findcrossings $id] {
3929 if {$x eq {}} {
3930 # delimiter between corner crossings and other crossings
3931 if {[llength $badcolors] >= $ncolors - 1} break
3932 set origbad $badcolors
3934 if {[info exists colormap($x)]
3935 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3936 lappend badcolors $colormap($x)
3939 if {[llength $badcolors] >= $ncolors} {
3940 set badcolors $origbad
3942 set origbad $badcolors
3943 if {[llength $badcolors] < $ncolors - 1} {
3944 foreach child $kids {
3945 if {[info exists colormap($child)]
3946 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3947 lappend badcolors $colormap($child)
3949 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3950 if {[info exists colormap($p)]
3951 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3952 lappend badcolors $colormap($p)
3956 if {[llength $badcolors] >= $ncolors} {
3957 set badcolors $origbad
3960 for {set i 0} {$i <= $ncolors} {incr i} {
3961 set c [lindex $colors $nextcolor]
3962 if {[incr nextcolor] >= $ncolors} {
3963 set nextcolor 0
3965 if {[lsearch -exact $badcolors $c]} break
3967 set colormap($id) $c
3970 proc bindline {t id} {
3971 global canv
3973 $canv bind $t <Enter> "lineenter %x %y $id"
3974 $canv bind $t <Motion> "linemotion %x %y $id"
3975 $canv bind $t <Leave> "lineleave $id"
3976 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3979 proc drawtags {id x xt y1} {
3980 global idtags idheads idotherrefs mainhead
3981 global linespc lthickness
3982 global canv commitrow rowtextx curview fgcolor bgcolor
3984 set marks {}
3985 set ntags 0
3986 set nheads 0
3987 if {[info exists idtags($id)]} {
3988 set marks $idtags($id)
3989 set ntags [llength $marks]
3991 if {[info exists idheads($id)]} {
3992 set marks [concat $marks $idheads($id)]
3993 set nheads [llength $idheads($id)]
3995 if {[info exists idotherrefs($id)]} {
3996 set marks [concat $marks $idotherrefs($id)]
3998 if {$marks eq {}} {
3999 return $xt
4002 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4003 set yt [expr {$y1 - 0.5 * $linespc}]
4004 set yb [expr {$yt + $linespc - 1}]
4005 set xvals {}
4006 set wvals {}
4007 set i -1
4008 foreach tag $marks {
4009 incr i
4010 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4011 set wid [font measure mainfontbold $tag]
4012 } else {
4013 set wid [font measure mainfont $tag]
4015 lappend xvals $xt
4016 lappend wvals $wid
4017 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4019 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4020 -width $lthickness -fill black -tags tag.$id]
4021 $canv lower $t
4022 foreach tag $marks x $xvals wid $wvals {
4023 set xl [expr {$x + $delta}]
4024 set xr [expr {$x + $delta + $wid + $lthickness}]
4025 set font mainfont
4026 if {[incr ntags -1] >= 0} {
4027 # draw a tag
4028 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4029 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4030 -width 1 -outline black -fill yellow -tags tag.$id]
4031 $canv bind $t <1> [list showtag $tag 1]
4032 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4033 } else {
4034 # draw a head or other ref
4035 if {[incr nheads -1] >= 0} {
4036 set col green
4037 if {$tag eq $mainhead} {
4038 set font mainfontbold
4040 } else {
4041 set col "#ddddff"
4043 set xl [expr {$xl - $delta/2}]
4044 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4045 -width 1 -outline black -fill $col -tags tag.$id
4046 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4047 set rwid [font measure mainfont $remoteprefix]
4048 set xi [expr {$x + 1}]
4049 set yti [expr {$yt + 1}]
4050 set xri [expr {$x + $rwid}]
4051 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4052 -width 0 -fill "#ffddaa" -tags tag.$id
4055 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4056 -font $font -tags [list tag.$id text]]
4057 if {$ntags >= 0} {
4058 $canv bind $t <1> [list showtag $tag 1]
4059 } elseif {$nheads >= 0} {
4060 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4063 return $xt
4066 proc xcoord {i level ln} {
4067 global canvx0 xspc1 xspc2
4069 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4070 if {$i > 0 && $i == $level} {
4071 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4072 } elseif {$i > $level} {
4073 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4075 return $x
4078 proc show_status {msg} {
4079 global canv fgcolor
4081 clear_display
4082 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4083 -tags text -fill $fgcolor
4086 # Insert a new commit as the child of the commit on row $row.
4087 # The new commit will be displayed on row $row and the commits
4088 # on that row and below will move down one row.
4089 proc insertrow {row newcmit} {
4090 global displayorder parentlist commitlisted children
4091 global commitrow curview rowidlist rowisopt rowfinal numcommits
4092 global numcommits
4093 global selectedline commitidx ordertok
4095 if {$row >= $numcommits} {
4096 puts "oops, inserting new row $row but only have $numcommits rows"
4097 return
4099 set p [lindex $displayorder $row]
4100 set displayorder [linsert $displayorder $row $newcmit]
4101 set parentlist [linsert $parentlist $row $p]
4102 set kids $children($curview,$p)
4103 lappend kids $newcmit
4104 set children($curview,$p) $kids
4105 set children($curview,$newcmit) {}
4106 set commitlisted [linsert $commitlisted $row 1]
4107 set l [llength $displayorder]
4108 for {set r $row} {$r < $l} {incr r} {
4109 set id [lindex $displayorder $r]
4110 set commitrow($curview,$id) $r
4112 incr commitidx($curview)
4113 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4115 if {$row < [llength $rowidlist]} {
4116 set idlist [lindex $rowidlist $row]
4117 if {$idlist ne {}} {
4118 if {[llength $kids] == 1} {
4119 set col [lsearch -exact $idlist $p]
4120 lset idlist $col $newcmit
4121 } else {
4122 set col [llength $idlist]
4123 lappend idlist $newcmit
4126 set rowidlist [linsert $rowidlist $row $idlist]
4127 set rowisopt [linsert $rowisopt $row 0]
4128 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4131 incr numcommits
4133 if {[info exists selectedline] && $selectedline >= $row} {
4134 incr selectedline
4136 redisplay
4139 # Remove a commit that was inserted with insertrow on row $row.
4140 proc removerow {row} {
4141 global displayorder parentlist commitlisted children
4142 global commitrow curview rowidlist rowisopt rowfinal numcommits
4143 global numcommits
4144 global linesegends selectedline commitidx
4146 if {$row >= $numcommits} {
4147 puts "oops, removing row $row but only have $numcommits rows"
4148 return
4150 set rp1 [expr {$row + 1}]
4151 set id [lindex $displayorder $row]
4152 set p [lindex $parentlist $row]
4153 set displayorder [lreplace $displayorder $row $row]
4154 set parentlist [lreplace $parentlist $row $row]
4155 set commitlisted [lreplace $commitlisted $row $row]
4156 set kids $children($curview,$p)
4157 set i [lsearch -exact $kids $id]
4158 if {$i >= 0} {
4159 set kids [lreplace $kids $i $i]
4160 set children($curview,$p) $kids
4162 set l [llength $displayorder]
4163 for {set r $row} {$r < $l} {incr r} {
4164 set id [lindex $displayorder $r]
4165 set commitrow($curview,$id) $r
4167 incr commitidx($curview) -1
4169 if {$row < [llength $rowidlist]} {
4170 set rowidlist [lreplace $rowidlist $row $row]
4171 set rowisopt [lreplace $rowisopt $row $row]
4172 set rowfinal [lreplace $rowfinal $row $row]
4175 incr numcommits -1
4177 if {[info exists selectedline] && $selectedline > $row} {
4178 incr selectedline -1
4180 redisplay
4183 # Don't change the text pane cursor if it is currently the hand cursor,
4184 # showing that we are over a sha1 ID link.
4185 proc settextcursor {c} {
4186 global ctext curtextcursor
4188 if {[$ctext cget -cursor] == $curtextcursor} {
4189 $ctext config -cursor $c
4191 set curtextcursor $c
4194 proc nowbusy {what {name {}}} {
4195 global isbusy busyname statusw
4197 if {[array names isbusy] eq {}} {
4198 . config -cursor watch
4199 settextcursor watch
4201 set isbusy($what) 1
4202 set busyname($what) $name
4203 if {$name ne {}} {
4204 $statusw conf -text $name
4208 proc notbusy {what} {
4209 global isbusy maincursor textcursor busyname statusw
4211 catch {
4212 unset isbusy($what)
4213 if {$busyname($what) ne {} &&
4214 [$statusw cget -text] eq $busyname($what)} {
4215 $statusw conf -text {}
4218 if {[array names isbusy] eq {}} {
4219 . config -cursor $maincursor
4220 settextcursor $textcursor
4224 proc findmatches {f} {
4225 global findtype findstring
4226 if {$findtype == [mc "Regexp"]} {
4227 set matches [regexp -indices -all -inline $findstring $f]
4228 } else {
4229 set fs $findstring
4230 if {$findtype == [mc "IgnCase"]} {
4231 set f [string tolower $f]
4232 set fs [string tolower $fs]
4234 set matches {}
4235 set i 0
4236 set l [string length $fs]
4237 while {[set j [string first $fs $f $i]] >= 0} {
4238 lappend matches [list $j [expr {$j+$l-1}]]
4239 set i [expr {$j + $l}]
4242 return $matches
4245 proc dofind {{dirn 1} {wrap 1}} {
4246 global findstring findstartline findcurline selectedline numcommits
4247 global gdttype filehighlight fh_serial find_dirn findallowwrap
4249 if {[info exists find_dirn]} {
4250 if {$find_dirn == $dirn} return
4251 stopfinding
4253 focus .
4254 if {$findstring eq {} || $numcommits == 0} return
4255 if {![info exists selectedline]} {
4256 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4257 } else {
4258 set findstartline $selectedline
4260 set findcurline $findstartline
4261 nowbusy finding [mc "Searching"]
4262 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4263 after cancel do_file_hl $fh_serial
4264 do_file_hl $fh_serial
4266 set find_dirn $dirn
4267 set findallowwrap $wrap
4268 run findmore
4271 proc stopfinding {} {
4272 global find_dirn findcurline fprogcoord
4274 if {[info exists find_dirn]} {
4275 unset find_dirn
4276 unset findcurline
4277 notbusy finding
4278 set fprogcoord 0
4279 adjustprogress
4283 proc findmore {} {
4284 global commitdata commitinfo numcommits findpattern findloc
4285 global findstartline findcurline displayorder
4286 global find_dirn gdttype fhighlights fprogcoord
4287 global findallowwrap
4289 if {![info exists find_dirn]} {
4290 return 0
4292 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4293 set l $findcurline
4294 set moretodo 0
4295 if {$find_dirn > 0} {
4296 incr l
4297 if {$l >= $numcommits} {
4298 set l 0
4300 if {$l <= $findstartline} {
4301 set lim [expr {$findstartline + 1}]
4302 } else {
4303 set lim $numcommits
4304 set moretodo $findallowwrap
4306 } else {
4307 if {$l == 0} {
4308 set l $numcommits
4310 incr l -1
4311 if {$l >= $findstartline} {
4312 set lim [expr {$findstartline - 1}]
4313 } else {
4314 set lim -1
4315 set moretodo $findallowwrap
4318 set n [expr {($lim - $l) * $find_dirn}]
4319 if {$n > 500} {
4320 set n 500
4321 set moretodo 1
4323 set found 0
4324 set domore 1
4325 if {$gdttype eq [mc "containing:"]} {
4326 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4327 set id [lindex $displayorder $l]
4328 # shouldn't happen unless git log doesn't give all the commits...
4329 if {![info exists commitdata($id)]} continue
4330 if {![doesmatch $commitdata($id)]} continue
4331 if {![info exists commitinfo($id)]} {
4332 getcommit $id
4334 set info $commitinfo($id)
4335 foreach f $info ty $fldtypes {
4336 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4337 [doesmatch $f]} {
4338 set found 1
4339 break
4342 if {$found} break
4344 } else {
4345 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4346 set id [lindex $displayorder $l]
4347 if {![info exists fhighlights($l)]} {
4348 askfilehighlight $l $id
4349 if {$domore} {
4350 set domore 0
4351 set findcurline [expr {$l - $find_dirn}]
4353 } elseif {$fhighlights($l)} {
4354 set found $domore
4355 break
4359 if {$found || ($domore && !$moretodo)} {
4360 unset findcurline
4361 unset find_dirn
4362 notbusy finding
4363 set fprogcoord 0
4364 adjustprogress
4365 if {$found} {
4366 findselectline $l
4367 } else {
4368 bell
4370 return 0
4372 if {!$domore} {
4373 flushhighlights
4374 } else {
4375 set findcurline [expr {$l - $find_dirn}]
4377 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4378 if {$n < 0} {
4379 incr n $numcommits
4381 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4382 adjustprogress
4383 return $domore
4386 proc findselectline {l} {
4387 global findloc commentend ctext findcurline markingmatches gdttype
4389 set markingmatches 1
4390 set findcurline $l
4391 selectline $l 1
4392 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4393 # highlight the matches in the comments
4394 set f [$ctext get 1.0 $commentend]
4395 set matches [findmatches $f]
4396 foreach match $matches {
4397 set start [lindex $match 0]
4398 set end [expr {[lindex $match 1] + 1}]
4399 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4402 drawvisible
4405 # mark the bits of a headline or author that match a find string
4406 proc markmatches {canv l str tag matches font row} {
4407 global selectedline
4409 set bbox [$canv bbox $tag]
4410 set x0 [lindex $bbox 0]
4411 set y0 [lindex $bbox 1]
4412 set y1 [lindex $bbox 3]
4413 foreach match $matches {
4414 set start [lindex $match 0]
4415 set end [lindex $match 1]
4416 if {$start > $end} continue
4417 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4418 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4419 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4420 [expr {$x0+$xlen+2}] $y1 \
4421 -outline {} -tags [list match$l matches] -fill yellow]
4422 $canv lower $t
4423 if {[info exists selectedline] && $row == $selectedline} {
4424 $canv raise $t secsel
4429 proc unmarkmatches {} {
4430 global markingmatches
4432 allcanvs delete matches
4433 set markingmatches 0
4434 stopfinding
4437 proc selcanvline {w x y} {
4438 global canv canvy0 ctext linespc
4439 global rowtextx
4440 set ymax [lindex [$canv cget -scrollregion] 3]
4441 if {$ymax == {}} return
4442 set yfrac [lindex [$canv yview] 0]
4443 set y [expr {$y + $yfrac * $ymax}]
4444 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4445 if {$l < 0} {
4446 set l 0
4448 if {$w eq $canv} {
4449 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4451 unmarkmatches
4452 selectline $l 1
4455 proc commit_descriptor {p} {
4456 global commitinfo
4457 if {![info exists commitinfo($p)]} {
4458 getcommit $p
4460 set l "..."
4461 if {[llength $commitinfo($p)] > 1} {
4462 set l [lindex $commitinfo($p) 0]
4464 return "$p ($l)\n"
4467 # append some text to the ctext widget, and make any SHA1 ID
4468 # that we know about be a clickable link.
4469 proc appendwithlinks {text tags} {
4470 global ctext commitrow linknum curview pendinglinks
4472 set start [$ctext index "end - 1c"]
4473 $ctext insert end $text $tags
4474 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4475 foreach l $links {
4476 set s [lindex $l 0]
4477 set e [lindex $l 1]
4478 set linkid [string range $text $s $e]
4479 incr e
4480 $ctext tag delete link$linknum
4481 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4482 setlink $linkid link$linknum
4483 incr linknum
4487 proc setlink {id lk} {
4488 global curview commitrow ctext pendinglinks commitinterest
4490 if {[info exists commitrow($curview,$id)]} {
4491 $ctext tag conf $lk -foreground blue -underline 1
4492 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4493 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4494 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4495 } else {
4496 lappend pendinglinks($id) $lk
4497 lappend commitinterest($id) {makelink %I}
4501 proc makelink {id} {
4502 global pendinglinks
4504 if {![info exists pendinglinks($id)]} return
4505 foreach lk $pendinglinks($id) {
4506 setlink $id $lk
4508 unset pendinglinks($id)
4511 proc linkcursor {w inc} {
4512 global linkentercount curtextcursor
4514 if {[incr linkentercount $inc] > 0} {
4515 $w configure -cursor hand2
4516 } else {
4517 $w configure -cursor $curtextcursor
4518 if {$linkentercount < 0} {
4519 set linkentercount 0
4524 proc viewnextline {dir} {
4525 global canv linespc
4527 $canv delete hover
4528 set ymax [lindex [$canv cget -scrollregion] 3]
4529 set wnow [$canv yview]
4530 set wtop [expr {[lindex $wnow 0] * $ymax}]
4531 set newtop [expr {$wtop + $dir * $linespc}]
4532 if {$newtop < 0} {
4533 set newtop 0
4534 } elseif {$newtop > $ymax} {
4535 set newtop $ymax
4537 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4540 # add a list of tag or branch names at position pos
4541 # returns the number of names inserted
4542 proc appendrefs {pos ids var} {
4543 global ctext commitrow linknum curview $var maxrefs
4545 if {[catch {$ctext index $pos}]} {
4546 return 0
4548 $ctext conf -state normal
4549 $ctext delete $pos "$pos lineend"
4550 set tags {}
4551 foreach id $ids {
4552 foreach tag [set $var\($id\)] {
4553 lappend tags [list $tag $id]
4556 if {[llength $tags] > $maxrefs} {
4557 $ctext insert $pos "many ([llength $tags])"
4558 } else {
4559 set tags [lsort -index 0 -decreasing $tags]
4560 set sep {}
4561 foreach ti $tags {
4562 set id [lindex $ti 1]
4563 set lk link$linknum
4564 incr linknum
4565 $ctext tag delete $lk
4566 $ctext insert $pos $sep
4567 $ctext insert $pos [lindex $ti 0] $lk
4568 setlink $id $lk
4569 set sep ", "
4572 $ctext conf -state disabled
4573 return [llength $tags]
4576 # called when we have finished computing the nearby tags
4577 proc dispneartags {delay} {
4578 global selectedline currentid showneartags tagphase
4580 if {![info exists selectedline] || !$showneartags} return
4581 after cancel dispnexttag
4582 if {$delay} {
4583 after 200 dispnexttag
4584 set tagphase -1
4585 } else {
4586 after idle dispnexttag
4587 set tagphase 0
4591 proc dispnexttag {} {
4592 global selectedline currentid showneartags tagphase ctext
4594 if {![info exists selectedline] || !$showneartags} return
4595 switch -- $tagphase {
4597 set dtags [desctags $currentid]
4598 if {$dtags ne {}} {
4599 appendrefs precedes $dtags idtags
4603 set atags [anctags $currentid]
4604 if {$atags ne {}} {
4605 appendrefs follows $atags idtags
4609 set dheads [descheads $currentid]
4610 if {$dheads ne {}} {
4611 if {[appendrefs branch $dheads idheads] > 1
4612 && [$ctext get "branch -3c"] eq "h"} {
4613 # turn "Branch" into "Branches"
4614 $ctext conf -state normal
4615 $ctext insert "branch -2c" "es"
4616 $ctext conf -state disabled
4621 if {[incr tagphase] <= 2} {
4622 after idle dispnexttag
4626 proc make_secsel {l} {
4627 global linehtag linentag linedtag canv canv2 canv3
4629 if {![info exists linehtag($l)]} return
4630 $canv delete secsel
4631 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4632 -tags secsel -fill [$canv cget -selectbackground]]
4633 $canv lower $t
4634 $canv2 delete secsel
4635 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4636 -tags secsel -fill [$canv2 cget -selectbackground]]
4637 $canv2 lower $t
4638 $canv3 delete secsel
4639 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4640 -tags secsel -fill [$canv3 cget -selectbackground]]
4641 $canv3 lower $t
4644 proc selectline {l isnew} {
4645 global canv ctext commitinfo selectedline
4646 global displayorder
4647 global canvy0 linespc parentlist children curview
4648 global currentid sha1entry
4649 global commentend idtags linknum
4650 global mergemax numcommits pending_select
4651 global cmitmode showneartags allcommits
4653 catch {unset pending_select}
4654 $canv delete hover
4655 normalline
4656 unsel_reflist
4657 stopfinding
4658 if {$l < 0 || $l >= $numcommits} return
4659 set y [expr {$canvy0 + $l * $linespc}]
4660 set ymax [lindex [$canv cget -scrollregion] 3]
4661 set ytop [expr {$y - $linespc - 1}]
4662 set ybot [expr {$y + $linespc + 1}]
4663 set wnow [$canv yview]
4664 set wtop [expr {[lindex $wnow 0] * $ymax}]
4665 set wbot [expr {[lindex $wnow 1] * $ymax}]
4666 set wh [expr {$wbot - $wtop}]
4667 set newtop $wtop
4668 if {$ytop < $wtop} {
4669 if {$ybot < $wtop} {
4670 set newtop [expr {$y - $wh / 2.0}]
4671 } else {
4672 set newtop $ytop
4673 if {$newtop > $wtop - $linespc} {
4674 set newtop [expr {$wtop - $linespc}]
4677 } elseif {$ybot > $wbot} {
4678 if {$ytop > $wbot} {
4679 set newtop [expr {$y - $wh / 2.0}]
4680 } else {
4681 set newtop [expr {$ybot - $wh}]
4682 if {$newtop < $wtop + $linespc} {
4683 set newtop [expr {$wtop + $linespc}]
4687 if {$newtop != $wtop} {
4688 if {$newtop < 0} {
4689 set newtop 0
4691 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4692 drawvisible
4695 make_secsel $l
4697 if {$isnew} {
4698 addtohistory [list selectline $l 0]
4701 set selectedline $l
4703 set id [lindex $displayorder $l]
4704 set currentid $id
4705 $sha1entry delete 0 end
4706 $sha1entry insert 0 $id
4707 $sha1entry selection from 0
4708 $sha1entry selection to end
4709 rhighlight_sel $id
4711 $ctext conf -state normal
4712 clear_ctext
4713 set linknum 0
4714 set info $commitinfo($id)
4715 set date [formatdate [lindex $info 2]]
4716 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
4717 set date [formatdate [lindex $info 4]]
4718 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
4719 if {[info exists idtags($id)]} {
4720 $ctext insert end [mc "Tags:"]
4721 foreach tag $idtags($id) {
4722 $ctext insert end " $tag"
4724 $ctext insert end "\n"
4727 set headers {}
4728 set olds [lindex $parentlist $l]
4729 if {[llength $olds] > 1} {
4730 set np 0
4731 foreach p $olds {
4732 if {$np >= $mergemax} {
4733 set tag mmax
4734 } else {
4735 set tag m$np
4737 $ctext insert end "[mc "Parent"]: " $tag
4738 appendwithlinks [commit_descriptor $p] {}
4739 incr np
4741 } else {
4742 foreach p $olds {
4743 append headers "[mc "Parent"]: [commit_descriptor $p]"
4747 foreach c $children($curview,$id) {
4748 append headers "[mc "Child"]: [commit_descriptor $c]"
4751 # make anything that looks like a SHA1 ID be a clickable link
4752 appendwithlinks $headers {}
4753 if {$showneartags} {
4754 if {![info exists allcommits]} {
4755 getallcommits
4757 $ctext insert end "[mc "Branch"]: "
4758 $ctext mark set branch "end -1c"
4759 $ctext mark gravity branch left
4760 $ctext insert end "\n[mc "Follows"]: "
4761 $ctext mark set follows "end -1c"
4762 $ctext mark gravity follows left
4763 $ctext insert end "\n[mc "Precedes"]: "
4764 $ctext mark set precedes "end -1c"
4765 $ctext mark gravity precedes left
4766 $ctext insert end "\n"
4767 dispneartags 1
4769 $ctext insert end "\n"
4770 set comment [lindex $info 5]
4771 if {[string first "\r" $comment] >= 0} {
4772 set comment [string map {"\r" "\n "} $comment]
4774 appendwithlinks $comment {comment}
4776 $ctext tag remove found 1.0 end
4777 $ctext conf -state disabled
4778 set commentend [$ctext index "end - 1c"]
4780 init_flist [mc "Comments"]
4781 if {$cmitmode eq "tree"} {
4782 gettree $id
4783 } elseif {[llength $olds] <= 1} {
4784 startdiff $id
4785 } else {
4786 mergediff $id $l
4790 proc selfirstline {} {
4791 unmarkmatches
4792 selectline 0 1
4795 proc sellastline {} {
4796 global numcommits
4797 unmarkmatches
4798 set l [expr {$numcommits - 1}]
4799 selectline $l 1
4802 proc selnextline {dir} {
4803 global selectedline
4804 focus .
4805 if {![info exists selectedline]} return
4806 set l [expr {$selectedline + $dir}]
4807 unmarkmatches
4808 selectline $l 1
4811 proc selnextpage {dir} {
4812 global canv linespc selectedline numcommits
4814 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4815 if {$lpp < 1} {
4816 set lpp 1
4818 allcanvs yview scroll [expr {$dir * $lpp}] units
4819 drawvisible
4820 if {![info exists selectedline]} return
4821 set l [expr {$selectedline + $dir * $lpp}]
4822 if {$l < 0} {
4823 set l 0
4824 } elseif {$l >= $numcommits} {
4825 set l [expr $numcommits - 1]
4827 unmarkmatches
4828 selectline $l 1
4831 proc unselectline {} {
4832 global selectedline currentid
4834 catch {unset selectedline}
4835 catch {unset currentid}
4836 allcanvs delete secsel
4837 rhighlight_none
4840 proc reselectline {} {
4841 global selectedline
4843 if {[info exists selectedline]} {
4844 selectline $selectedline 0
4848 proc addtohistory {cmd} {
4849 global history historyindex curview
4851 set elt [list $curview $cmd]
4852 if {$historyindex > 0
4853 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4854 return
4857 if {$historyindex < [llength $history]} {
4858 set history [lreplace $history $historyindex end $elt]
4859 } else {
4860 lappend history $elt
4862 incr historyindex
4863 if {$historyindex > 1} {
4864 .tf.bar.leftbut conf -state normal
4865 } else {
4866 .tf.bar.leftbut conf -state disabled
4868 .tf.bar.rightbut conf -state disabled
4871 proc godo {elt} {
4872 global curview
4874 set view [lindex $elt 0]
4875 set cmd [lindex $elt 1]
4876 if {$curview != $view} {
4877 showview $view
4879 eval $cmd
4882 proc goback {} {
4883 global history historyindex
4884 focus .
4886 if {$historyindex > 1} {
4887 incr historyindex -1
4888 godo [lindex $history [expr {$historyindex - 1}]]
4889 .tf.bar.rightbut conf -state normal
4891 if {$historyindex <= 1} {
4892 .tf.bar.leftbut conf -state disabled
4896 proc goforw {} {
4897 global history historyindex
4898 focus .
4900 if {$historyindex < [llength $history]} {
4901 set cmd [lindex $history $historyindex]
4902 incr historyindex
4903 godo $cmd
4904 .tf.bar.leftbut conf -state normal
4906 if {$historyindex >= [llength $history]} {
4907 .tf.bar.rightbut conf -state disabled
4911 proc gettree {id} {
4912 global treefilelist treeidlist diffids diffmergeid treepending
4913 global nullid nullid2
4915 set diffids $id
4916 catch {unset diffmergeid}
4917 if {![info exists treefilelist($id)]} {
4918 if {![info exists treepending]} {
4919 if {$id eq $nullid} {
4920 set cmd [list | git ls-files]
4921 } elseif {$id eq $nullid2} {
4922 set cmd [list | git ls-files --stage -t]
4923 } else {
4924 set cmd [list | git ls-tree -r $id]
4926 if {[catch {set gtf [open $cmd r]}]} {
4927 return
4929 set treepending $id
4930 set treefilelist($id) {}
4931 set treeidlist($id) {}
4932 fconfigure $gtf -blocking 0
4933 filerun $gtf [list gettreeline $gtf $id]
4935 } else {
4936 setfilelist $id
4940 proc gettreeline {gtf id} {
4941 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4943 set nl 0
4944 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4945 if {$diffids eq $nullid} {
4946 set fname $line
4947 } else {
4948 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4949 set i [string first "\t" $line]
4950 if {$i < 0} continue
4951 set sha1 [lindex $line 2]
4952 set fname [string range $line [expr {$i+1}] end]
4953 if {[string index $fname 0] eq "\""} {
4954 set fname [lindex $fname 0]
4956 lappend treeidlist($id) $sha1
4958 lappend treefilelist($id) $fname
4960 if {![eof $gtf]} {
4961 return [expr {$nl >= 1000? 2: 1}]
4963 close $gtf
4964 unset treepending
4965 if {$cmitmode ne "tree"} {
4966 if {![info exists diffmergeid]} {
4967 gettreediffs $diffids
4969 } elseif {$id ne $diffids} {
4970 gettree $diffids
4971 } else {
4972 setfilelist $id
4974 return 0
4977 proc showfile {f} {
4978 global treefilelist treeidlist diffids nullid nullid2
4979 global ctext commentend
4981 set i [lsearch -exact $treefilelist($diffids) $f]
4982 if {$i < 0} {
4983 puts "oops, $f not in list for id $diffids"
4984 return
4986 if {$diffids eq $nullid} {
4987 if {[catch {set bf [open $f r]} err]} {
4988 puts "oops, can't read $f: $err"
4989 return
4991 } else {
4992 set blob [lindex $treeidlist($diffids) $i]
4993 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4994 puts "oops, error reading blob $blob: $err"
4995 return
4998 fconfigure $bf -blocking 0
4999 filerun $bf [list getblobline $bf $diffids]
5000 $ctext config -state normal
5001 clear_ctext $commentend
5002 $ctext insert end "\n"
5003 $ctext insert end "$f\n" filesep
5004 $ctext config -state disabled
5005 $ctext yview $commentend
5006 settabs 0
5009 proc getblobline {bf id} {
5010 global diffids cmitmode ctext
5012 if {$id ne $diffids || $cmitmode ne "tree"} {
5013 catch {close $bf}
5014 return 0
5016 $ctext config -state normal
5017 set nl 0
5018 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5019 $ctext insert end "$line\n"
5021 if {[eof $bf]} {
5022 # delete last newline
5023 $ctext delete "end - 2c" "end - 1c"
5024 close $bf
5025 return 0
5027 $ctext config -state disabled
5028 return [expr {$nl >= 1000? 2: 1}]
5031 proc mergediff {id l} {
5032 global diffmergeid mdifffd
5033 global diffids
5034 global parentlist
5035 global limitdiffs viewfiles curview
5037 set diffmergeid $id
5038 set diffids $id
5039 # this doesn't seem to actually affect anything...
5040 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5041 if {$limitdiffs && $viewfiles($curview) ne {}} {
5042 set cmd [concat $cmd -- $viewfiles($curview)]
5044 if {[catch {set mdf [open $cmd r]} err]} {
5045 error_popup "[mc "Error getting merge diffs:"] $err"
5046 return
5048 fconfigure $mdf -blocking 0
5049 set mdifffd($id) $mdf
5050 set np [llength [lindex $parentlist $l]]
5051 settabs $np
5052 filerun $mdf [list getmergediffline $mdf $id $np]
5055 proc getmergediffline {mdf id np} {
5056 global diffmergeid ctext cflist mergemax
5057 global difffilestart mdifffd
5059 $ctext conf -state normal
5060 set nr 0
5061 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5062 if {![info exists diffmergeid] || $id != $diffmergeid
5063 || $mdf != $mdifffd($id)} {
5064 close $mdf
5065 return 0
5067 if {[regexp {^diff --cc (.*)} $line match fname]} {
5068 # start of a new file
5069 $ctext insert end "\n"
5070 set here [$ctext index "end - 1c"]
5071 lappend difffilestart $here
5072 add_flist [list $fname]
5073 set l [expr {(78 - [string length $fname]) / 2}]
5074 set pad [string range "----------------------------------------" 1 $l]
5075 $ctext insert end "$pad $fname $pad\n" filesep
5076 } elseif {[regexp {^@@} $line]} {
5077 $ctext insert end "$line\n" hunksep
5078 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5079 # do nothing
5080 } else {
5081 # parse the prefix - one ' ', '-' or '+' for each parent
5082 set spaces {}
5083 set minuses {}
5084 set pluses {}
5085 set isbad 0
5086 for {set j 0} {$j < $np} {incr j} {
5087 set c [string range $line $j $j]
5088 if {$c == " "} {
5089 lappend spaces $j
5090 } elseif {$c == "-"} {
5091 lappend minuses $j
5092 } elseif {$c == "+"} {
5093 lappend pluses $j
5094 } else {
5095 set isbad 1
5096 break
5099 set tags {}
5100 set num {}
5101 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5102 # line doesn't appear in result, parents in $minuses have the line
5103 set num [lindex $minuses 0]
5104 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5105 # line appears in result, parents in $pluses don't have the line
5106 lappend tags mresult
5107 set num [lindex $spaces 0]
5109 if {$num ne {}} {
5110 if {$num >= $mergemax} {
5111 set num "max"
5113 lappend tags m$num
5115 $ctext insert end "$line\n" $tags
5118 $ctext conf -state disabled
5119 if {[eof $mdf]} {
5120 close $mdf
5121 return 0
5123 return [expr {$nr >= 1000? 2: 1}]
5126 proc startdiff {ids} {
5127 global treediffs diffids treepending diffmergeid nullid nullid2
5129 settabs 1
5130 set diffids $ids
5131 catch {unset diffmergeid}
5132 if {![info exists treediffs($ids)] ||
5133 [lsearch -exact $ids $nullid] >= 0 ||
5134 [lsearch -exact $ids $nullid2] >= 0} {
5135 if {![info exists treepending]} {
5136 gettreediffs $ids
5138 } else {
5139 addtocflist $ids
5143 proc path_filter {filter name} {
5144 foreach p $filter {
5145 set l [string length $p]
5146 if {[string index $p end] eq "/"} {
5147 if {[string compare -length $l $p $name] == 0} {
5148 return 1
5150 } else {
5151 if {[string compare -length $l $p $name] == 0 &&
5152 ([string length $name] == $l ||
5153 [string index $name $l] eq "/")} {
5154 return 1
5158 return 0
5161 proc addtocflist {ids} {
5162 global treediffs
5164 add_flist $treediffs($ids)
5165 getblobdiffs $ids
5168 proc diffcmd {ids flags} {
5169 global nullid nullid2
5171 set i [lsearch -exact $ids $nullid]
5172 set j [lsearch -exact $ids $nullid2]
5173 if {$i >= 0} {
5174 if {[llength $ids] > 1 && $j < 0} {
5175 # comparing working directory with some specific revision
5176 set cmd [concat | git diff-index $flags]
5177 if {$i == 0} {
5178 lappend cmd -R [lindex $ids 1]
5179 } else {
5180 lappend cmd [lindex $ids 0]
5182 } else {
5183 # comparing working directory with index
5184 set cmd [concat | git diff-files $flags]
5185 if {$j == 1} {
5186 lappend cmd -R
5189 } elseif {$j >= 0} {
5190 set cmd [concat | git diff-index --cached $flags]
5191 if {[llength $ids] > 1} {
5192 # comparing index with specific revision
5193 if {$i == 0} {
5194 lappend cmd -R [lindex $ids 1]
5195 } else {
5196 lappend cmd [lindex $ids 0]
5198 } else {
5199 # comparing index with HEAD
5200 lappend cmd HEAD
5202 } else {
5203 set cmd [concat | git diff-tree -r $flags $ids]
5205 return $cmd
5208 proc gettreediffs {ids} {
5209 global treediff treepending
5211 set treepending $ids
5212 set treediff {}
5213 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5214 fconfigure $gdtf -blocking 0
5215 filerun $gdtf [list gettreediffline $gdtf $ids]
5218 proc gettreediffline {gdtf ids} {
5219 global treediff treediffs treepending diffids diffmergeid
5220 global cmitmode viewfiles curview limitdiffs
5222 set nr 0
5223 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5224 set i [string first "\t" $line]
5225 if {$i >= 0} {
5226 set file [string range $line [expr {$i+1}] end]
5227 if {[string index $file 0] eq "\""} {
5228 set file [lindex $file 0]
5230 lappend treediff $file
5233 if {![eof $gdtf]} {
5234 return [expr {$nr >= 1000? 2: 1}]
5236 close $gdtf
5237 if {$limitdiffs && $viewfiles($curview) ne {}} {
5238 set flist {}
5239 foreach f $treediff {
5240 if {[path_filter $viewfiles($curview) $f]} {
5241 lappend flist $f
5244 set treediffs($ids) $flist
5245 } else {
5246 set treediffs($ids) $treediff
5248 unset treepending
5249 if {$cmitmode eq "tree"} {
5250 gettree $diffids
5251 } elseif {$ids != $diffids} {
5252 if {![info exists diffmergeid]} {
5253 gettreediffs $diffids
5255 } else {
5256 addtocflist $ids
5258 return 0
5261 # empty string or positive integer
5262 proc diffcontextvalidate {v} {
5263 return [regexp {^(|[1-9][0-9]*)$} $v]
5266 proc diffcontextchange {n1 n2 op} {
5267 global diffcontextstring diffcontext
5269 if {[string is integer -strict $diffcontextstring]} {
5270 if {$diffcontextstring > 0} {
5271 set diffcontext $diffcontextstring
5272 reselectline
5277 proc changeignorespace {} {
5278 reselectline
5281 proc getblobdiffs {ids} {
5282 global blobdifffd diffids env
5283 global diffinhdr treediffs
5284 global diffcontext
5285 global ignorespace
5286 global limitdiffs viewfiles curview
5288 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5289 if {$ignorespace} {
5290 append cmd " -w"
5292 if {$limitdiffs && $viewfiles($curview) ne {}} {
5293 set cmd [concat $cmd -- $viewfiles($curview)]
5295 if {[catch {set bdf [open $cmd r]} err]} {
5296 puts "error getting diffs: $err"
5297 return
5299 set diffinhdr 0
5300 fconfigure $bdf -blocking 0
5301 set blobdifffd($ids) $bdf
5302 filerun $bdf [list getblobdiffline $bdf $diffids]
5305 proc setinlist {var i val} {
5306 global $var
5308 while {[llength [set $var]] < $i} {
5309 lappend $var {}
5311 if {[llength [set $var]] == $i} {
5312 lappend $var $val
5313 } else {
5314 lset $var $i $val
5318 proc makediffhdr {fname ids} {
5319 global ctext curdiffstart treediffs
5321 set i [lsearch -exact $treediffs($ids) $fname]
5322 if {$i >= 0} {
5323 setinlist difffilestart $i $curdiffstart
5325 set l [expr {(78 - [string length $fname]) / 2}]
5326 set pad [string range "----------------------------------------" 1 $l]
5327 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5330 proc getblobdiffline {bdf ids} {
5331 global diffids blobdifffd ctext curdiffstart
5332 global diffnexthead diffnextnote difffilestart
5333 global diffinhdr treediffs
5335 set nr 0
5336 $ctext conf -state normal
5337 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5338 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5339 close $bdf
5340 return 0
5342 if {![string compare -length 11 "diff --git " $line]} {
5343 # trim off "diff --git "
5344 set line [string range $line 11 end]
5345 set diffinhdr 1
5346 # start of a new file
5347 $ctext insert end "\n"
5348 set curdiffstart [$ctext index "end - 1c"]
5349 $ctext insert end "\n" filesep
5350 # If the name hasn't changed the length will be odd,
5351 # the middle char will be a space, and the two bits either
5352 # side will be a/name and b/name, or "a/name" and "b/name".
5353 # If the name has changed we'll get "rename from" and
5354 # "rename to" or "copy from" and "copy to" lines following this,
5355 # and we'll use them to get the filenames.
5356 # This complexity is necessary because spaces in the filename(s)
5357 # don't get escaped.
5358 set l [string length $line]
5359 set i [expr {$l / 2}]
5360 if {!(($l & 1) && [string index $line $i] eq " " &&
5361 [string range $line 2 [expr {$i - 1}]] eq \
5362 [string range $line [expr {$i + 3}] end])} {
5363 continue
5365 # unescape if quoted and chop off the a/ from the front
5366 if {[string index $line 0] eq "\""} {
5367 set fname [string range [lindex $line 0] 2 end]
5368 } else {
5369 set fname [string range $line 2 [expr {$i - 1}]]
5371 makediffhdr $fname $ids
5373 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5374 $line match f1l f1c f2l f2c rest]} {
5375 $ctext insert end "$line\n" hunksep
5376 set diffinhdr 0
5378 } elseif {$diffinhdr} {
5379 if {![string compare -length 12 "rename from " $line]} {
5380 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5381 if {[string index $fname 0] eq "\""} {
5382 set fname [lindex $fname 0]
5384 set i [lsearch -exact $treediffs($ids) $fname]
5385 if {$i >= 0} {
5386 setinlist difffilestart $i $curdiffstart
5388 } elseif {![string compare -length 10 $line "rename to "] ||
5389 ![string compare -length 8 $line "copy to "]} {
5390 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5391 if {[string index $fname 0] eq "\""} {
5392 set fname [lindex $fname 0]
5394 makediffhdr $fname $ids
5395 } elseif {[string compare -length 3 $line "---"] == 0} {
5396 # do nothing
5397 continue
5398 } elseif {[string compare -length 3 $line "+++"] == 0} {
5399 set diffinhdr 0
5400 continue
5402 $ctext insert end "$line\n" filesep
5404 } else {
5405 set x [string range $line 0 0]
5406 if {$x == "-" || $x == "+"} {
5407 set tag [expr {$x == "+"}]
5408 $ctext insert end "$line\n" d$tag
5409 } elseif {$x == " "} {
5410 $ctext insert end "$line\n"
5411 } else {
5412 # "\ No newline at end of file",
5413 # or something else we don't recognize
5414 $ctext insert end "$line\n" hunksep
5418 $ctext conf -state disabled
5419 if {[eof $bdf]} {
5420 close $bdf
5421 return 0
5423 return [expr {$nr >= 1000? 2: 1}]
5426 proc changediffdisp {} {
5427 global ctext diffelide
5429 $ctext tag conf d0 -elide [lindex $diffelide 0]
5430 $ctext tag conf d1 -elide [lindex $diffelide 1]
5433 proc prevfile {} {
5434 global difffilestart ctext
5435 set prev [lindex $difffilestart 0]
5436 set here [$ctext index @0,0]
5437 foreach loc $difffilestart {
5438 if {[$ctext compare $loc >= $here]} {
5439 $ctext yview $prev
5440 return
5442 set prev $loc
5444 $ctext yview $prev
5447 proc nextfile {} {
5448 global difffilestart ctext
5449 set here [$ctext index @0,0]
5450 foreach loc $difffilestart {
5451 if {[$ctext compare $loc > $here]} {
5452 $ctext yview $loc
5453 return
5458 proc clear_ctext {{first 1.0}} {
5459 global ctext smarktop smarkbot
5460 global pendinglinks
5462 set l [lindex [split $first .] 0]
5463 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5464 set smarktop $l
5466 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5467 set smarkbot $l
5469 $ctext delete $first end
5470 if {$first eq "1.0"} {
5471 catch {unset pendinglinks}
5475 proc settabs {{firstab {}}} {
5476 global firsttabstop tabstop ctext have_tk85
5478 if {$firstab ne {} && $have_tk85} {
5479 set firsttabstop $firstab
5481 set w [font measure textfont "0"]
5482 if {$firsttabstop != 0} {
5483 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5484 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5485 } elseif {$have_tk85 || $tabstop != 8} {
5486 $ctext conf -tabs [expr {$tabstop * $w}]
5487 } else {
5488 $ctext conf -tabs {}
5492 proc incrsearch {name ix op} {
5493 global ctext searchstring searchdirn
5495 $ctext tag remove found 1.0 end
5496 if {[catch {$ctext index anchor}]} {
5497 # no anchor set, use start of selection, or of visible area
5498 set sel [$ctext tag ranges sel]
5499 if {$sel ne {}} {
5500 $ctext mark set anchor [lindex $sel 0]
5501 } elseif {$searchdirn eq "-forwards"} {
5502 $ctext mark set anchor @0,0
5503 } else {
5504 $ctext mark set anchor @0,[winfo height $ctext]
5507 if {$searchstring ne {}} {
5508 set here [$ctext search $searchdirn -- $searchstring anchor]
5509 if {$here ne {}} {
5510 $ctext see $here
5512 searchmarkvisible 1
5516 proc dosearch {} {
5517 global sstring ctext searchstring searchdirn
5519 focus $sstring
5520 $sstring icursor end
5521 set searchdirn -forwards
5522 if {$searchstring ne {}} {
5523 set sel [$ctext tag ranges sel]
5524 if {$sel ne {}} {
5525 set start "[lindex $sel 0] + 1c"
5526 } elseif {[catch {set start [$ctext index anchor]}]} {
5527 set start "@0,0"
5529 set match [$ctext search -count mlen -- $searchstring $start]
5530 $ctext tag remove sel 1.0 end
5531 if {$match eq {}} {
5532 bell
5533 return
5535 $ctext see $match
5536 set mend "$match + $mlen c"
5537 $ctext tag add sel $match $mend
5538 $ctext mark unset anchor
5542 proc dosearchback {} {
5543 global sstring ctext searchstring searchdirn
5545 focus $sstring
5546 $sstring icursor end
5547 set searchdirn -backwards
5548 if {$searchstring ne {}} {
5549 set sel [$ctext tag ranges sel]
5550 if {$sel ne {}} {
5551 set start [lindex $sel 0]
5552 } elseif {[catch {set start [$ctext index anchor]}]} {
5553 set start @0,[winfo height $ctext]
5555 set match [$ctext search -backwards -count ml -- $searchstring $start]
5556 $ctext tag remove sel 1.0 end
5557 if {$match eq {}} {
5558 bell
5559 return
5561 $ctext see $match
5562 set mend "$match + $ml c"
5563 $ctext tag add sel $match $mend
5564 $ctext mark unset anchor
5568 proc searchmark {first last} {
5569 global ctext searchstring
5571 set mend $first.0
5572 while {1} {
5573 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5574 if {$match eq {}} break
5575 set mend "$match + $mlen c"
5576 $ctext tag add found $match $mend
5580 proc searchmarkvisible {doall} {
5581 global ctext smarktop smarkbot
5583 set topline [lindex [split [$ctext index @0,0] .] 0]
5584 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5585 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5586 # no overlap with previous
5587 searchmark $topline $botline
5588 set smarktop $topline
5589 set smarkbot $botline
5590 } else {
5591 if {$topline < $smarktop} {
5592 searchmark $topline [expr {$smarktop-1}]
5593 set smarktop $topline
5595 if {$botline > $smarkbot} {
5596 searchmark [expr {$smarkbot+1}] $botline
5597 set smarkbot $botline
5602 proc scrolltext {f0 f1} {
5603 global searchstring
5605 .bleft.sb set $f0 $f1
5606 if {$searchstring ne {}} {
5607 searchmarkvisible 0
5611 proc setcoords {} {
5612 global linespc charspc canvx0 canvy0
5613 global xspc1 xspc2 lthickness
5615 set linespc [font metrics mainfont -linespace]
5616 set charspc [font measure mainfont "m"]
5617 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5618 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5619 set lthickness [expr {int($linespc / 9) + 1}]
5620 set xspc1(0) $linespc
5621 set xspc2 $linespc
5624 proc redisplay {} {
5625 global canv
5626 global selectedline
5628 set ymax [lindex [$canv cget -scrollregion] 3]
5629 if {$ymax eq {} || $ymax == 0} return
5630 set span [$canv yview]
5631 clear_display
5632 setcanvscroll
5633 allcanvs yview moveto [lindex $span 0]
5634 drawvisible
5635 if {[info exists selectedline]} {
5636 selectline $selectedline 0
5637 allcanvs yview moveto [lindex $span 0]
5641 proc parsefont {f n} {
5642 global fontattr
5644 set fontattr($f,family) [lindex $n 0]
5645 set s [lindex $n 1]
5646 if {$s eq {} || $s == 0} {
5647 set s 10
5648 } elseif {$s < 0} {
5649 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5651 set fontattr($f,size) $s
5652 set fontattr($f,weight) normal
5653 set fontattr($f,slant) roman
5654 foreach style [lrange $n 2 end] {
5655 switch -- $style {
5656 "normal" -
5657 "bold" {set fontattr($f,weight) $style}
5658 "roman" -
5659 "italic" {set fontattr($f,slant) $style}
5664 proc fontflags {f {isbold 0}} {
5665 global fontattr
5667 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5668 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5669 -slant $fontattr($f,slant)]
5672 proc fontname {f} {
5673 global fontattr
5675 set n [list $fontattr($f,family) $fontattr($f,size)]
5676 if {$fontattr($f,weight) eq "bold"} {
5677 lappend n "bold"
5679 if {$fontattr($f,slant) eq "italic"} {
5680 lappend n "italic"
5682 return $n
5685 proc incrfont {inc} {
5686 global mainfont textfont ctext canv phase cflist showrefstop
5687 global stopped entries fontattr
5689 unmarkmatches
5690 set s $fontattr(mainfont,size)
5691 incr s $inc
5692 if {$s < 1} {
5693 set s 1
5695 set fontattr(mainfont,size) $s
5696 font config mainfont -size $s
5697 font config mainfontbold -size $s
5698 set mainfont [fontname mainfont]
5699 set s $fontattr(textfont,size)
5700 incr s $inc
5701 if {$s < 1} {
5702 set s 1
5704 set fontattr(textfont,size) $s
5705 font config textfont -size $s
5706 font config textfontbold -size $s
5707 set textfont [fontname textfont]
5708 setcoords
5709 settabs
5710 redisplay
5713 proc clearsha1 {} {
5714 global sha1entry sha1string
5715 if {[string length $sha1string] == 40} {
5716 $sha1entry delete 0 end
5720 proc sha1change {n1 n2 op} {
5721 global sha1string currentid sha1but
5722 if {$sha1string == {}
5723 || ([info exists currentid] && $sha1string == $currentid)} {
5724 set state disabled
5725 } else {
5726 set state normal
5728 if {[$sha1but cget -state] == $state} return
5729 if {$state == "normal"} {
5730 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5731 } else {
5732 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5736 proc gotocommit {} {
5737 global sha1string currentid commitrow tagids headids
5738 global displayorder numcommits curview
5740 if {$sha1string == {}
5741 || ([info exists currentid] && $sha1string == $currentid)} return
5742 if {[info exists tagids($sha1string)]} {
5743 set id $tagids($sha1string)
5744 } elseif {[info exists headids($sha1string)]} {
5745 set id $headids($sha1string)
5746 } else {
5747 set id [string tolower $sha1string]
5748 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5749 set matches {}
5750 foreach i $displayorder {
5751 if {[string match $id* $i]} {
5752 lappend matches $i
5755 if {$matches ne {}} {
5756 if {[llength $matches] > 1} {
5757 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5758 return
5760 set id [lindex $matches 0]
5764 if {[info exists commitrow($curview,$id)]} {
5765 selectline $commitrow($curview,$id) 1
5766 return
5768 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5769 set msg [mc "SHA1 id %s is not known" $sha1string]
5770 } else {
5771 set msg [mc "Tag/Head %s is not known" $sha1string]
5773 error_popup $msg
5776 proc lineenter {x y id} {
5777 global hoverx hovery hoverid hovertimer
5778 global commitinfo canv
5780 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5781 set hoverx $x
5782 set hovery $y
5783 set hoverid $id
5784 if {[info exists hovertimer]} {
5785 after cancel $hovertimer
5787 set hovertimer [after 500 linehover]
5788 $canv delete hover
5791 proc linemotion {x y id} {
5792 global hoverx hovery hoverid hovertimer
5794 if {[info exists hoverid] && $id == $hoverid} {
5795 set hoverx $x
5796 set hovery $y
5797 if {[info exists hovertimer]} {
5798 after cancel $hovertimer
5800 set hovertimer [after 500 linehover]
5804 proc lineleave {id} {
5805 global hoverid hovertimer canv
5807 if {[info exists hoverid] && $id == $hoverid} {
5808 $canv delete hover
5809 if {[info exists hovertimer]} {
5810 after cancel $hovertimer
5811 unset hovertimer
5813 unset hoverid
5817 proc linehover {} {
5818 global hoverx hovery hoverid hovertimer
5819 global canv linespc lthickness
5820 global commitinfo
5822 set text [lindex $commitinfo($hoverid) 0]
5823 set ymax [lindex [$canv cget -scrollregion] 3]
5824 if {$ymax == {}} return
5825 set yfrac [lindex [$canv yview] 0]
5826 set x [expr {$hoverx + 2 * $linespc}]
5827 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5828 set x0 [expr {$x - 2 * $lthickness}]
5829 set y0 [expr {$y - 2 * $lthickness}]
5830 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5831 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5832 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5833 -fill \#ffff80 -outline black -width 1 -tags hover]
5834 $canv raise $t
5835 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5836 -font mainfont]
5837 $canv raise $t
5840 proc clickisonarrow {id y} {
5841 global lthickness
5843 set ranges [rowranges $id]
5844 set thresh [expr {2 * $lthickness + 6}]
5845 set n [expr {[llength $ranges] - 1}]
5846 for {set i 1} {$i < $n} {incr i} {
5847 set row [lindex $ranges $i]
5848 if {abs([yc $row] - $y) < $thresh} {
5849 return $i
5852 return {}
5855 proc arrowjump {id n y} {
5856 global canv
5858 # 1 <-> 2, 3 <-> 4, etc...
5859 set n [expr {(($n - 1) ^ 1) + 1}]
5860 set row [lindex [rowranges $id] $n]
5861 set yt [yc $row]
5862 set ymax [lindex [$canv cget -scrollregion] 3]
5863 if {$ymax eq {} || $ymax <= 0} return
5864 set view [$canv yview]
5865 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5866 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5867 if {$yfrac < 0} {
5868 set yfrac 0
5870 allcanvs yview moveto $yfrac
5873 proc lineclick {x y id isnew} {
5874 global ctext commitinfo children canv thickerline curview commitrow
5876 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5877 unmarkmatches
5878 unselectline
5879 normalline
5880 $canv delete hover
5881 # draw this line thicker than normal
5882 set thickerline $id
5883 drawlines $id
5884 if {$isnew} {
5885 set ymax [lindex [$canv cget -scrollregion] 3]
5886 if {$ymax eq {}} return
5887 set yfrac [lindex [$canv yview] 0]
5888 set y [expr {$y + $yfrac * $ymax}]
5890 set dirn [clickisonarrow $id $y]
5891 if {$dirn ne {}} {
5892 arrowjump $id $dirn $y
5893 return
5896 if {$isnew} {
5897 addtohistory [list lineclick $x $y $id 0]
5899 # fill the details pane with info about this line
5900 $ctext conf -state normal
5901 clear_ctext
5902 settabs 0
5903 $ctext insert end "[mc "Parent"]:\t"
5904 $ctext insert end $id link0
5905 setlink $id link0
5906 set info $commitinfo($id)
5907 $ctext insert end "\n\t[lindex $info 0]\n"
5908 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5909 set date [formatdate [lindex $info 2]]
5910 $ctext insert end "\t[mc "Date"]:\t$date\n"
5911 set kids $children($curview,$id)
5912 if {$kids ne {}} {
5913 $ctext insert end "\n[mc "Children"]:"
5914 set i 0
5915 foreach child $kids {
5916 incr i
5917 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5918 set info $commitinfo($child)
5919 $ctext insert end "\n\t"
5920 $ctext insert end $child link$i
5921 setlink $child link$i
5922 $ctext insert end "\n\t[lindex $info 0]"
5923 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5924 set date [formatdate [lindex $info 2]]
5925 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5928 $ctext conf -state disabled
5929 init_flist {}
5932 proc normalline {} {
5933 global thickerline
5934 if {[info exists thickerline]} {
5935 set id $thickerline
5936 unset thickerline
5937 drawlines $id
5941 proc selbyid {id} {
5942 global commitrow curview
5943 if {[info exists commitrow($curview,$id)]} {
5944 selectline $commitrow($curview,$id) 1
5948 proc mstime {} {
5949 global startmstime
5950 if {![info exists startmstime]} {
5951 set startmstime [clock clicks -milliseconds]
5953 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5956 proc rowmenu {x y id} {
5957 global rowctxmenu commitrow selectedline rowmenuid curview
5958 global nullid nullid2 fakerowmenu mainhead
5960 stopfinding
5961 set rowmenuid $id
5962 if {![info exists selectedline]
5963 || $commitrow($curview,$id) eq $selectedline} {
5964 set state disabled
5965 } else {
5966 set state normal
5968 if {$id ne $nullid && $id ne $nullid2} {
5969 set menu $rowctxmenu
5970 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
5971 } else {
5972 set menu $fakerowmenu
5974 $menu entryconfigure [mc "Diff this -> selected"] -state $state
5975 $menu entryconfigure [mc "Diff selected -> this"] -state $state
5976 $menu entryconfigure [mc "Make patch"] -state $state
5977 tk_popup $menu $x $y
5980 proc diffvssel {dirn} {
5981 global rowmenuid selectedline displayorder
5983 if {![info exists selectedline]} return
5984 if {$dirn} {
5985 set oldid [lindex $displayorder $selectedline]
5986 set newid $rowmenuid
5987 } else {
5988 set oldid $rowmenuid
5989 set newid [lindex $displayorder $selectedline]
5991 addtohistory [list doseldiff $oldid $newid]
5992 doseldiff $oldid $newid
5995 proc doseldiff {oldid newid} {
5996 global ctext
5997 global commitinfo
5999 $ctext conf -state normal
6000 clear_ctext
6001 init_flist [mc "Top"]
6002 $ctext insert end "[mc "From"] "
6003 $ctext insert end $oldid link0
6004 setlink $oldid link0
6005 $ctext insert end "\n "
6006 $ctext insert end [lindex $commitinfo($oldid) 0]
6007 $ctext insert end "\n\n[mc "To"] "
6008 $ctext insert end $newid link1
6009 setlink $newid link1
6010 $ctext insert end "\n "
6011 $ctext insert end [lindex $commitinfo($newid) 0]
6012 $ctext insert end "\n"
6013 $ctext conf -state disabled
6014 $ctext tag remove found 1.0 end
6015 startdiff [list $oldid $newid]
6018 proc mkpatch {} {
6019 global rowmenuid currentid commitinfo patchtop patchnum
6021 if {![info exists currentid]} return
6022 set oldid $currentid
6023 set oldhead [lindex $commitinfo($oldid) 0]
6024 set newid $rowmenuid
6025 set newhead [lindex $commitinfo($newid) 0]
6026 set top .patch
6027 set patchtop $top
6028 catch {destroy $top}
6029 toplevel $top
6030 label $top.title -text [mc "Generate patch"]
6031 grid $top.title - -pady 10
6032 label $top.from -text [mc "From:"]
6033 entry $top.fromsha1 -width 40 -relief flat
6034 $top.fromsha1 insert 0 $oldid
6035 $top.fromsha1 conf -state readonly
6036 grid $top.from $top.fromsha1 -sticky w
6037 entry $top.fromhead -width 60 -relief flat
6038 $top.fromhead insert 0 $oldhead
6039 $top.fromhead conf -state readonly
6040 grid x $top.fromhead -sticky w
6041 label $top.to -text [mc "To:"]
6042 entry $top.tosha1 -width 40 -relief flat
6043 $top.tosha1 insert 0 $newid
6044 $top.tosha1 conf -state readonly
6045 grid $top.to $top.tosha1 -sticky w
6046 entry $top.tohead -width 60 -relief flat
6047 $top.tohead insert 0 $newhead
6048 $top.tohead conf -state readonly
6049 grid x $top.tohead -sticky w
6050 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6051 grid $top.rev x -pady 10
6052 label $top.flab -text [mc "Output file:"]
6053 entry $top.fname -width 60
6054 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6055 incr patchnum
6056 grid $top.flab $top.fname -sticky w
6057 frame $top.buts
6058 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6059 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6060 grid $top.buts.gen $top.buts.can
6061 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6062 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6063 grid $top.buts - -pady 10 -sticky ew
6064 focus $top.fname
6067 proc mkpatchrev {} {
6068 global patchtop
6070 set oldid [$patchtop.fromsha1 get]
6071 set oldhead [$patchtop.fromhead get]
6072 set newid [$patchtop.tosha1 get]
6073 set newhead [$patchtop.tohead get]
6074 foreach e [list fromsha1 fromhead tosha1 tohead] \
6075 v [list $newid $newhead $oldid $oldhead] {
6076 $patchtop.$e conf -state normal
6077 $patchtop.$e delete 0 end
6078 $patchtop.$e insert 0 $v
6079 $patchtop.$e conf -state readonly
6083 proc mkpatchgo {} {
6084 global patchtop nullid nullid2
6086 set oldid [$patchtop.fromsha1 get]
6087 set newid [$patchtop.tosha1 get]
6088 set fname [$patchtop.fname get]
6089 set cmd [diffcmd [list $oldid $newid] -p]
6090 # trim off the initial "|"
6091 set cmd [lrange $cmd 1 end]
6092 lappend cmd >$fname &
6093 if {[catch {eval exec $cmd} err]} {
6094 error_popup "[mc "Error creating patch:"] $err"
6096 catch {destroy $patchtop}
6097 unset patchtop
6100 proc mkpatchcan {} {
6101 global patchtop
6103 catch {destroy $patchtop}
6104 unset patchtop
6107 proc mktag {} {
6108 global rowmenuid mktagtop commitinfo
6110 set top .maketag
6111 set mktagtop $top
6112 catch {destroy $top}
6113 toplevel $top
6114 label $top.title -text [mc "Create tag"]
6115 grid $top.title - -pady 10
6116 label $top.id -text [mc "ID:"]
6117 entry $top.sha1 -width 40 -relief flat
6118 $top.sha1 insert 0 $rowmenuid
6119 $top.sha1 conf -state readonly
6120 grid $top.id $top.sha1 -sticky w
6121 entry $top.head -width 60 -relief flat
6122 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6123 $top.head conf -state readonly
6124 grid x $top.head -sticky w
6125 label $top.tlab -text [mc "Tag name:"]
6126 entry $top.tag -width 60
6127 grid $top.tlab $top.tag -sticky w
6128 frame $top.buts
6129 button $top.buts.gen -text [mc "Create"] -command mktaggo
6130 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6131 grid $top.buts.gen $top.buts.can
6132 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6133 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6134 grid $top.buts - -pady 10 -sticky ew
6135 focus $top.tag
6138 proc domktag {} {
6139 global mktagtop env tagids idtags
6141 set id [$mktagtop.sha1 get]
6142 set tag [$mktagtop.tag get]
6143 if {$tag == {}} {
6144 error_popup [mc "No tag name specified"]
6145 return
6147 if {[info exists tagids($tag)]} {
6148 error_popup [mc "Tag \"%s\" already exists" $tag]
6149 return
6151 if {[catch {
6152 set dir [gitdir]
6153 set fname [file join $dir "refs/tags" $tag]
6154 set f [open $fname w]
6155 puts $f $id
6156 close $f
6157 } err]} {
6158 error_popup "[mc "Error creating tag:"] $err"
6159 return
6162 set tagids($tag) $id
6163 lappend idtags($id) $tag
6164 redrawtags $id
6165 addedtag $id
6166 dispneartags 0
6167 run refill_reflist
6170 proc redrawtags {id} {
6171 global canv linehtag commitrow idpos selectedline curview
6172 global canvxmax iddrawn
6174 if {![info exists commitrow($curview,$id)]} return
6175 if {![info exists iddrawn($id)]} return
6176 drawcommits $commitrow($curview,$id)
6177 $canv delete tag.$id
6178 set xt [eval drawtags $id $idpos($id)]
6179 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6180 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6181 set xr [expr {$xt + [font measure mainfont $text]}]
6182 if {$xr > $canvxmax} {
6183 set canvxmax $xr
6184 setcanvscroll
6186 if {[info exists selectedline]
6187 && $selectedline == $commitrow($curview,$id)} {
6188 selectline $selectedline 0
6192 proc mktagcan {} {
6193 global mktagtop
6195 catch {destroy $mktagtop}
6196 unset mktagtop
6199 proc mktaggo {} {
6200 domktag
6201 mktagcan
6204 proc writecommit {} {
6205 global rowmenuid wrcomtop commitinfo wrcomcmd
6207 set top .writecommit
6208 set wrcomtop $top
6209 catch {destroy $top}
6210 toplevel $top
6211 label $top.title -text [mc "Write commit to file"]
6212 grid $top.title - -pady 10
6213 label $top.id -text [mc "ID:"]
6214 entry $top.sha1 -width 40 -relief flat
6215 $top.sha1 insert 0 $rowmenuid
6216 $top.sha1 conf -state readonly
6217 grid $top.id $top.sha1 -sticky w
6218 entry $top.head -width 60 -relief flat
6219 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6220 $top.head conf -state readonly
6221 grid x $top.head -sticky w
6222 label $top.clab -text [mc "Command:"]
6223 entry $top.cmd -width 60 -textvariable wrcomcmd
6224 grid $top.clab $top.cmd -sticky w -pady 10
6225 label $top.flab -text [mc "Output file:"]
6226 entry $top.fname -width 60
6227 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6228 grid $top.flab $top.fname -sticky w
6229 frame $top.buts
6230 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6231 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6232 grid $top.buts.gen $top.buts.can
6233 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6234 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6235 grid $top.buts - -pady 10 -sticky ew
6236 focus $top.fname
6239 proc wrcomgo {} {
6240 global wrcomtop
6242 set id [$wrcomtop.sha1 get]
6243 set cmd "echo $id | [$wrcomtop.cmd get]"
6244 set fname [$wrcomtop.fname get]
6245 if {[catch {exec sh -c $cmd >$fname &} err]} {
6246 error_popup "[mc "Error writing commit:"] $err"
6248 catch {destroy $wrcomtop}
6249 unset wrcomtop
6252 proc wrcomcan {} {
6253 global wrcomtop
6255 catch {destroy $wrcomtop}
6256 unset wrcomtop
6259 proc mkbranch {} {
6260 global rowmenuid mkbrtop
6262 set top .makebranch
6263 catch {destroy $top}
6264 toplevel $top
6265 label $top.title -text [mc "Create new branch"]
6266 grid $top.title - -pady 10
6267 label $top.id -text [mc "ID:"]
6268 entry $top.sha1 -width 40 -relief flat
6269 $top.sha1 insert 0 $rowmenuid
6270 $top.sha1 conf -state readonly
6271 grid $top.id $top.sha1 -sticky w
6272 label $top.nlab -text [mc "Name:"]
6273 entry $top.name -width 40
6274 grid $top.nlab $top.name -sticky w
6275 frame $top.buts
6276 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6277 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6278 grid $top.buts.go $top.buts.can
6279 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6280 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6281 grid $top.buts - -pady 10 -sticky ew
6282 focus $top.name
6285 proc mkbrgo {top} {
6286 global headids idheads
6288 set name [$top.name get]
6289 set id [$top.sha1 get]
6290 if {$name eq {}} {
6291 error_popup [mc "Please specify a name for the new branch"]
6292 return
6294 catch {destroy $top}
6295 nowbusy newbranch
6296 update
6297 if {[catch {
6298 exec git branch $name $id
6299 } err]} {
6300 notbusy newbranch
6301 error_popup $err
6302 } else {
6303 set headids($name) $id
6304 lappend idheads($id) $name
6305 addedhead $id $name
6306 notbusy newbranch
6307 redrawtags $id
6308 dispneartags 0
6309 run refill_reflist
6313 proc cherrypick {} {
6314 global rowmenuid curview commitrow
6315 global mainhead
6317 set oldhead [exec git rev-parse HEAD]
6318 set dheads [descheads $rowmenuid]
6319 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6320 set ok [confirm_popup [mc "Commit %s is already\
6321 included in branch %s -- really re-apply it?" \
6322 [string range $rowmenuid 0 7] $mainhead]]
6323 if {!$ok} return
6325 nowbusy cherrypick [mc "Cherry-picking"]
6326 update
6327 # Unfortunately git-cherry-pick writes stuff to stderr even when
6328 # no error occurs, and exec takes that as an indication of error...
6329 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6330 notbusy cherrypick
6331 error_popup $err
6332 return
6334 set newhead [exec git rev-parse HEAD]
6335 if {$newhead eq $oldhead} {
6336 notbusy cherrypick
6337 error_popup [mc "No changes committed"]
6338 return
6340 addnewchild $newhead $oldhead
6341 if {[info exists commitrow($curview,$oldhead)]} {
6342 insertrow $commitrow($curview,$oldhead) $newhead
6343 if {$mainhead ne {}} {
6344 movehead $newhead $mainhead
6345 movedhead $newhead $mainhead
6347 redrawtags $oldhead
6348 redrawtags $newhead
6350 notbusy cherrypick
6353 proc resethead {} {
6354 global mainheadid mainhead rowmenuid confirm_ok resettype
6356 set confirm_ok 0
6357 set w ".confirmreset"
6358 toplevel $w
6359 wm transient $w .
6360 wm title $w [mc "Confirm reset"]
6361 message $w.m -text \
6362 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6363 -justify center -aspect 1000
6364 pack $w.m -side top -fill x -padx 20 -pady 20
6365 frame $w.f -relief sunken -border 2
6366 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6367 grid $w.f.rt -sticky w
6368 set resettype mixed
6369 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6370 -text [mc "Soft: Leave working tree and index untouched"]
6371 grid $w.f.soft -sticky w
6372 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6373 -text [mc "Mixed: Leave working tree untouched, reset index"]
6374 grid $w.f.mixed -sticky w
6375 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6376 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6377 grid $w.f.hard -sticky w
6378 pack $w.f -side top -fill x
6379 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6380 pack $w.ok -side left -fill x -padx 20 -pady 20
6381 button $w.cancel -text [mc Cancel] -command "destroy $w"
6382 pack $w.cancel -side right -fill x -padx 20 -pady 20
6383 bind $w <Visibility> "grab $w; focus $w"
6384 tkwait window $w
6385 if {!$confirm_ok} return
6386 if {[catch {set fd [open \
6387 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6388 error_popup $err
6389 } else {
6390 dohidelocalchanges
6391 filerun $fd [list readresetstat $fd]
6392 nowbusy reset [mc "Resetting"]
6396 proc readresetstat {fd} {
6397 global mainhead mainheadid showlocalchanges rprogcoord
6399 if {[gets $fd line] >= 0} {
6400 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6401 set rprogcoord [expr {1.0 * $m / $n}]
6402 adjustprogress
6404 return 1
6406 set rprogcoord 0
6407 adjustprogress
6408 notbusy reset
6409 if {[catch {close $fd} err]} {
6410 error_popup $err
6412 set oldhead $mainheadid
6413 set newhead [exec git rev-parse HEAD]
6414 if {$newhead ne $oldhead} {
6415 movehead $newhead $mainhead
6416 movedhead $newhead $mainhead
6417 set mainheadid $newhead
6418 redrawtags $oldhead
6419 redrawtags $newhead
6421 if {$showlocalchanges} {
6422 doshowlocalchanges
6424 return 0
6427 # context menu for a head
6428 proc headmenu {x y id head} {
6429 global headmenuid headmenuhead headctxmenu mainhead
6431 stopfinding
6432 set headmenuid $id
6433 set headmenuhead $head
6434 set state normal
6435 if {$head eq $mainhead} {
6436 set state disabled
6438 $headctxmenu entryconfigure 0 -state $state
6439 $headctxmenu entryconfigure 1 -state $state
6440 tk_popup $headctxmenu $x $y
6443 proc cobranch {} {
6444 global headmenuid headmenuhead mainhead headids
6445 global showlocalchanges mainheadid
6447 # check the tree is clean first??
6448 set oldmainhead $mainhead
6449 nowbusy checkout [mc "Checking out"]
6450 update
6451 dohidelocalchanges
6452 if {[catch {
6453 exec git checkout -q $headmenuhead
6454 } err]} {
6455 notbusy checkout
6456 error_popup $err
6457 } else {
6458 notbusy checkout
6459 set mainhead $headmenuhead
6460 set mainheadid $headmenuid
6461 if {[info exists headids($oldmainhead)]} {
6462 redrawtags $headids($oldmainhead)
6464 redrawtags $headmenuid
6466 if {$showlocalchanges} {
6467 dodiffindex
6471 proc rmbranch {} {
6472 global headmenuid headmenuhead mainhead
6473 global idheads
6475 set head $headmenuhead
6476 set id $headmenuid
6477 # this check shouldn't be needed any more...
6478 if {$head eq $mainhead} {
6479 error_popup [mc "Cannot delete the currently checked-out branch"]
6480 return
6482 set dheads [descheads $id]
6483 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6484 # the stuff on this branch isn't on any other branch
6485 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6486 branch.\nReally delete branch %s?" $head $head]]} return
6488 nowbusy rmbranch
6489 update
6490 if {[catch {exec git branch -D $head} err]} {
6491 notbusy rmbranch
6492 error_popup $err
6493 return
6495 removehead $id $head
6496 removedhead $id $head
6497 redrawtags $id
6498 notbusy rmbranch
6499 dispneartags 0
6500 run refill_reflist
6503 # Display a list of tags and heads
6504 proc showrefs {} {
6505 global showrefstop bgcolor fgcolor selectbgcolor
6506 global bglist fglist reflistfilter reflist maincursor
6508 set top .showrefs
6509 set showrefstop $top
6510 if {[winfo exists $top]} {
6511 raise $top
6512 refill_reflist
6513 return
6515 toplevel $top
6516 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6517 text $top.list -background $bgcolor -foreground $fgcolor \
6518 -selectbackground $selectbgcolor -font mainfont \
6519 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6520 -width 30 -height 20 -cursor $maincursor \
6521 -spacing1 1 -spacing3 1 -state disabled
6522 $top.list tag configure highlight -background $selectbgcolor
6523 lappend bglist $top.list
6524 lappend fglist $top.list
6525 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6526 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6527 grid $top.list $top.ysb -sticky nsew
6528 grid $top.xsb x -sticky ew
6529 frame $top.f
6530 label $top.f.l -text "[mc "Filter"]: "
6531 entry $top.f.e -width 20 -textvariable reflistfilter
6532 set reflistfilter "*"
6533 trace add variable reflistfilter write reflistfilter_change
6534 pack $top.f.e -side right -fill x -expand 1
6535 pack $top.f.l -side left
6536 grid $top.f - -sticky ew -pady 2
6537 button $top.close -command [list destroy $top] -text [mc "Close"]
6538 grid $top.close -
6539 grid columnconfigure $top 0 -weight 1
6540 grid rowconfigure $top 0 -weight 1
6541 bind $top.list <1> {break}
6542 bind $top.list <B1-Motion> {break}
6543 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6544 set reflist {}
6545 refill_reflist
6548 proc sel_reflist {w x y} {
6549 global showrefstop reflist headids tagids otherrefids
6551 if {![winfo exists $showrefstop]} return
6552 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6553 set ref [lindex $reflist [expr {$l-1}]]
6554 set n [lindex $ref 0]
6555 switch -- [lindex $ref 1] {
6556 "H" {selbyid $headids($n)}
6557 "T" {selbyid $tagids($n)}
6558 "o" {selbyid $otherrefids($n)}
6560 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6563 proc unsel_reflist {} {
6564 global showrefstop
6566 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6567 $showrefstop.list tag remove highlight 0.0 end
6570 proc reflistfilter_change {n1 n2 op} {
6571 global reflistfilter
6573 after cancel refill_reflist
6574 after 200 refill_reflist
6577 proc refill_reflist {} {
6578 global reflist reflistfilter showrefstop headids tagids otherrefids
6579 global commitrow curview commitinterest
6581 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6582 set refs {}
6583 foreach n [array names headids] {
6584 if {[string match $reflistfilter $n]} {
6585 if {[info exists commitrow($curview,$headids($n))]} {
6586 lappend refs [list $n H]
6587 } else {
6588 set commitinterest($headids($n)) {run refill_reflist}
6592 foreach n [array names tagids] {
6593 if {[string match $reflistfilter $n]} {
6594 if {[info exists commitrow($curview,$tagids($n))]} {
6595 lappend refs [list $n T]
6596 } else {
6597 set commitinterest($tagids($n)) {run refill_reflist}
6601 foreach n [array names otherrefids] {
6602 if {[string match $reflistfilter $n]} {
6603 if {[info exists commitrow($curview,$otherrefids($n))]} {
6604 lappend refs [list $n o]
6605 } else {
6606 set commitinterest($otherrefids($n)) {run refill_reflist}
6610 set refs [lsort -index 0 $refs]
6611 if {$refs eq $reflist} return
6613 # Update the contents of $showrefstop.list according to the
6614 # differences between $reflist (old) and $refs (new)
6615 $showrefstop.list conf -state normal
6616 $showrefstop.list insert end "\n"
6617 set i 0
6618 set j 0
6619 while {$i < [llength $reflist] || $j < [llength $refs]} {
6620 if {$i < [llength $reflist]} {
6621 if {$j < [llength $refs]} {
6622 set cmp [string compare [lindex $reflist $i 0] \
6623 [lindex $refs $j 0]]
6624 if {$cmp == 0} {
6625 set cmp [string compare [lindex $reflist $i 1] \
6626 [lindex $refs $j 1]]
6628 } else {
6629 set cmp -1
6631 } else {
6632 set cmp 1
6634 switch -- $cmp {
6635 -1 {
6636 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6637 incr i
6640 incr i
6641 incr j
6644 set l [expr {$j + 1}]
6645 $showrefstop.list image create $l.0 -align baseline \
6646 -image reficon-[lindex $refs $j 1] -padx 2
6647 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6648 incr j
6652 set reflist $refs
6653 # delete last newline
6654 $showrefstop.list delete end-2c end-1c
6655 $showrefstop.list conf -state disabled
6658 # Stuff for finding nearby tags
6659 proc getallcommits {} {
6660 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6661 global idheads idtags idotherrefs allparents tagobjid
6663 if {![info exists allcommits]} {
6664 set nextarc 0
6665 set allcommits 0
6666 set seeds {}
6667 set allcwait 0
6668 set cachedarcs 0
6669 set allccache [file join [gitdir] "gitk.cache"]
6670 if {![catch {
6671 set f [open $allccache r]
6672 set allcwait 1
6673 getcache $f
6674 }]} return
6677 if {$allcwait} {
6678 return
6680 set cmd [list | git rev-list --parents]
6681 set allcupdate [expr {$seeds ne {}}]
6682 if {!$allcupdate} {
6683 set ids "--all"
6684 } else {
6685 set refs [concat [array names idheads] [array names idtags] \
6686 [array names idotherrefs]]
6687 set ids {}
6688 set tagobjs {}
6689 foreach name [array names tagobjid] {
6690 lappend tagobjs $tagobjid($name)
6692 foreach id [lsort -unique $refs] {
6693 if {![info exists allparents($id)] &&
6694 [lsearch -exact $tagobjs $id] < 0} {
6695 lappend ids $id
6698 if {$ids ne {}} {
6699 foreach id $seeds {
6700 lappend ids "^$id"
6704 if {$ids ne {}} {
6705 set fd [open [concat $cmd $ids] r]
6706 fconfigure $fd -blocking 0
6707 incr allcommits
6708 nowbusy allcommits
6709 filerun $fd [list getallclines $fd]
6710 } else {
6711 dispneartags 0
6715 # Since most commits have 1 parent and 1 child, we group strings of
6716 # such commits into "arcs" joining branch/merge points (BMPs), which
6717 # are commits that either don't have 1 parent or don't have 1 child.
6719 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6720 # arcout(id) - outgoing arcs for BMP
6721 # arcids(a) - list of IDs on arc including end but not start
6722 # arcstart(a) - BMP ID at start of arc
6723 # arcend(a) - BMP ID at end of arc
6724 # growing(a) - arc a is still growing
6725 # arctags(a) - IDs out of arcids (excluding end) that have tags
6726 # archeads(a) - IDs out of arcids (excluding end) that have heads
6727 # The start of an arc is at the descendent end, so "incoming" means
6728 # coming from descendents, and "outgoing" means going towards ancestors.
6730 proc getallclines {fd} {
6731 global allparents allchildren idtags idheads nextarc
6732 global arcnos arcids arctags arcout arcend arcstart archeads growing
6733 global seeds allcommits cachedarcs allcupdate
6735 set nid 0
6736 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6737 set id [lindex $line 0]
6738 if {[info exists allparents($id)]} {
6739 # seen it already
6740 continue
6742 set cachedarcs 0
6743 set olds [lrange $line 1 end]
6744 set allparents($id) $olds
6745 if {![info exists allchildren($id)]} {
6746 set allchildren($id) {}
6747 set arcnos($id) {}
6748 lappend seeds $id
6749 } else {
6750 set a $arcnos($id)
6751 if {[llength $olds] == 1 && [llength $a] == 1} {
6752 lappend arcids($a) $id
6753 if {[info exists idtags($id)]} {
6754 lappend arctags($a) $id
6756 if {[info exists idheads($id)]} {
6757 lappend archeads($a) $id
6759 if {[info exists allparents($olds)]} {
6760 # seen parent already
6761 if {![info exists arcout($olds)]} {
6762 splitarc $olds
6764 lappend arcids($a) $olds
6765 set arcend($a) $olds
6766 unset growing($a)
6768 lappend allchildren($olds) $id
6769 lappend arcnos($olds) $a
6770 continue
6773 foreach a $arcnos($id) {
6774 lappend arcids($a) $id
6775 set arcend($a) $id
6776 unset growing($a)
6779 set ao {}
6780 foreach p $olds {
6781 lappend allchildren($p) $id
6782 set a [incr nextarc]
6783 set arcstart($a) $id
6784 set archeads($a) {}
6785 set arctags($a) {}
6786 set archeads($a) {}
6787 set arcids($a) {}
6788 lappend ao $a
6789 set growing($a) 1
6790 if {[info exists allparents($p)]} {
6791 # seen it already, may need to make a new branch
6792 if {![info exists arcout($p)]} {
6793 splitarc $p
6795 lappend arcids($a) $p
6796 set arcend($a) $p
6797 unset growing($a)
6799 lappend arcnos($p) $a
6801 set arcout($id) $ao
6803 if {$nid > 0} {
6804 global cached_dheads cached_dtags cached_atags
6805 catch {unset cached_dheads}
6806 catch {unset cached_dtags}
6807 catch {unset cached_atags}
6809 if {![eof $fd]} {
6810 return [expr {$nid >= 1000? 2: 1}]
6812 set cacheok 1
6813 if {[catch {
6814 fconfigure $fd -blocking 1
6815 close $fd
6816 } err]} {
6817 # got an error reading the list of commits
6818 # if we were updating, try rereading the whole thing again
6819 if {$allcupdate} {
6820 incr allcommits -1
6821 dropcache $err
6822 return
6824 error_popup "[mc "Error reading commit topology information;\
6825 branch and preceding/following tag information\
6826 will be incomplete."]\n($err)"
6827 set cacheok 0
6829 if {[incr allcommits -1] == 0} {
6830 notbusy allcommits
6831 if {$cacheok} {
6832 run savecache
6835 dispneartags 0
6836 return 0
6839 proc recalcarc {a} {
6840 global arctags archeads arcids idtags idheads
6842 set at {}
6843 set ah {}
6844 foreach id [lrange $arcids($a) 0 end-1] {
6845 if {[info exists idtags($id)]} {
6846 lappend at $id
6848 if {[info exists idheads($id)]} {
6849 lappend ah $id
6852 set arctags($a) $at
6853 set archeads($a) $ah
6856 proc splitarc {p} {
6857 global arcnos arcids nextarc arctags archeads idtags idheads
6858 global arcstart arcend arcout allparents growing
6860 set a $arcnos($p)
6861 if {[llength $a] != 1} {
6862 puts "oops splitarc called but [llength $a] arcs already"
6863 return
6865 set a [lindex $a 0]
6866 set i [lsearch -exact $arcids($a) $p]
6867 if {$i < 0} {
6868 puts "oops splitarc $p not in arc $a"
6869 return
6871 set na [incr nextarc]
6872 if {[info exists arcend($a)]} {
6873 set arcend($na) $arcend($a)
6874 } else {
6875 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6876 set j [lsearch -exact $arcnos($l) $a]
6877 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6879 set tail [lrange $arcids($a) [expr {$i+1}] end]
6880 set arcids($a) [lrange $arcids($a) 0 $i]
6881 set arcend($a) $p
6882 set arcstart($na) $p
6883 set arcout($p) $na
6884 set arcids($na) $tail
6885 if {[info exists growing($a)]} {
6886 set growing($na) 1
6887 unset growing($a)
6890 foreach id $tail {
6891 if {[llength $arcnos($id)] == 1} {
6892 set arcnos($id) $na
6893 } else {
6894 set j [lsearch -exact $arcnos($id) $a]
6895 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6899 # reconstruct tags and heads lists
6900 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6901 recalcarc $a
6902 recalcarc $na
6903 } else {
6904 set arctags($na) {}
6905 set archeads($na) {}
6909 # Update things for a new commit added that is a child of one
6910 # existing commit. Used when cherry-picking.
6911 proc addnewchild {id p} {
6912 global allparents allchildren idtags nextarc
6913 global arcnos arcids arctags arcout arcend arcstart archeads growing
6914 global seeds allcommits
6916 if {![info exists allcommits] || ![info exists arcnos($p)]} return
6917 set allparents($id) [list $p]
6918 set allchildren($id) {}
6919 set arcnos($id) {}
6920 lappend seeds $id
6921 lappend allchildren($p) $id
6922 set a [incr nextarc]
6923 set arcstart($a) $id
6924 set archeads($a) {}
6925 set arctags($a) {}
6926 set arcids($a) [list $p]
6927 set arcend($a) $p
6928 if {![info exists arcout($p)]} {
6929 splitarc $p
6931 lappend arcnos($p) $a
6932 set arcout($id) [list $a]
6935 # This implements a cache for the topology information.
6936 # The cache saves, for each arc, the start and end of the arc,
6937 # the ids on the arc, and the outgoing arcs from the end.
6938 proc readcache {f} {
6939 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6940 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6941 global allcwait
6943 set a $nextarc
6944 set lim $cachedarcs
6945 if {$lim - $a > 500} {
6946 set lim [expr {$a + 500}]
6948 if {[catch {
6949 if {$a == $lim} {
6950 # finish reading the cache and setting up arctags, etc.
6951 set line [gets $f]
6952 if {$line ne "1"} {error "bad final version"}
6953 close $f
6954 foreach id [array names idtags] {
6955 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6956 [llength $allparents($id)] == 1} {
6957 set a [lindex $arcnos($id) 0]
6958 if {$arctags($a) eq {}} {
6959 recalcarc $a
6963 foreach id [array names idheads] {
6964 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6965 [llength $allparents($id)] == 1} {
6966 set a [lindex $arcnos($id) 0]
6967 if {$archeads($a) eq {}} {
6968 recalcarc $a
6972 foreach id [lsort -unique $possible_seeds] {
6973 if {$arcnos($id) eq {}} {
6974 lappend seeds $id
6977 set allcwait 0
6978 } else {
6979 while {[incr a] <= $lim} {
6980 set line [gets $f]
6981 if {[llength $line] != 3} {error "bad line"}
6982 set s [lindex $line 0]
6983 set arcstart($a) $s
6984 lappend arcout($s) $a
6985 if {![info exists arcnos($s)]} {
6986 lappend possible_seeds $s
6987 set arcnos($s) {}
6989 set e [lindex $line 1]
6990 if {$e eq {}} {
6991 set growing($a) 1
6992 } else {
6993 set arcend($a) $e
6994 if {![info exists arcout($e)]} {
6995 set arcout($e) {}
6998 set arcids($a) [lindex $line 2]
6999 foreach id $arcids($a) {
7000 lappend allparents($s) $id
7001 set s $id
7002 lappend arcnos($id) $a
7004 if {![info exists allparents($s)]} {
7005 set allparents($s) {}
7007 set arctags($a) {}
7008 set archeads($a) {}
7010 set nextarc [expr {$a - 1}]
7012 } err]} {
7013 dropcache $err
7014 return 0
7016 if {!$allcwait} {
7017 getallcommits
7019 return $allcwait
7022 proc getcache {f} {
7023 global nextarc cachedarcs possible_seeds
7025 if {[catch {
7026 set line [gets $f]
7027 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7028 # make sure it's an integer
7029 set cachedarcs [expr {int([lindex $line 1])}]
7030 if {$cachedarcs < 0} {error "bad number of arcs"}
7031 set nextarc 0
7032 set possible_seeds {}
7033 run readcache $f
7034 } err]} {
7035 dropcache $err
7037 return 0
7040 proc dropcache {err} {
7041 global allcwait nextarc cachedarcs seeds
7043 #puts "dropping cache ($err)"
7044 foreach v {arcnos arcout arcids arcstart arcend growing \
7045 arctags archeads allparents allchildren} {
7046 global $v
7047 catch {unset $v}
7049 set allcwait 0
7050 set nextarc 0
7051 set cachedarcs 0
7052 set seeds {}
7053 getallcommits
7056 proc writecache {f} {
7057 global cachearc cachedarcs allccache
7058 global arcstart arcend arcnos arcids arcout
7060 set a $cachearc
7061 set lim $cachedarcs
7062 if {$lim - $a > 1000} {
7063 set lim [expr {$a + 1000}]
7065 if {[catch {
7066 while {[incr a] <= $lim} {
7067 if {[info exists arcend($a)]} {
7068 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7069 } else {
7070 puts $f [list $arcstart($a) {} $arcids($a)]
7073 } err]} {
7074 catch {close $f}
7075 catch {file delete $allccache}
7076 #puts "writing cache failed ($err)"
7077 return 0
7079 set cachearc [expr {$a - 1}]
7080 if {$a > $cachedarcs} {
7081 puts $f "1"
7082 close $f
7083 return 0
7085 return 1
7088 proc savecache {} {
7089 global nextarc cachedarcs cachearc allccache
7091 if {$nextarc == $cachedarcs} return
7092 set cachearc 0
7093 set cachedarcs $nextarc
7094 catch {
7095 set f [open $allccache w]
7096 puts $f [list 1 $cachedarcs]
7097 run writecache $f
7101 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7102 # or 0 if neither is true.
7103 proc anc_or_desc {a b} {
7104 global arcout arcstart arcend arcnos cached_isanc
7106 if {$arcnos($a) eq $arcnos($b)} {
7107 # Both are on the same arc(s); either both are the same BMP,
7108 # or if one is not a BMP, the other is also not a BMP or is
7109 # the BMP at end of the arc (and it only has 1 incoming arc).
7110 # Or both can be BMPs with no incoming arcs.
7111 if {$a eq $b || $arcnos($a) eq {}} {
7112 return 0
7114 # assert {[llength $arcnos($a)] == 1}
7115 set arc [lindex $arcnos($a) 0]
7116 set i [lsearch -exact $arcids($arc) $a]
7117 set j [lsearch -exact $arcids($arc) $b]
7118 if {$i < 0 || $i > $j} {
7119 return 1
7120 } else {
7121 return -1
7125 if {![info exists arcout($a)]} {
7126 set arc [lindex $arcnos($a) 0]
7127 if {[info exists arcend($arc)]} {
7128 set aend $arcend($arc)
7129 } else {
7130 set aend {}
7132 set a $arcstart($arc)
7133 } else {
7134 set aend $a
7136 if {![info exists arcout($b)]} {
7137 set arc [lindex $arcnos($b) 0]
7138 if {[info exists arcend($arc)]} {
7139 set bend $arcend($arc)
7140 } else {
7141 set bend {}
7143 set b $arcstart($arc)
7144 } else {
7145 set bend $b
7147 if {$a eq $bend} {
7148 return 1
7150 if {$b eq $aend} {
7151 return -1
7153 if {[info exists cached_isanc($a,$bend)]} {
7154 if {$cached_isanc($a,$bend)} {
7155 return 1
7158 if {[info exists cached_isanc($b,$aend)]} {
7159 if {$cached_isanc($b,$aend)} {
7160 return -1
7162 if {[info exists cached_isanc($a,$bend)]} {
7163 return 0
7167 set todo [list $a $b]
7168 set anc($a) a
7169 set anc($b) b
7170 for {set i 0} {$i < [llength $todo]} {incr i} {
7171 set x [lindex $todo $i]
7172 if {$anc($x) eq {}} {
7173 continue
7175 foreach arc $arcnos($x) {
7176 set xd $arcstart($arc)
7177 if {$xd eq $bend} {
7178 set cached_isanc($a,$bend) 1
7179 set cached_isanc($b,$aend) 0
7180 return 1
7181 } elseif {$xd eq $aend} {
7182 set cached_isanc($b,$aend) 1
7183 set cached_isanc($a,$bend) 0
7184 return -1
7186 if {![info exists anc($xd)]} {
7187 set anc($xd) $anc($x)
7188 lappend todo $xd
7189 } elseif {$anc($xd) ne $anc($x)} {
7190 set anc($xd) {}
7194 set cached_isanc($a,$bend) 0
7195 set cached_isanc($b,$aend) 0
7196 return 0
7199 # This identifies whether $desc has an ancestor that is
7200 # a growing tip of the graph and which is not an ancestor of $anc
7201 # and returns 0 if so and 1 if not.
7202 # If we subsequently discover a tag on such a growing tip, and that
7203 # turns out to be a descendent of $anc (which it could, since we
7204 # don't necessarily see children before parents), then $desc
7205 # isn't a good choice to display as a descendent tag of
7206 # $anc (since it is the descendent of another tag which is
7207 # a descendent of $anc). Similarly, $anc isn't a good choice to
7208 # display as a ancestor tag of $desc.
7210 proc is_certain {desc anc} {
7211 global arcnos arcout arcstart arcend growing problems
7213 set certain {}
7214 if {[llength $arcnos($anc)] == 1} {
7215 # tags on the same arc are certain
7216 if {$arcnos($desc) eq $arcnos($anc)} {
7217 return 1
7219 if {![info exists arcout($anc)]} {
7220 # if $anc is partway along an arc, use the start of the arc instead
7221 set a [lindex $arcnos($anc) 0]
7222 set anc $arcstart($a)
7225 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7226 set x $desc
7227 } else {
7228 set a [lindex $arcnos($desc) 0]
7229 set x $arcend($a)
7231 if {$x == $anc} {
7232 return 1
7234 set anclist [list $x]
7235 set dl($x) 1
7236 set nnh 1
7237 set ngrowanc 0
7238 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7239 set x [lindex $anclist $i]
7240 if {$dl($x)} {
7241 incr nnh -1
7243 set done($x) 1
7244 foreach a $arcout($x) {
7245 if {[info exists growing($a)]} {
7246 if {![info exists growanc($x)] && $dl($x)} {
7247 set growanc($x) 1
7248 incr ngrowanc
7250 } else {
7251 set y $arcend($a)
7252 if {[info exists dl($y)]} {
7253 if {$dl($y)} {
7254 if {!$dl($x)} {
7255 set dl($y) 0
7256 if {![info exists done($y)]} {
7257 incr nnh -1
7259 if {[info exists growanc($x)]} {
7260 incr ngrowanc -1
7262 set xl [list $y]
7263 for {set k 0} {$k < [llength $xl]} {incr k} {
7264 set z [lindex $xl $k]
7265 foreach c $arcout($z) {
7266 if {[info exists arcend($c)]} {
7267 set v $arcend($c)
7268 if {[info exists dl($v)] && $dl($v)} {
7269 set dl($v) 0
7270 if {![info exists done($v)]} {
7271 incr nnh -1
7273 if {[info exists growanc($v)]} {
7274 incr ngrowanc -1
7276 lappend xl $v
7283 } elseif {$y eq $anc || !$dl($x)} {
7284 set dl($y) 0
7285 lappend anclist $y
7286 } else {
7287 set dl($y) 1
7288 lappend anclist $y
7289 incr nnh
7294 foreach x [array names growanc] {
7295 if {$dl($x)} {
7296 return 0
7298 return 0
7300 return 1
7303 proc validate_arctags {a} {
7304 global arctags idtags
7306 set i -1
7307 set na $arctags($a)
7308 foreach id $arctags($a) {
7309 incr i
7310 if {![info exists idtags($id)]} {
7311 set na [lreplace $na $i $i]
7312 incr i -1
7315 set arctags($a) $na
7318 proc validate_archeads {a} {
7319 global archeads idheads
7321 set i -1
7322 set na $archeads($a)
7323 foreach id $archeads($a) {
7324 incr i
7325 if {![info exists idheads($id)]} {
7326 set na [lreplace $na $i $i]
7327 incr i -1
7330 set archeads($a) $na
7333 # Return the list of IDs that have tags that are descendents of id,
7334 # ignoring IDs that are descendents of IDs already reported.
7335 proc desctags {id} {
7336 global arcnos arcstart arcids arctags idtags allparents
7337 global growing cached_dtags
7339 if {![info exists allparents($id)]} {
7340 return {}
7342 set t1 [clock clicks -milliseconds]
7343 set argid $id
7344 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7345 # part-way along an arc; check that arc first
7346 set a [lindex $arcnos($id) 0]
7347 if {$arctags($a) ne {}} {
7348 validate_arctags $a
7349 set i [lsearch -exact $arcids($a) $id]
7350 set tid {}
7351 foreach t $arctags($a) {
7352 set j [lsearch -exact $arcids($a) $t]
7353 if {$j >= $i} break
7354 set tid $t
7356 if {$tid ne {}} {
7357 return $tid
7360 set id $arcstart($a)
7361 if {[info exists idtags($id)]} {
7362 return $id
7365 if {[info exists cached_dtags($id)]} {
7366 return $cached_dtags($id)
7369 set origid $id
7370 set todo [list $id]
7371 set queued($id) 1
7372 set nc 1
7373 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7374 set id [lindex $todo $i]
7375 set done($id) 1
7376 set ta [info exists hastaggedancestor($id)]
7377 if {!$ta} {
7378 incr nc -1
7380 # ignore tags on starting node
7381 if {!$ta && $i > 0} {
7382 if {[info exists idtags($id)]} {
7383 set tagloc($id) $id
7384 set ta 1
7385 } elseif {[info exists cached_dtags($id)]} {
7386 set tagloc($id) $cached_dtags($id)
7387 set ta 1
7390 foreach a $arcnos($id) {
7391 set d $arcstart($a)
7392 if {!$ta && $arctags($a) ne {}} {
7393 validate_arctags $a
7394 if {$arctags($a) ne {}} {
7395 lappend tagloc($id) [lindex $arctags($a) end]
7398 if {$ta || $arctags($a) ne {}} {
7399 set tomark [list $d]
7400 for {set j 0} {$j < [llength $tomark]} {incr j} {
7401 set dd [lindex $tomark $j]
7402 if {![info exists hastaggedancestor($dd)]} {
7403 if {[info exists done($dd)]} {
7404 foreach b $arcnos($dd) {
7405 lappend tomark $arcstart($b)
7407 if {[info exists tagloc($dd)]} {
7408 unset tagloc($dd)
7410 } elseif {[info exists queued($dd)]} {
7411 incr nc -1
7413 set hastaggedancestor($dd) 1
7417 if {![info exists queued($d)]} {
7418 lappend todo $d
7419 set queued($d) 1
7420 if {![info exists hastaggedancestor($d)]} {
7421 incr nc
7426 set tags {}
7427 foreach id [array names tagloc] {
7428 if {![info exists hastaggedancestor($id)]} {
7429 foreach t $tagloc($id) {
7430 if {[lsearch -exact $tags $t] < 0} {
7431 lappend tags $t
7436 set t2 [clock clicks -milliseconds]
7437 set loopix $i
7439 # remove tags that are descendents of other tags
7440 for {set i 0} {$i < [llength $tags]} {incr i} {
7441 set a [lindex $tags $i]
7442 for {set j 0} {$j < $i} {incr j} {
7443 set b [lindex $tags $j]
7444 set r [anc_or_desc $a $b]
7445 if {$r == 1} {
7446 set tags [lreplace $tags $j $j]
7447 incr j -1
7448 incr i -1
7449 } elseif {$r == -1} {
7450 set tags [lreplace $tags $i $i]
7451 incr i -1
7452 break
7457 if {[array names growing] ne {}} {
7458 # graph isn't finished, need to check if any tag could get
7459 # eclipsed by another tag coming later. Simply ignore any
7460 # tags that could later get eclipsed.
7461 set ctags {}
7462 foreach t $tags {
7463 if {[is_certain $t $origid]} {
7464 lappend ctags $t
7467 if {$tags eq $ctags} {
7468 set cached_dtags($origid) $tags
7469 } else {
7470 set tags $ctags
7472 } else {
7473 set cached_dtags($origid) $tags
7475 set t3 [clock clicks -milliseconds]
7476 if {0 && $t3 - $t1 >= 100} {
7477 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7478 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7480 return $tags
7483 proc anctags {id} {
7484 global arcnos arcids arcout arcend arctags idtags allparents
7485 global growing cached_atags
7487 if {![info exists allparents($id)]} {
7488 return {}
7490 set t1 [clock clicks -milliseconds]
7491 set argid $id
7492 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7493 # part-way along an arc; check that arc first
7494 set a [lindex $arcnos($id) 0]
7495 if {$arctags($a) ne {}} {
7496 validate_arctags $a
7497 set i [lsearch -exact $arcids($a) $id]
7498 foreach t $arctags($a) {
7499 set j [lsearch -exact $arcids($a) $t]
7500 if {$j > $i} {
7501 return $t
7505 if {![info exists arcend($a)]} {
7506 return {}
7508 set id $arcend($a)
7509 if {[info exists idtags($id)]} {
7510 return $id
7513 if {[info exists cached_atags($id)]} {
7514 return $cached_atags($id)
7517 set origid $id
7518 set todo [list $id]
7519 set queued($id) 1
7520 set taglist {}
7521 set nc 1
7522 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7523 set id [lindex $todo $i]
7524 set done($id) 1
7525 set td [info exists hastaggeddescendent($id)]
7526 if {!$td} {
7527 incr nc -1
7529 # ignore tags on starting node
7530 if {!$td && $i > 0} {
7531 if {[info exists idtags($id)]} {
7532 set tagloc($id) $id
7533 set td 1
7534 } elseif {[info exists cached_atags($id)]} {
7535 set tagloc($id) $cached_atags($id)
7536 set td 1
7539 foreach a $arcout($id) {
7540 if {!$td && $arctags($a) ne {}} {
7541 validate_arctags $a
7542 if {$arctags($a) ne {}} {
7543 lappend tagloc($id) [lindex $arctags($a) 0]
7546 if {![info exists arcend($a)]} continue
7547 set d $arcend($a)
7548 if {$td || $arctags($a) ne {}} {
7549 set tomark [list $d]
7550 for {set j 0} {$j < [llength $tomark]} {incr j} {
7551 set dd [lindex $tomark $j]
7552 if {![info exists hastaggeddescendent($dd)]} {
7553 if {[info exists done($dd)]} {
7554 foreach b $arcout($dd) {
7555 if {[info exists arcend($b)]} {
7556 lappend tomark $arcend($b)
7559 if {[info exists tagloc($dd)]} {
7560 unset tagloc($dd)
7562 } elseif {[info exists queued($dd)]} {
7563 incr nc -1
7565 set hastaggeddescendent($dd) 1
7569 if {![info exists queued($d)]} {
7570 lappend todo $d
7571 set queued($d) 1
7572 if {![info exists hastaggeddescendent($d)]} {
7573 incr nc
7578 set t2 [clock clicks -milliseconds]
7579 set loopix $i
7580 set tags {}
7581 foreach id [array names tagloc] {
7582 if {![info exists hastaggeddescendent($id)]} {
7583 foreach t $tagloc($id) {
7584 if {[lsearch -exact $tags $t] < 0} {
7585 lappend tags $t
7591 # remove tags that are ancestors of other tags
7592 for {set i 0} {$i < [llength $tags]} {incr i} {
7593 set a [lindex $tags $i]
7594 for {set j 0} {$j < $i} {incr j} {
7595 set b [lindex $tags $j]
7596 set r [anc_or_desc $a $b]
7597 if {$r == -1} {
7598 set tags [lreplace $tags $j $j]
7599 incr j -1
7600 incr i -1
7601 } elseif {$r == 1} {
7602 set tags [lreplace $tags $i $i]
7603 incr i -1
7604 break
7609 if {[array names growing] ne {}} {
7610 # graph isn't finished, need to check if any tag could get
7611 # eclipsed by another tag coming later. Simply ignore any
7612 # tags that could later get eclipsed.
7613 set ctags {}
7614 foreach t $tags {
7615 if {[is_certain $origid $t]} {
7616 lappend ctags $t
7619 if {$tags eq $ctags} {
7620 set cached_atags($origid) $tags
7621 } else {
7622 set tags $ctags
7624 } else {
7625 set cached_atags($origid) $tags
7627 set t3 [clock clicks -milliseconds]
7628 if {0 && $t3 - $t1 >= 100} {
7629 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7630 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7632 return $tags
7635 # Return the list of IDs that have heads that are descendents of id,
7636 # including id itself if it has a head.
7637 proc descheads {id} {
7638 global arcnos arcstart arcids archeads idheads cached_dheads
7639 global allparents
7641 if {![info exists allparents($id)]} {
7642 return {}
7644 set aret {}
7645 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7646 # part-way along an arc; check it first
7647 set a [lindex $arcnos($id) 0]
7648 if {$archeads($a) ne {}} {
7649 validate_archeads $a
7650 set i [lsearch -exact $arcids($a) $id]
7651 foreach t $archeads($a) {
7652 set j [lsearch -exact $arcids($a) $t]
7653 if {$j > $i} break
7654 lappend aret $t
7657 set id $arcstart($a)
7659 set origid $id
7660 set todo [list $id]
7661 set seen($id) 1
7662 set ret {}
7663 for {set i 0} {$i < [llength $todo]} {incr i} {
7664 set id [lindex $todo $i]
7665 if {[info exists cached_dheads($id)]} {
7666 set ret [concat $ret $cached_dheads($id)]
7667 } else {
7668 if {[info exists idheads($id)]} {
7669 lappend ret $id
7671 foreach a $arcnos($id) {
7672 if {$archeads($a) ne {}} {
7673 validate_archeads $a
7674 if {$archeads($a) ne {}} {
7675 set ret [concat $ret $archeads($a)]
7678 set d $arcstart($a)
7679 if {![info exists seen($d)]} {
7680 lappend todo $d
7681 set seen($d) 1
7686 set ret [lsort -unique $ret]
7687 set cached_dheads($origid) $ret
7688 return [concat $ret $aret]
7691 proc addedtag {id} {
7692 global arcnos arcout cached_dtags cached_atags
7694 if {![info exists arcnos($id)]} return
7695 if {![info exists arcout($id)]} {
7696 recalcarc [lindex $arcnos($id) 0]
7698 catch {unset cached_dtags}
7699 catch {unset cached_atags}
7702 proc addedhead {hid head} {
7703 global arcnos arcout cached_dheads
7705 if {![info exists arcnos($hid)]} return
7706 if {![info exists arcout($hid)]} {
7707 recalcarc [lindex $arcnos($hid) 0]
7709 catch {unset cached_dheads}
7712 proc removedhead {hid head} {
7713 global cached_dheads
7715 catch {unset cached_dheads}
7718 proc movedhead {hid head} {
7719 global arcnos arcout cached_dheads
7721 if {![info exists arcnos($hid)]} return
7722 if {![info exists arcout($hid)]} {
7723 recalcarc [lindex $arcnos($hid) 0]
7725 catch {unset cached_dheads}
7728 proc changedrefs {} {
7729 global cached_dheads cached_dtags cached_atags
7730 global arctags archeads arcnos arcout idheads idtags
7732 foreach id [concat [array names idheads] [array names idtags]] {
7733 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7734 set a [lindex $arcnos($id) 0]
7735 if {![info exists donearc($a)]} {
7736 recalcarc $a
7737 set donearc($a) 1
7741 catch {unset cached_dtags}
7742 catch {unset cached_atags}
7743 catch {unset cached_dheads}
7746 proc rereadrefs {} {
7747 global idtags idheads idotherrefs mainhead
7749 set refids [concat [array names idtags] \
7750 [array names idheads] [array names idotherrefs]]
7751 foreach id $refids {
7752 if {![info exists ref($id)]} {
7753 set ref($id) [listrefs $id]
7756 set oldmainhead $mainhead
7757 readrefs
7758 changedrefs
7759 set refids [lsort -unique [concat $refids [array names idtags] \
7760 [array names idheads] [array names idotherrefs]]]
7761 foreach id $refids {
7762 set v [listrefs $id]
7763 if {![info exists ref($id)] || $ref($id) != $v ||
7764 ($id eq $oldmainhead && $id ne $mainhead) ||
7765 ($id eq $mainhead && $id ne $oldmainhead)} {
7766 redrawtags $id
7769 run refill_reflist
7772 proc listrefs {id} {
7773 global idtags idheads idotherrefs
7775 set x {}
7776 if {[info exists idtags($id)]} {
7777 set x $idtags($id)
7779 set y {}
7780 if {[info exists idheads($id)]} {
7781 set y $idheads($id)
7783 set z {}
7784 if {[info exists idotherrefs($id)]} {
7785 set z $idotherrefs($id)
7787 return [list $x $y $z]
7790 proc showtag {tag isnew} {
7791 global ctext tagcontents tagids linknum tagobjid
7793 if {$isnew} {
7794 addtohistory [list showtag $tag 0]
7796 $ctext conf -state normal
7797 clear_ctext
7798 settabs 0
7799 set linknum 0
7800 if {![info exists tagcontents($tag)]} {
7801 catch {
7802 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7805 if {[info exists tagcontents($tag)]} {
7806 set text $tagcontents($tag)
7807 } else {
7808 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
7810 appendwithlinks $text {}
7811 $ctext conf -state disabled
7812 init_flist {}
7815 proc doquit {} {
7816 global stopped
7817 set stopped 100
7818 savestuff .
7819 destroy .
7822 proc mkfontdisp {font top which} {
7823 global fontattr fontpref $font
7825 set fontpref($font) [set $font]
7826 button $top.${font}but -text $which -font optionfont \
7827 -command [list choosefont $font $which]
7828 label $top.$font -relief flat -font $font \
7829 -text $fontattr($font,family) -justify left
7830 grid x $top.${font}but $top.$font -sticky w
7833 proc choosefont {font which} {
7834 global fontparam fontlist fonttop fontattr
7836 set fontparam(which) $which
7837 set fontparam(font) $font
7838 set fontparam(family) [font actual $font -family]
7839 set fontparam(size) $fontattr($font,size)
7840 set fontparam(weight) $fontattr($font,weight)
7841 set fontparam(slant) $fontattr($font,slant)
7842 set top .gitkfont
7843 set fonttop $top
7844 if {![winfo exists $top]} {
7845 font create sample
7846 eval font config sample [font actual $font]
7847 toplevel $top
7848 wm title $top [mc "Gitk font chooser"]
7849 label $top.l -textvariable fontparam(which)
7850 pack $top.l -side top
7851 set fontlist [lsort [font families]]
7852 frame $top.f
7853 listbox $top.f.fam -listvariable fontlist \
7854 -yscrollcommand [list $top.f.sb set]
7855 bind $top.f.fam <<ListboxSelect>> selfontfam
7856 scrollbar $top.f.sb -command [list $top.f.fam yview]
7857 pack $top.f.sb -side right -fill y
7858 pack $top.f.fam -side left -fill both -expand 1
7859 pack $top.f -side top -fill both -expand 1
7860 frame $top.g
7861 spinbox $top.g.size -from 4 -to 40 -width 4 \
7862 -textvariable fontparam(size) \
7863 -validatecommand {string is integer -strict %s}
7864 checkbutton $top.g.bold -padx 5 \
7865 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7866 -variable fontparam(weight) -onvalue bold -offvalue normal
7867 checkbutton $top.g.ital -padx 5 \
7868 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
7869 -variable fontparam(slant) -onvalue italic -offvalue roman
7870 pack $top.g.size $top.g.bold $top.g.ital -side left
7871 pack $top.g -side top
7872 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7873 -background white
7874 $top.c create text 100 25 -anchor center -text $which -font sample \
7875 -fill black -tags text
7876 bind $top.c <Configure> [list centertext $top.c]
7877 pack $top.c -side top -fill x
7878 frame $top.buts
7879 button $top.buts.ok -text [mc "OK"] -command fontok -default active
7880 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7881 grid $top.buts.ok $top.buts.can
7882 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7883 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7884 pack $top.buts -side bottom -fill x
7885 trace add variable fontparam write chg_fontparam
7886 } else {
7887 raise $top
7888 $top.c itemconf text -text $which
7890 set i [lsearch -exact $fontlist $fontparam(family)]
7891 if {$i >= 0} {
7892 $top.f.fam selection set $i
7893 $top.f.fam see $i
7897 proc centertext {w} {
7898 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7901 proc fontok {} {
7902 global fontparam fontpref prefstop
7904 set f $fontparam(font)
7905 set fontpref($f) [list $fontparam(family) $fontparam(size)]
7906 if {$fontparam(weight) eq "bold"} {
7907 lappend fontpref($f) "bold"
7909 if {$fontparam(slant) eq "italic"} {
7910 lappend fontpref($f) "italic"
7912 set w $prefstop.$f
7913 $w conf -text $fontparam(family) -font $fontpref($f)
7915 fontcan
7918 proc fontcan {} {
7919 global fonttop fontparam
7921 if {[info exists fonttop]} {
7922 catch {destroy $fonttop}
7923 catch {font delete sample}
7924 unset fonttop
7925 unset fontparam
7929 proc selfontfam {} {
7930 global fonttop fontparam
7932 set i [$fonttop.f.fam curselection]
7933 if {$i ne {}} {
7934 set fontparam(family) [$fonttop.f.fam get $i]
7938 proc chg_fontparam {v sub op} {
7939 global fontparam
7941 font config sample -$sub $fontparam($sub)
7944 proc doprefs {} {
7945 global maxwidth maxgraphpct
7946 global oldprefs prefstop showneartags showlocalchanges
7947 global bgcolor fgcolor ctext diffcolors selectbgcolor
7948 global tabstop limitdiffs
7950 set top .gitkprefs
7951 set prefstop $top
7952 if {[winfo exists $top]} {
7953 raise $top
7954 return
7956 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7957 limitdiffs tabstop} {
7958 set oldprefs($v) [set $v]
7960 toplevel $top
7961 wm title $top [mc "Gitk preferences"]
7962 label $top.ldisp -text [mc "Commit list display options"]
7963 grid $top.ldisp - -sticky w -pady 10
7964 label $top.spacer -text " "
7965 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7966 -font optionfont
7967 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7968 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7969 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7970 -font optionfont
7971 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7972 grid x $top.maxpctl $top.maxpct -sticky w
7973 frame $top.showlocal
7974 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7975 checkbutton $top.showlocal.b -variable showlocalchanges
7976 pack $top.showlocal.b $top.showlocal.l -side left
7977 grid x $top.showlocal -sticky w
7979 label $top.ddisp -text [mc "Diff display options"]
7980 grid $top.ddisp - -sticky w -pady 10
7981 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7982 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7983 grid x $top.tabstopl $top.tabstop -sticky w
7984 frame $top.ntag
7985 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7986 checkbutton $top.ntag.b -variable showneartags
7987 pack $top.ntag.b $top.ntag.l -side left
7988 grid x $top.ntag -sticky w
7989 frame $top.ldiff
7990 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7991 checkbutton $top.ldiff.b -variable limitdiffs
7992 pack $top.ldiff.b $top.ldiff.l -side left
7993 grid x $top.ldiff -sticky w
7995 label $top.cdisp -text [mc "Colors: press to choose"]
7996 grid $top.cdisp - -sticky w -pady 10
7997 label $top.bg -padx 40 -relief sunk -background $bgcolor
7998 button $top.bgbut -text [mc "Background"] -font optionfont \
7999 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8000 grid x $top.bgbut $top.bg -sticky w
8001 label $top.fg -padx 40 -relief sunk -background $fgcolor
8002 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8003 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8004 grid x $top.fgbut $top.fg -sticky w
8005 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8006 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8007 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8008 [list $ctext tag conf d0 -foreground]]
8009 grid x $top.diffoldbut $top.diffold -sticky w
8010 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8011 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8012 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8013 [list $ctext tag conf d1 -foreground]]
8014 grid x $top.diffnewbut $top.diffnew -sticky w
8015 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8016 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8017 -command [list choosecolor diffcolors 2 $top.hunksep \
8018 "diff hunk header" \
8019 [list $ctext tag conf hunksep -foreground]]
8020 grid x $top.hunksepbut $top.hunksep -sticky w
8021 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8022 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8023 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8024 grid x $top.selbgbut $top.selbgsep -sticky w
8026 label $top.cfont -text [mc "Fonts: press to choose"]
8027 grid $top.cfont - -sticky w -pady 10
8028 mkfontdisp mainfont $top [mc "Main font"]
8029 mkfontdisp textfont $top [mc "Diff display font"]
8030 mkfontdisp uifont $top [mc "User interface font"]
8032 frame $top.buts
8033 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8034 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8035 grid $top.buts.ok $top.buts.can
8036 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8037 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8038 grid $top.buts - - -pady 10 -sticky ew
8039 bind $top <Visibility> "focus $top.buts.ok"
8042 proc choosecolor {v vi w x cmd} {
8043 global $v
8045 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8046 -title [mc "Gitk: choose color for %s" $x]]
8047 if {$c eq {}} return
8048 $w conf -background $c
8049 lset $v $vi $c
8050 eval $cmd $c
8053 proc setselbg {c} {
8054 global bglist cflist
8055 foreach w $bglist {
8056 $w configure -selectbackground $c
8058 $cflist tag configure highlight \
8059 -background [$cflist cget -selectbackground]
8060 allcanvs itemconf secsel -fill $c
8063 proc setbg {c} {
8064 global bglist
8066 foreach w $bglist {
8067 $w conf -background $c
8071 proc setfg {c} {
8072 global fglist canv
8074 foreach w $fglist {
8075 $w conf -foreground $c
8077 allcanvs itemconf text -fill $c
8078 $canv itemconf circle -outline $c
8081 proc prefscan {} {
8082 global oldprefs prefstop
8084 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8085 limitdiffs tabstop} {
8086 global $v
8087 set $v $oldprefs($v)
8089 catch {destroy $prefstop}
8090 unset prefstop
8091 fontcan
8094 proc prefsok {} {
8095 global maxwidth maxgraphpct
8096 global oldprefs prefstop showneartags showlocalchanges
8097 global fontpref mainfont textfont uifont
8098 global limitdiffs treediffs
8100 catch {destroy $prefstop}
8101 unset prefstop
8102 fontcan
8103 set fontchanged 0
8104 if {$mainfont ne $fontpref(mainfont)} {
8105 set mainfont $fontpref(mainfont)
8106 parsefont mainfont $mainfont
8107 eval font configure mainfont [fontflags mainfont]
8108 eval font configure mainfontbold [fontflags mainfont 1]
8109 setcoords
8110 set fontchanged 1
8112 if {$textfont ne $fontpref(textfont)} {
8113 set textfont $fontpref(textfont)
8114 parsefont textfont $textfont
8115 eval font configure textfont [fontflags textfont]
8116 eval font configure textfontbold [fontflags textfont 1]
8118 if {$uifont ne $fontpref(uifont)} {
8119 set uifont $fontpref(uifont)
8120 parsefont uifont $uifont
8121 eval font configure uifont [fontflags uifont]
8123 settabs
8124 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8125 if {$showlocalchanges} {
8126 doshowlocalchanges
8127 } else {
8128 dohidelocalchanges
8131 if {$limitdiffs != $oldprefs(limitdiffs)} {
8132 # treediffs elements are limited by path
8133 catch {unset treediffs}
8135 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8136 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8137 redisplay
8138 } elseif {$showneartags != $oldprefs(showneartags) ||
8139 $limitdiffs != $oldprefs(limitdiffs)} {
8140 reselectline
8144 proc formatdate {d} {
8145 global datetimeformat
8146 if {$d ne {}} {
8147 set d [clock format $d -format $datetimeformat]
8149 return $d
8152 # This list of encoding names and aliases is distilled from
8153 # http://www.iana.org/assignments/character-sets.
8154 # Not all of them are supported by Tcl.
8155 set encoding_aliases {
8156 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8157 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8158 { ISO-10646-UTF-1 csISO10646UTF1 }
8159 { ISO_646.basic:1983 ref csISO646basic1983 }
8160 { INVARIANT csINVARIANT }
8161 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8162 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8163 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8164 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8165 { NATS-DANO iso-ir-9-1 csNATSDANO }
8166 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8167 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8168 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8169 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8170 { ISO-2022-KR csISO2022KR }
8171 { EUC-KR csEUCKR }
8172 { ISO-2022-JP csISO2022JP }
8173 { ISO-2022-JP-2 csISO2022JP2 }
8174 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8175 csISO13JISC6220jp }
8176 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8177 { IT iso-ir-15 ISO646-IT csISO15Italian }
8178 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8179 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8180 { greek7-old iso-ir-18 csISO18Greek7Old }
8181 { latin-greek iso-ir-19 csISO19LatinGreek }
8182 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8183 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8184 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8185 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8186 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8187 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8188 { INIS iso-ir-49 csISO49INIS }
8189 { INIS-8 iso-ir-50 csISO50INIS8 }
8190 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8191 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8192 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8193 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8194 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8195 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8196 csISO60Norwegian1 }
8197 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8198 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8199 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8200 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8201 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8202 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8203 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8204 { greek7 iso-ir-88 csISO88Greek7 }
8205 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8206 { iso-ir-90 csISO90 }
8207 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8208 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8209 csISO92JISC62991984b }
8210 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8211 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8212 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8213 csISO95JIS62291984handadd }
8214 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8215 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8216 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8217 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8218 CP819 csISOLatin1 }
8219 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8220 { T.61-7bit iso-ir-102 csISO102T617bit }
8221 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8222 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8223 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8224 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8225 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8226 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8227 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8228 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8229 arabic csISOLatinArabic }
8230 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8231 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8232 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8233 greek greek8 csISOLatinGreek }
8234 { T.101-G2 iso-ir-128 csISO128T101G2 }
8235 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8236 csISOLatinHebrew }
8237 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8238 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8239 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8240 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8241 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8242 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8243 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8244 csISOLatinCyrillic }
8245 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8246 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8247 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8248 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8249 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8250 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8251 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8252 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8253 { ISO_10367-box iso-ir-155 csISO10367Box }
8254 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8255 { latin-lap lap iso-ir-158 csISO158Lap }
8256 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8257 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8258 { us-dk csUSDK }
8259 { dk-us csDKUS }
8260 { JIS_X0201 X0201 csHalfWidthKatakana }
8261 { KSC5636 ISO646-KR csKSC5636 }
8262 { ISO-10646-UCS-2 csUnicode }
8263 { ISO-10646-UCS-4 csUCS4 }
8264 { DEC-MCS dec csDECMCS }
8265 { hp-roman8 roman8 r8 csHPRoman8 }
8266 { macintosh mac csMacintosh }
8267 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8268 csIBM037 }
8269 { IBM038 EBCDIC-INT cp038 csIBM038 }
8270 { IBM273 CP273 csIBM273 }
8271 { IBM274 EBCDIC-BE CP274 csIBM274 }
8272 { IBM275 EBCDIC-BR cp275 csIBM275 }
8273 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8274 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8275 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8276 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8277 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8278 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8279 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8280 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8281 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8282 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8283 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8284 { IBM437 cp437 437 csPC8CodePage437 }
8285 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8286 { IBM775 cp775 csPC775Baltic }
8287 { IBM850 cp850 850 csPC850Multilingual }
8288 { IBM851 cp851 851 csIBM851 }
8289 { IBM852 cp852 852 csPCp852 }
8290 { IBM855 cp855 855 csIBM855 }
8291 { IBM857 cp857 857 csIBM857 }
8292 { IBM860 cp860 860 csIBM860 }
8293 { IBM861 cp861 861 cp-is csIBM861 }
8294 { IBM862 cp862 862 csPC862LatinHebrew }
8295 { IBM863 cp863 863 csIBM863 }
8296 { IBM864 cp864 csIBM864 }
8297 { IBM865 cp865 865 csIBM865 }
8298 { IBM866 cp866 866 csIBM866 }
8299 { IBM868 CP868 cp-ar csIBM868 }
8300 { IBM869 cp869 869 cp-gr csIBM869 }
8301 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8302 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8303 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8304 { IBM891 cp891 csIBM891 }
8305 { IBM903 cp903 csIBM903 }
8306 { IBM904 cp904 904 csIBBM904 }
8307 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8308 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8309 { IBM1026 CP1026 csIBM1026 }
8310 { EBCDIC-AT-DE csIBMEBCDICATDE }
8311 { EBCDIC-AT-DE-A csEBCDICATDEA }
8312 { EBCDIC-CA-FR csEBCDICCAFR }
8313 { EBCDIC-DK-NO csEBCDICDKNO }
8314 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8315 { EBCDIC-FI-SE csEBCDICFISE }
8316 { EBCDIC-FI-SE-A csEBCDICFISEA }
8317 { EBCDIC-FR csEBCDICFR }
8318 { EBCDIC-IT csEBCDICIT }
8319 { EBCDIC-PT csEBCDICPT }
8320 { EBCDIC-ES csEBCDICES }
8321 { EBCDIC-ES-A csEBCDICESA }
8322 { EBCDIC-ES-S csEBCDICESS }
8323 { EBCDIC-UK csEBCDICUK }
8324 { EBCDIC-US csEBCDICUS }
8325 { UNKNOWN-8BIT csUnknown8BiT }
8326 { MNEMONIC csMnemonic }
8327 { MNEM csMnem }
8328 { VISCII csVISCII }
8329 { VIQR csVIQR }
8330 { KOI8-R csKOI8R }
8331 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8332 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8333 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8334 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8335 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8336 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8337 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8338 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8339 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8340 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8341 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8342 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8343 { IBM1047 IBM-1047 }
8344 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8345 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8346 { UNICODE-1-1 csUnicode11 }
8347 { CESU-8 csCESU-8 }
8348 { BOCU-1 csBOCU-1 }
8349 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8350 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8351 l8 }
8352 { ISO-8859-15 ISO_8859-15 Latin-9 }
8353 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8354 { GBK CP936 MS936 windows-936 }
8355 { JIS_Encoding csJISEncoding }
8356 { Shift_JIS MS_Kanji csShiftJIS }
8357 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8358 EUC-JP }
8359 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8360 { ISO-10646-UCS-Basic csUnicodeASCII }
8361 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8362 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8363 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8364 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8365 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8366 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8367 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8368 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8369 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8370 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8371 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8372 { Ventura-US csVenturaUS }
8373 { Ventura-International csVenturaInternational }
8374 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8375 { PC8-Turkish csPC8Turkish }
8376 { IBM-Symbols csIBMSymbols }
8377 { IBM-Thai csIBMThai }
8378 { HP-Legal csHPLegal }
8379 { HP-Pi-font csHPPiFont }
8380 { HP-Math8 csHPMath8 }
8381 { Adobe-Symbol-Encoding csHPPSMath }
8382 { HP-DeskTop csHPDesktop }
8383 { Ventura-Math csVenturaMath }
8384 { Microsoft-Publishing csMicrosoftPublishing }
8385 { Windows-31J csWindows31J }
8386 { GB2312 csGB2312 }
8387 { Big5 csBig5 }
8390 proc tcl_encoding {enc} {
8391 global encoding_aliases
8392 set names [encoding names]
8393 set lcnames [string tolower $names]
8394 set enc [string tolower $enc]
8395 set i [lsearch -exact $lcnames $enc]
8396 if {$i < 0} {
8397 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8398 if {[regsub {^iso[-_]} $enc iso encx]} {
8399 set i [lsearch -exact $lcnames $encx]
8402 if {$i < 0} {
8403 foreach l $encoding_aliases {
8404 set ll [string tolower $l]
8405 if {[lsearch -exact $ll $enc] < 0} continue
8406 # look through the aliases for one that tcl knows about
8407 foreach e $ll {
8408 set i [lsearch -exact $lcnames $e]
8409 if {$i < 0} {
8410 if {[regsub {^iso[-_]} $e iso ex]} {
8411 set i [lsearch -exact $lcnames $ex]
8414 if {$i >= 0} break
8416 break
8419 if {$i >= 0} {
8420 return [lindex $names $i]
8422 return {}
8425 # First check that Tcl/Tk is recent enough
8426 if {[catch {package require Tk 8.4} err]} {
8427 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8428 Gitk requires at least Tcl/Tk 8.4."]
8429 exit 1
8432 # defaults...
8433 set datemode 0
8434 set wrcomcmd "git diff-tree --stdin -p --pretty"
8436 set gitencoding {}
8437 catch {
8438 set gitencoding [exec git config --get i18n.commitencoding]
8440 if {$gitencoding == ""} {
8441 set gitencoding "utf-8"
8443 set tclencoding [tcl_encoding $gitencoding]
8444 if {$tclencoding == {}} {
8445 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8448 set mainfont {Helvetica 9}
8449 set textfont {Courier 9}
8450 set uifont {Helvetica 9 bold}
8451 set tabstop 8
8452 set findmergefiles 0
8453 set maxgraphpct 50
8454 set maxwidth 16
8455 set revlistorder 0
8456 set fastdate 0
8457 set uparrowlen 5
8458 set downarrowlen 5
8459 set mingaplen 100
8460 set cmitmode "patch"
8461 set wrapcomment "none"
8462 set showneartags 1
8463 set maxrefs 20
8464 set maxlinelen 200
8465 set showlocalchanges 1
8466 set limitdiffs 1
8467 set datetimeformat "%Y-%m-%d %H:%M:%S"
8469 set colors {green red blue magenta darkgrey brown orange}
8470 set bgcolor white
8471 set fgcolor black
8472 set diffcolors {red "#00a000" blue}
8473 set diffcontext 3
8474 set ignorespace 0
8475 set selectbgcolor gray85
8477 ## For msgcat loading, first locate the installation location.
8478 if { [info exists ::env(GITK_MSGSDIR)] } {
8479 ## Msgsdir was manually set in the environment.
8480 set gitk_msgsdir $::env(GITK_MSGSDIR)
8481 } else {
8482 ## Let's guess the prefix from argv0.
8483 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8484 set gitk_libdir [file join $gitk_prefix share gitk lib]
8485 set gitk_msgsdir [file join $gitk_libdir msgs]
8486 unset gitk_prefix
8489 ## Internationalization (i18n) through msgcat and gettext. See
8490 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8491 package require msgcat
8492 namespace import ::msgcat::mc
8493 ## And eventually load the actual message catalog
8494 ::msgcat::mcload $gitk_msgsdir
8496 catch {source ~/.gitk}
8498 font create optionfont -family sans-serif -size -12
8500 parsefont mainfont $mainfont
8501 eval font create mainfont [fontflags mainfont]
8502 eval font create mainfontbold [fontflags mainfont 1]
8504 parsefont textfont $textfont
8505 eval font create textfont [fontflags textfont]
8506 eval font create textfontbold [fontflags textfont 1]
8508 parsefont uifont $uifont
8509 eval font create uifont [fontflags uifont]
8511 setoptions
8513 # check that we can find a .git directory somewhere...
8514 if {[catch {set gitdir [gitdir]}]} {
8515 show_error {} . [mc "Cannot find a git repository here."]
8516 exit 1
8518 if {![file isdirectory $gitdir]} {
8519 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8520 exit 1
8523 set mergeonly 0
8524 set revtreeargs {}
8525 set cmdline_files {}
8526 set i 0
8527 foreach arg $argv {
8528 switch -- $arg {
8529 "" { }
8530 "-d" { set datemode 1 }
8531 "--merge" {
8532 set mergeonly 1
8533 lappend revtreeargs $arg
8535 "--" {
8536 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8537 break
8539 default {
8540 lappend revtreeargs $arg
8543 incr i
8546 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8547 # no -- on command line, but some arguments (other than -d)
8548 if {[catch {
8549 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8550 set cmdline_files [split $f "\n"]
8551 set n [llength $cmdline_files]
8552 set revtreeargs [lrange $revtreeargs 0 end-$n]
8553 # Unfortunately git rev-parse doesn't produce an error when
8554 # something is both a revision and a filename. To be consistent
8555 # with git log and git rev-list, check revtreeargs for filenames.
8556 foreach arg $revtreeargs {
8557 if {[file exists $arg]} {
8558 show_error {} . [mc "Ambiguous argument '%s': both revision\
8559 and filename" $arg]
8560 exit 1
8563 } err]} {
8564 # unfortunately we get both stdout and stderr in $err,
8565 # so look for "fatal:".
8566 set i [string first "fatal:" $err]
8567 if {$i > 0} {
8568 set err [string range $err [expr {$i + 6}] end]
8570 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8571 exit 1
8575 if {$mergeonly} {
8576 # find the list of unmerged files
8577 set mlist {}
8578 set nr_unmerged 0
8579 if {[catch {
8580 set fd [open "| git ls-files -u" r]
8581 } err]} {
8582 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8583 exit 1
8585 while {[gets $fd line] >= 0} {
8586 set i [string first "\t" $line]
8587 if {$i < 0} continue
8588 set fname [string range $line [expr {$i+1}] end]
8589 if {[lsearch -exact $mlist $fname] >= 0} continue
8590 incr nr_unmerged
8591 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8592 lappend mlist $fname
8595 catch {close $fd}
8596 if {$mlist eq {}} {
8597 if {$nr_unmerged == 0} {
8598 show_error {} . [mc "No files selected: --merge specified but\
8599 no files are unmerged."]
8600 } else {
8601 show_error {} . [mc "No files selected: --merge specified but\
8602 no unmerged files are within file limit."]
8604 exit 1
8606 set cmdline_files $mlist
8609 set nullid "0000000000000000000000000000000000000000"
8610 set nullid2 "0000000000000000000000000000000000000001"
8612 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8614 set runq {}
8615 set history {}
8616 set historyindex 0
8617 set fh_serial 0
8618 set nhl_names {}
8619 set highlight_paths {}
8620 set findpattern {}
8621 set searchdirn -forwards
8622 set boldrows {}
8623 set boldnamerows {}
8624 set diffelide {0 0}
8625 set markingmatches 0
8626 set linkentercount 0
8627 set need_redisplay 0
8628 set nrows_drawn 0
8629 set firsttabstop 0
8631 set nextviewnum 1
8632 set curview 0
8633 set selectedview 0
8634 set selectedhlview [mc "None"]
8635 set highlight_related [mc "None"]
8636 set highlight_files {}
8637 set viewfiles(0) {}
8638 set viewperm(0) 0
8639 set viewargs(0) {}
8641 set cmdlineok 0
8642 set stopped 0
8643 set stuffsaved 0
8644 set patchnum 0
8645 set localirow -1
8646 set localfrow -1
8647 set lserial 0
8648 setcoords
8649 makewindow
8650 # wait for the window to become visible
8651 tkwait visibility .
8652 wm title . "[file tail $argv0]: [file tail [pwd]]"
8653 readrefs
8655 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8656 # create a view for the files/dirs specified on the command line
8657 set curview 1
8658 set selectedview 1
8659 set nextviewnum 2
8660 set viewname(1) [mc "Command line"]
8661 set viewfiles(1) $cmdline_files
8662 set viewargs(1) $revtreeargs
8663 set viewperm(1) 0
8664 addviewmenu 1
8665 .bar.view entryconf [mc "Edit view..."] -state normal
8666 .bar.view entryconf [mc "Delete view"] -state normal
8669 if {[info exists permviews]} {
8670 foreach v $permviews {
8671 set n $nextviewnum
8672 incr nextviewnum
8673 set viewname($n) [lindex $v 0]
8674 set viewfiles($n) [lindex $v 1]
8675 set viewargs($n) [lindex $v 2]
8676 set viewperm($n) 1
8677 addviewmenu $n
8680 getcommits