1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
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.
9
10proc 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]
16 }
17}
18
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.
24proc run args {
25 global isonrunq runq
26
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {}} {
30 after idle dorunq
31 }
32 lappend runq [list {} $script]
33 set isonrunq($script) 1
34}
35
36proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
38}
39
40proc filereadable {fd script} {
41 global runq
42
43 fileevent $fd readable {}
44 if {$runq eq {}} {
45 after idle dorunq
46 }
47 lappend runq [list $fd $script]
48}
49
50proc dorunq {} {
51 global isonrunq runq
52
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]
69 }
70 } elseif {$fd eq {}} {
71 unset isonrunq($script)
72 }
73 set t0 $t1
74 if {$t1 - $tstart >= 80} break
75 }
76 if {$runq ne {}} {
77 after idle dorunq
78 }
79}
80
81# Start off a git rev-list process and arrange to read its output
82proc 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
88
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"
96 }
97 if {[catch {
98 set fd [open [concat | git log -z --pretty=raw $order --parents \
99 --boundary $viewargs($view) "--" $viewfiles($view)] r]
100 } err]} {
101 error_popup "Error executing git rev-list: $err"
102 exit 1
103 }
104 set commfd($view) $fd
105 set leftover($view) {}
106 if {$showlocalchanges} {
107 lappend commitinterest($mainheadid) {dodiffindex}
108 }
109 fconfigure $fd -blocking 0 -translation lf -eofchar {}
110 if {$tclencoding != {}} {
111 fconfigure $fd -encoding $tclencoding
112 }
113 filerun $fd [list getcommitlines $fd $view]
114 nowbusy $view
115 if {$view == $curview} {
116 set progressdirn 1
117 set progresscoords {0 0}
118 set proglastnc 0
119 }
120}
121
122proc stop_rev_list {} {
123 global commfd curview
124
125 if {![info exists commfd($curview)]} return
126 set fd $commfd($curview)
127 catch {
128 set pid [pid $fd]
129 exec kill $pid
130 }
131 catch {close $fd}
132 unset commfd($curview)
133}
134
135proc getcommits {} {
136 global phase canv mainfont curview
137
138 set phase getcommits
139 initlayout
140 start_rev_list $curview
141 show_status "Reading commits..."
142}
143
144# This makes a string representation of a positive integer which
145# sorts as a string in numerical order
146proc 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]
153 }
154 return [format "z%.8x" $n]
155}
156
157proc 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
164
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"
169 }
170 if {$stuff == {}} {
171 if {![eof $fd]} {
172 return 1
173 }
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
189 }
190 }
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"
203 }
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.)"
211 }
212 } else {
213 set err "Error reading commits$fv: $err"
214 }
215 error_popup $err
216 }
217 if {$view == $curview} {
218 run chewcommits $view
219 }
220 return 0
221 }
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
229 }
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}]]
236 }
237 set start [expr {$i + 1}]
238 set j [string first "\n" $cmit]
239 set ok 0
240 set listed 1
241 if {$j >= 0 && [string match "commit *" $cmit]} {
242 set ids [string range $cmit 7 [expr {$j - 1}]]
243 if {[string match {[-<>]*} $ids]} {
244 switch -- [string index $ids 0] {
245 "-" {set listed 0}
246 "<" {set listed 2}
247 ">" {set listed 3}
248 }
249 set ids [string range $ids 1 end]
250 }
251 set ok 1
252 foreach id $ids {
253 if {[string length $id] != 40} {
254 set ok 0
255 break
256 }
257 }
258 }
259 if {!$ok} {
260 set shortcmit $cmit
261 if {[string length $shortcmit] > 80} {
262 set shortcmit "[string range $shortcmit 0 80]..."
263 }
264 error_popup "Can't parse git log output: {$shortcmit}"
265 exit 1
266 }
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)
275 }
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
284 }
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
290 }
291 if {![info exists ordertok($view,$p)]} {
292 set ordertok($view,$p) "$otok[strrep $i]]"
293 set idpending($view,$p) 1
294 }
295 incr i
296 }
297 }
298 } else {
299 set olds {}
300 }
301 if {![info exists children($view,$id)]} {
302 set children($view,$id) {}
303 }
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
315 }
316 if {[info exists commitinterest($id)]} {
317 foreach script $commitinterest($id) {
318 eval [string map [list "%I" $id] $script]
319 }
320 unset commitinterest($id)
321 }
322 set gotsome 1
323 }
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
338 }
339 if {$r > 0.2} {
340 set l [expr {$r - 0.2}]
341 }
342 } else {
343 set l [expr {$l - $inc}]
344 if {$l <= 0.0} {
345 set l 0.0
346 set progressdirn 1
347 }
348 set r [expr {$l + 0.2}]
349 }
350 set progresscoords [list $l $r]
351 adjustprogress
352 }
353 }
354 return 2
355}
356
357proc chewcommits {view} {
358 global curview hlview viewcomplete
359 global selectedline pending_select
360
361 if {$view == $curview} {
362 layoutmore
363 if {$viewcomplete($view)} {
364 global displayorder commitidx phase
365 global numcommits startmsecs
366
367 if {[info exists pending_select]} {
368 set row [first_real_row]
369 selectline $row 1
370 }
371 if {$commitidx($curview) > 0} {
372 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
373 #puts "overall $ms ms for $numcommits commits"
374 } else {
375 show_status "No commits selected"
376 }
377 notbusy layout
378 set phase {}
379 }
380 }
381 if {[info exists hlview] && $view == $hlview} {
382 vhighlightmore
383 }
384 return 0
385}
386
387proc readcommit {id} {
388 if {[catch {set contents [exec git cat-file commit $id]}]} return
389 parsecommit $id $contents 0
390}
391
392proc updatecommits {} {
393 global viewdata curview phase displayorder ordertok idpending
394 global children commitrow selectedline thickerline showneartags
395
396 if {$phase ne {}} {
397 stop_rev_list
398 set phase {}
399 }
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)}
405 }
406 foreach vid [array names idpending "$n,*"] {
407 unset idpending($vid)
408 }
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
417 }
418 showview $n
419}
420
421proc parsecommit {id contents listed} {
422 global commitinfo cdate
423
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]
435 }
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]
446 }
447 }
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]
454 }
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]]
459 }
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"
468 }
469 set comment $newcomment
470 }
471 if {$comdate != {}} {
472 set cdate($id) $comdate
473 }
474 set commitinfo($id) [list $headline $auname $audate \
475 $comname $comdate $comment]
476}
477
478proc getcommit {id} {
479 global commitdata commitinfo
480
481 if {[info exists commitdata($id)]} {
482 parsecommit $id $commitdata($id) 1
483 } else {
484 readcommit $id
485 if {![info exists commitinfo($id)]} {
486 set commitinfo($id) {"No commit information available"}
487 }
488 }
489 return 1
490}
491
492proc readrefs {} {
493 global tagids idtags headids idheads tagobjid
494 global otherrefids idotherrefs mainhead mainheadid
495
496 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
497 catch {unset $v}
498 }
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
510 }
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
523 }
524 set tagids($name) $id
525 lappend idtags($id) $name
526 } else {
527 set otherrefids($name) $id
528 lappend idotherrefs($id) $name
529 }
530 }
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)
540 }
541 }
542 }
543}
544
545# skip over fake commits
546proc first_real_row {} {
547 global nullid nullid2 displayorder numcommits
548
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
553 }
554 }
555 return $row
556}
557
558# update things for a head moved to a child of its previous location
559proc movehead {id name} {
560 global headids idheads
561
562 removehead $headids($name) $name
563 set headids($name) $id
564 lappend idheads($id) $name
565}
566
567# update things when a head has been removed
568proc removehead {id name} {
569 global headids idheads
570
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]
577 }
578 }
579 unset headids($name)
580}
581
582proc show_error {w top msg} {
583 message $w.m -text $msg -justify center -aspect 400
584 pack $w.m -side top -fill x -padx 20 -pady 20
585 button $w.ok -text OK -command "destroy $top"
586 pack $w.ok -side bottom -fill x
587 bind $top <Visibility> "grab $top; focus $top"
588 bind $top <Key-Return> "destroy $top"
589 tkwait window $top
590}
591
592proc error_popup msg {
593 set w .error
594 toplevel $w
595 wm transient $w .
596 show_error $w $w $msg
597}
598
599proc confirm_popup msg {
600 global confirm_ok
601 set confirm_ok 0
602 set w .confirm
603 toplevel $w
604 wm transient $w .
605 message $w.m -text $msg -justify center -aspect 400
606 pack $w.m -side top -fill x -padx 20 -pady 20
607 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text Cancel -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
612 tkwait window $w
613 return $confirm_ok
614}
615
616proc makewindow {} {
617 global canv canv2 canv3 linespc charspc ctext cflist
618 global textfont mainfont uifont tabstop
619 global findtype findtypemenu findloc findstring fstring geometry
620 global entries sha1entry sha1string sha1but
621 global diffcontextstring diffcontext
622 global maincursor textcursor curtextcursor
623 global rowctxmenu fakerowmenu mergemax wrapcomment
624 global highlight_files gdttype
625 global searchstring sstring
626 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
627 global headctxmenu progresscanv progressitem progresscoords statusw
628 global fprogitem fprogcoord lastprogupdate progupdatepending
629 global have_tk85
630
631 menu .bar
632 .bar add cascade -label "File" -menu .bar.file
633 .bar configure -font $uifont
634 menu .bar.file
635 .bar.file add command -label "Update" -command updatecommits
636 .bar.file add command -label "Reread references" -command rereadrefs
637 .bar.file add command -label "List references" -command showrefs
638 .bar.file add command -label "Quit" -command doquit
639 .bar.file configure -font $uifont
640 menu .bar.edit
641 .bar add cascade -label "Edit" -menu .bar.edit
642 .bar.edit add command -label "Preferences" -command doprefs
643 .bar.edit configure -font $uifont
644
645 menu .bar.view -font $uifont
646 .bar add cascade -label "View" -menu .bar.view
647 .bar.view add command -label "New view..." -command {newview 0}
648 .bar.view add command -label "Edit view..." -command editview \
649 -state disabled
650 .bar.view add command -label "Delete view" -command delview -state disabled
651 .bar.view add separator
652 .bar.view add radiobutton -label "All files" -command {showview 0} \
653 -variable selectedview -value 0
654
655 menu .bar.help
656 .bar add cascade -label "Help" -menu .bar.help
657 .bar.help add command -label "About gitk" -command about
658 .bar.help add command -label "Key bindings" -command keys
659 .bar.help configure -font $uifont
660 . configure -menu .bar
661
662 # the gui has upper and lower half, parts of a paned window.
663 panedwindow .ctop -orient vertical
664
665 # possibly use assumed geometry
666 if {![info exists geometry(pwsash0)]} {
667 set geometry(topheight) [expr {15 * $linespc}]
668 set geometry(topwidth) [expr {80 * $charspc}]
669 set geometry(botheight) [expr {15 * $linespc}]
670 set geometry(botwidth) [expr {50 * $charspc}]
671 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
672 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
673 }
674
675 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
676 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
677 frame .tf.histframe
678 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
679
680 # create three canvases
681 set cscroll .tf.histframe.csb
682 set canv .tf.histframe.pwclist.canv
683 canvas $canv \
684 -selectbackground $selectbgcolor \
685 -background $bgcolor -bd 0 \
686 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
687 .tf.histframe.pwclist add $canv
688 set canv2 .tf.histframe.pwclist.canv2
689 canvas $canv2 \
690 -selectbackground $selectbgcolor \
691 -background $bgcolor -bd 0 -yscrollincr $linespc
692 .tf.histframe.pwclist add $canv2
693 set canv3 .tf.histframe.pwclist.canv3
694 canvas $canv3 \
695 -selectbackground $selectbgcolor \
696 -background $bgcolor -bd 0 -yscrollincr $linespc
697 .tf.histframe.pwclist add $canv3
698 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
699 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
700
701 # a scroll bar to rule them
702 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
703 pack $cscroll -side right -fill y
704 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
705 lappend bglist $canv $canv2 $canv3
706 pack .tf.histframe.pwclist -fill both -expand 1 -side left
707
708 # we have two button bars at bottom of top frame. Bar 1
709 frame .tf.bar
710 frame .tf.lbar -height 15
711
712 set sha1entry .tf.bar.sha1
713 set entries $sha1entry
714 set sha1but .tf.bar.sha1label
715 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
716 -command gotocommit -width 8 -font $uifont
717 $sha1but conf -disabledforeground [$sha1but cget -foreground]
718 pack .tf.bar.sha1label -side left
719 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
720 trace add variable sha1string write sha1change
721 pack $sha1entry -side left -pady 2
722
723 image create bitmap bm-left -data {
724 #define left_width 16
725 #define left_height 16
726 static unsigned char left_bits[] = {
727 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
728 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
729 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
730 }
731 image create bitmap bm-right -data {
732 #define right_width 16
733 #define right_height 16
734 static unsigned char right_bits[] = {
735 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
736 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
737 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
738 }
739 button .tf.bar.leftbut -image bm-left -command goback \
740 -state disabled -width 26
741 pack .tf.bar.leftbut -side left -fill y
742 button .tf.bar.rightbut -image bm-right -command goforw \
743 -state disabled -width 26
744 pack .tf.bar.rightbut -side left -fill y
745
746 # Status label and progress bar
747 set statusw .tf.bar.status
748 label $statusw -width 15 -relief sunken -font $uifont
749 pack $statusw -side left -padx 5
750 set h [expr {[font metrics $uifont -linespace] + 2}]
751 set progresscanv .tf.bar.progress
752 canvas $progresscanv -relief sunken -height $h -borderwidth 2
753 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
754 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
755 pack $progresscanv -side right -expand 1 -fill x
756 set progresscoords {0 0}
757 set fprogcoord 0
758 bind $progresscanv <Configure> adjustprogress
759 set lastprogupdate [clock clicks -milliseconds]
760 set progupdatepending 0
761
762 # build up the bottom bar of upper window
763 label .tf.lbar.flabel -text "Find " -font $uifont
764 button .tf.lbar.fnext -text "next" -command dofind -font $uifont
765 button .tf.lbar.fprev -text "prev" -command {dofind 1} -font $uifont
766 label .tf.lbar.flab2 -text " commit " -font $uifont
767 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
768 -side left -fill y
769 set gdttype "containing:"
770 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
771 "containing:" \
772 "touching paths:" \
773 "adding/removing string:"]
774 trace add variable gdttype write gdttype_change
775 $gm conf -font $uifont
776 .tf.lbar.gdttype conf -font $uifont
777 pack .tf.lbar.gdttype -side left -fill y
778
779 set findstring {}
780 set fstring .tf.lbar.findstring
781 lappend entries $fstring
782 entry $fstring -width 30 -font $textfont -textvariable findstring
783 trace add variable findstring write find_change
784 set findtype Exact
785 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
786 findtype Exact IgnCase Regexp]
787 trace add variable findtype write findcom_change
788 .tf.lbar.findtype configure -font $uifont
789 .tf.lbar.findtype.menu configure -font $uifont
790 set findloc "All fields"
791 tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
792 Comments Author Committer
793 trace add variable findloc write find_change
794 .tf.lbar.findloc configure -font $uifont
795 .tf.lbar.findloc.menu configure -font $uifont
796 pack .tf.lbar.findloc -side right
797 pack .tf.lbar.findtype -side right
798 pack $fstring -side left -expand 1 -fill x
799
800 # Finish putting the upper half of the viewer together
801 pack .tf.lbar -in .tf -side bottom -fill x
802 pack .tf.bar -in .tf -side bottom -fill x
803 pack .tf.histframe -fill both -side top -expand 1
804 .ctop add .tf
805 .ctop paneconfigure .tf -height $geometry(topheight)
806 .ctop paneconfigure .tf -width $geometry(topwidth)
807
808 # now build up the bottom
809 panedwindow .pwbottom -orient horizontal
810
811 # lower left, a text box over search bar, scroll bar to the right
812 # if we know window height, then that will set the lower text height, otherwise
813 # we set lower text height which will drive window height
814 if {[info exists geometry(main)]} {
815 frame .bleft -width $geometry(botwidth)
816 } else {
817 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
818 }
819 frame .bleft.top
820 frame .bleft.mid
821
822 button .bleft.top.search -text "Search" -command dosearch \
823 -font $uifont
824 pack .bleft.top.search -side left -padx 5
825 set sstring .bleft.top.sstring
826 entry $sstring -width 20 -font $textfont -textvariable searchstring
827 lappend entries $sstring
828 trace add variable searchstring write incrsearch
829 pack $sstring -side left -expand 1 -fill x
830 radiobutton .bleft.mid.diff -text "Diff" \
831 -command changediffdisp -variable diffelide -value {0 0}
832 radiobutton .bleft.mid.old -text "Old version" \
833 -command changediffdisp -variable diffelide -value {0 1}
834 radiobutton .bleft.mid.new -text "New version" \
835 -command changediffdisp -variable diffelide -value {1 0}
836 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
837 -font $uifont
838 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
839 spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
840 -from 1 -increment 1 -to 10000000 \
841 -validate all -validatecommand "diffcontextvalidate %P" \
842 -textvariable diffcontextstring
843 .bleft.mid.diffcontext set $diffcontext
844 trace add variable diffcontextstring write diffcontextchange
845 lappend entries .bleft.mid.diffcontext
846 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
847 set ctext .bleft.ctext
848 text $ctext -background $bgcolor -foreground $fgcolor \
849 -state disabled -font $textfont \
850 -yscrollcommand scrolltext -wrap none
851 if {$have_tk85} {
852 $ctext conf -tabstyle wordprocessor
853 }
854 scrollbar .bleft.sb -command "$ctext yview"
855 pack .bleft.top -side top -fill x
856 pack .bleft.mid -side top -fill x
857 pack .bleft.sb -side right -fill y
858 pack $ctext -side left -fill both -expand 1
859 lappend bglist $ctext
860 lappend fglist $ctext
861
862 $ctext tag conf comment -wrap $wrapcomment
863 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
864 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
865 $ctext tag conf d0 -fore [lindex $diffcolors 0]
866 $ctext tag conf d1 -fore [lindex $diffcolors 1]
867 $ctext tag conf m0 -fore red
868 $ctext tag conf m1 -fore blue
869 $ctext tag conf m2 -fore green
870 $ctext tag conf m3 -fore purple
871 $ctext tag conf m4 -fore brown
872 $ctext tag conf m5 -fore "#009090"
873 $ctext tag conf m6 -fore magenta
874 $ctext tag conf m7 -fore "#808000"
875 $ctext tag conf m8 -fore "#009000"
876 $ctext tag conf m9 -fore "#ff0080"
877 $ctext tag conf m10 -fore cyan
878 $ctext tag conf m11 -fore "#b07070"
879 $ctext tag conf m12 -fore "#70b0f0"
880 $ctext tag conf m13 -fore "#70f0b0"
881 $ctext tag conf m14 -fore "#f0b070"
882 $ctext tag conf m15 -fore "#ff70b0"
883 $ctext tag conf mmax -fore darkgrey
884 set mergemax 16
885 $ctext tag conf mresult -font [concat $textfont bold]
886 $ctext tag conf msep -font [concat $textfont bold]
887 $ctext tag conf found -back yellow
888
889 .pwbottom add .bleft
890 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
891
892 # lower right
893 frame .bright
894 frame .bright.mode
895 radiobutton .bright.mode.patch -text "Patch" \
896 -command reselectline -variable cmitmode -value "patch"
897 .bright.mode.patch configure -font $uifont
898 radiobutton .bright.mode.tree -text "Tree" \
899 -command reselectline -variable cmitmode -value "tree"
900 .bright.mode.tree configure -font $uifont
901 grid .bright.mode.patch .bright.mode.tree -sticky ew
902 pack .bright.mode -side top -fill x
903 set cflist .bright.cfiles
904 set indent [font measure $mainfont "nn"]
905 text $cflist \
906 -selectbackground $selectbgcolor \
907 -background $bgcolor -foreground $fgcolor \
908 -font $mainfont \
909 -tabs [list $indent [expr {2 * $indent}]] \
910 -yscrollcommand ".bright.sb set" \
911 -cursor [. cget -cursor] \
912 -spacing1 1 -spacing3 1
913 lappend bglist $cflist
914 lappend fglist $cflist
915 scrollbar .bright.sb -command "$cflist yview"
916 pack .bright.sb -side right -fill y
917 pack $cflist -side left -fill both -expand 1
918 $cflist tag configure highlight \
919 -background [$cflist cget -selectbackground]
920 $cflist tag configure bold -font [concat $mainfont bold]
921
922 .pwbottom add .bright
923 .ctop add .pwbottom
924
925 # restore window position if known
926 if {[info exists geometry(main)]} {
927 wm geometry . "$geometry(main)"
928 }
929
930 if {[tk windowingsystem] eq {aqua}} {
931 set M1B M1
932 } else {
933 set M1B Control
934 }
935
936 bind .pwbottom <Configure> {resizecdetpanes %W %w}
937 pack .ctop -fill both -expand 1
938 bindall <1> {selcanvline %W %x %y}
939 #bindall <B1-Motion> {selcanvline %W %x %y}
940 if {[tk windowingsystem] == "win32"} {
941 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
942 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
943 } else {
944 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
945 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
946 }
947 bindall <2> "canvscan mark %W %x %y"
948 bindall <B2-Motion> "canvscan dragto %W %x %y"
949 bindkey <Home> selfirstline
950 bindkey <End> sellastline
951 bind . <Key-Up> "selnextline -1"
952 bind . <Key-Down> "selnextline 1"
953 bindkey <Key-Right> "goforw"
954 bindkey <Key-Left> "goback"
955 bind . <Key-Prior> "selnextpage -1"
956 bind . <Key-Next> "selnextpage 1"
957 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
958 bind . <$M1B-End> "allcanvs yview moveto 1.0"
959 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
960 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
961 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
962 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
963 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
964 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
965 bindkey <Key-space> "$ctext yview scroll 1 pages"
966 bindkey p "selnextline -1"
967 bindkey n "selnextline 1"
968 bindkey z "goback"
969 bindkey x "goforw"
970 bindkey i "selnextline -1"
971 bindkey k "selnextline 1"
972 bindkey j "goback"
973 bindkey l "goforw"
974 bindkey b "$ctext yview scroll -1 pages"
975 bindkey d "$ctext yview scroll 18 units"
976 bindkey u "$ctext yview scroll -18 units"
977 bindkey / {findnext 1}
978 bindkey <Key-Return> {findnext 0}
979 bindkey ? findprev
980 bindkey f nextfile
981 bindkey <F5> updatecommits
982 bind . <$M1B-q> doquit
983 bind . <$M1B-f> dofind
984 bind . <$M1B-g> {findnext 0}
985 bind . <$M1B-r> dosearchback
986 bind . <$M1B-s> dosearch
987 bind . <$M1B-equal> {incrfont 1}
988 bind . <$M1B-KP_Add> {incrfont 1}
989 bind . <$M1B-minus> {incrfont -1}
990 bind . <$M1B-KP_Subtract> {incrfont -1}
991 wm protocol . WM_DELETE_WINDOW doquit
992 bind . <Button-1> "click %W"
993 bind $fstring <Key-Return> dofind
994 bind $sha1entry <Key-Return> gotocommit
995 bind $sha1entry <<PasteSelection>> clearsha1
996 bind $cflist <1> {sel_flist %W %x %y; break}
997 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
998 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
999 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1000
1001 set maincursor [. cget -cursor]
1002 set textcursor [$ctext cget -cursor]
1003 set curtextcursor $textcursor
1004
1005 set rowctxmenu .rowctxmenu
1006 menu $rowctxmenu -tearoff 0
1007 $rowctxmenu add command -label "Diff this -> selected" \
1008 -command {diffvssel 0}
1009 $rowctxmenu add command -label "Diff selected -> this" \
1010 -command {diffvssel 1}
1011 $rowctxmenu add command -label "Make patch" -command mkpatch
1012 $rowctxmenu add command -label "Create tag" -command mktag
1013 $rowctxmenu add command -label "Write commit to file" -command writecommit
1014 $rowctxmenu add command -label "Create new branch" -command mkbranch
1015 $rowctxmenu add command -label "Cherry-pick this commit" \
1016 -command cherrypick
1017 $rowctxmenu add command -label "Reset HEAD branch to here" \
1018 -command resethead
1019
1020 set fakerowmenu .fakerowmenu
1021 menu $fakerowmenu -tearoff 0
1022 $fakerowmenu add command -label "Diff this -> selected" \
1023 -command {diffvssel 0}
1024 $fakerowmenu add command -label "Diff selected -> this" \
1025 -command {diffvssel 1}
1026 $fakerowmenu add command -label "Make patch" -command mkpatch
1027# $fakerowmenu add command -label "Commit" -command {mkcommit 0}
1028# $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
1029# $fakerowmenu add command -label "Revert local changes" -command revertlocal
1030
1031 set headctxmenu .headctxmenu
1032 menu $headctxmenu -tearoff 0
1033 $headctxmenu add command -label "Check out this branch" \
1034 -command cobranch
1035 $headctxmenu add command -label "Remove this branch" \
1036 -command rmbranch
1037
1038 global flist_menu
1039 set flist_menu .flistctxmenu
1040 menu $flist_menu -tearoff 0
1041 $flist_menu add command -label "Highlight this too" \
1042 -command {flist_hl 0}
1043 $flist_menu add command -label "Highlight this only" \
1044 -command {flist_hl 1}
1045}
1046
1047# Windows sends all mouse wheel events to the current focused window, not
1048# the one where the mouse hovers, so bind those events here and redirect
1049# to the correct window
1050proc windows_mousewheel_redirector {W X Y D} {
1051 global canv canv2 canv3
1052 set w [winfo containing -displayof $W $X $Y]
1053 if {$w ne ""} {
1054 set u [expr {$D < 0 ? 5 : -5}]
1055 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1056 allcanvs yview scroll $u units
1057 } else {
1058 catch {
1059 $w yview scroll $u units
1060 }
1061 }
1062 }
1063}
1064
1065# mouse-2 makes all windows scan vertically, but only the one
1066# the cursor is in scans horizontally
1067proc canvscan {op w x y} {
1068 global canv canv2 canv3
1069 foreach c [list $canv $canv2 $canv3] {
1070 if {$c == $w} {
1071 $c scan $op $x $y
1072 } else {
1073 $c scan $op 0 $y
1074 }
1075 }
1076}
1077
1078proc scrollcanv {cscroll f0 f1} {
1079 $cscroll set $f0 $f1
1080 drawfrac $f0 $f1
1081 flushhighlights
1082}
1083
1084# when we make a key binding for the toplevel, make sure
1085# it doesn't get triggered when that key is pressed in the
1086# find string entry widget.
1087proc bindkey {ev script} {
1088 global entries
1089 bind . $ev $script
1090 set escript [bind Entry $ev]
1091 if {$escript == {}} {
1092 set escript [bind Entry <Key>]
1093 }
1094 foreach e $entries {
1095 bind $e $ev "$escript; break"
1096 }
1097}
1098
1099# set the focus back to the toplevel for any click outside
1100# the entry widgets
1101proc click {w} {
1102 global ctext entries
1103 foreach e [concat $entries $ctext] {
1104 if {$w == $e} return
1105 }
1106 focus .
1107}
1108
1109# Adjust the progress bar for a change in requested extent or canvas size
1110proc adjustprogress {} {
1111 global progresscanv progressitem progresscoords
1112 global fprogitem fprogcoord lastprogupdate progupdatepending
1113
1114 set w [expr {[winfo width $progresscanv] - 4}]
1115 set x0 [expr {$w * [lindex $progresscoords 0]}]
1116 set x1 [expr {$w * [lindex $progresscoords 1]}]
1117 set h [winfo height $progresscanv]
1118 $progresscanv coords $progressitem $x0 0 $x1 $h
1119 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1120 set now [clock clicks -milliseconds]
1121 if {$now >= $lastprogupdate + 100} {
1122 set progupdatepending 0
1123 update
1124 } elseif {!$progupdatepending} {
1125 set progupdatepending 1
1126 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1127 }
1128}
1129
1130proc doprogupdate {} {
1131 global lastprogupdate progupdatepending
1132
1133 if {$progupdatepending} {
1134 set progupdatepending 0
1135 set lastprogupdate [clock clicks -milliseconds]
1136 update
1137 }
1138}
1139
1140proc savestuff {w} {
1141 global canv canv2 canv3 mainfont textfont uifont tabstop
1142 global stuffsaved findmergefiles maxgraphpct
1143 global maxwidth showneartags showlocalchanges
1144 global viewname viewfiles viewargs viewperm nextviewnum
1145 global cmitmode wrapcomment datetimeformat
1146 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1147
1148 if {$stuffsaved} return
1149 if {![winfo viewable .]} return
1150 catch {
1151 set f [open "~/.gitk-new" w]
1152 puts $f [list set mainfont $mainfont]
1153 puts $f [list set textfont $textfont]
1154 puts $f [list set uifont $uifont]
1155 puts $f [list set tabstop $tabstop]
1156 puts $f [list set findmergefiles $findmergefiles]
1157 puts $f [list set maxgraphpct $maxgraphpct]
1158 puts $f [list set maxwidth $maxwidth]
1159 puts $f [list set cmitmode $cmitmode]
1160 puts $f [list set wrapcomment $wrapcomment]
1161 puts $f [list set showneartags $showneartags]
1162 puts $f [list set showlocalchanges $showlocalchanges]
1163 puts $f [list set datetimeformat $datetimeformat]
1164 puts $f [list set bgcolor $bgcolor]
1165 puts $f [list set fgcolor $fgcolor]
1166 puts $f [list set colors $colors]
1167 puts $f [list set diffcolors $diffcolors]
1168 puts $f [list set diffcontext $diffcontext]
1169 puts $f [list set selectbgcolor $selectbgcolor]
1170
1171 puts $f "set geometry(main) [wm geometry .]"
1172 puts $f "set geometry(topwidth) [winfo width .tf]"
1173 puts $f "set geometry(topheight) [winfo height .tf]"
1174 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1175 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1176 puts $f "set geometry(botwidth) [winfo width .bleft]"
1177 puts $f "set geometry(botheight) [winfo height .bleft]"
1178
1179 puts -nonewline $f "set permviews {"
1180 for {set v 0} {$v < $nextviewnum} {incr v} {
1181 if {$viewperm($v)} {
1182 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1183 }
1184 }
1185 puts $f "}"
1186 close $f
1187 file rename -force "~/.gitk-new" "~/.gitk"
1188 }
1189 set stuffsaved 1
1190}
1191
1192proc resizeclistpanes {win w} {
1193 global oldwidth
1194 if {[info exists oldwidth($win)]} {
1195 set s0 [$win sash coord 0]
1196 set s1 [$win sash coord 1]
1197 if {$w < 60} {
1198 set sash0 [expr {int($w/2 - 2)}]
1199 set sash1 [expr {int($w*5/6 - 2)}]
1200 } else {
1201 set factor [expr {1.0 * $w / $oldwidth($win)}]
1202 set sash0 [expr {int($factor * [lindex $s0 0])}]
1203 set sash1 [expr {int($factor * [lindex $s1 0])}]
1204 if {$sash0 < 30} {
1205 set sash0 30
1206 }
1207 if {$sash1 < $sash0 + 20} {
1208 set sash1 [expr {$sash0 + 20}]
1209 }
1210 if {$sash1 > $w - 10} {
1211 set sash1 [expr {$w - 10}]
1212 if {$sash0 > $sash1 - 20} {
1213 set sash0 [expr {$sash1 - 20}]
1214 }
1215 }
1216 }
1217 $win sash place 0 $sash0 [lindex $s0 1]
1218 $win sash place 1 $sash1 [lindex $s1 1]
1219 }
1220 set oldwidth($win) $w
1221}
1222
1223proc resizecdetpanes {win w} {
1224 global oldwidth
1225 if {[info exists oldwidth($win)]} {
1226 set s0 [$win sash coord 0]
1227 if {$w < 60} {
1228 set sash0 [expr {int($w*3/4 - 2)}]
1229 } else {
1230 set factor [expr {1.0 * $w / $oldwidth($win)}]
1231 set sash0 [expr {int($factor * [lindex $s0 0])}]
1232 if {$sash0 < 45} {
1233 set sash0 45
1234 }
1235 if {$sash0 > $w - 15} {
1236 set sash0 [expr {$w - 15}]
1237 }
1238 }
1239 $win sash place 0 $sash0 [lindex $s0 1]
1240 }
1241 set oldwidth($win) $w
1242}
1243
1244proc allcanvs args {
1245 global canv canv2 canv3
1246 eval $canv $args
1247 eval $canv2 $args
1248 eval $canv3 $args
1249}
1250
1251proc bindall {event action} {
1252 global canv canv2 canv3
1253 bind $canv $event $action
1254 bind $canv2 $event $action
1255 bind $canv3 $event $action
1256}
1257
1258proc about {} {
1259 global uifont
1260 set w .about
1261 if {[winfo exists $w]} {
1262 raise $w
1263 return
1264 }
1265 toplevel $w
1266 wm title $w "About gitk"
1267 message $w.m -text {
1268Gitk - a commit viewer for git
1269
1270Copyright © 2005-2006 Paul Mackerras
1271
1272Use and redistribute under the terms of the GNU General Public License} \
1273 -justify center -aspect 400 -border 2 -bg white -relief groove
1274 pack $w.m -side top -fill x -padx 2 -pady 2
1275 $w.m configure -font $uifont
1276 button $w.ok -text Close -command "destroy $w" -default active
1277 pack $w.ok -side bottom
1278 $w.ok configure -font $uifont
1279 bind $w <Visibility> "focus $w.ok"
1280 bind $w <Key-Escape> "destroy $w"
1281 bind $w <Key-Return> "destroy $w"
1282}
1283
1284proc keys {} {
1285 global uifont
1286 set w .keys
1287 if {[winfo exists $w]} {
1288 raise $w
1289 return
1290 }
1291 if {[tk windowingsystem] eq {aqua}} {
1292 set M1T Cmd
1293 } else {
1294 set M1T Ctrl
1295 }
1296 toplevel $w
1297 wm title $w "Gitk key bindings"
1298 message $w.m -text "
1299Gitk key bindings:
1300
1301<$M1T-Q> Quit
1302<Home> Move to first commit
1303<End> Move to last commit
1304<Up>, p, i Move up one commit
1305<Down>, n, k Move down one commit
1306<Left>, z, j Go back in history list
1307<Right>, x, l Go forward in history list
1308<PageUp> Move up one page in commit list
1309<PageDown> Move down one page in commit list
1310<$M1T-Home> Scroll to top of commit list
1311<$M1T-End> Scroll to bottom of commit list
1312<$M1T-Up> Scroll commit list up one line
1313<$M1T-Down> Scroll commit list down one line
1314<$M1T-PageUp> Scroll commit list up one page
1315<$M1T-PageDown> Scroll commit list down one page
1316<Shift-Up> Move to previous highlighted line
1317<Shift-Down> Move to next highlighted line
1318<Delete>, b Scroll diff view up one page
1319<Backspace> Scroll diff view up one page
1320<Space> Scroll diff view down one page
1321u Scroll diff view up 18 lines
1322d Scroll diff view down 18 lines
1323<$M1T-F> Find
1324<$M1T-G> Move to next find hit
1325<Return> Move to next find hit
1326/ Move to next find hit, or redo find
1327? Move to previous find hit
1328f Scroll diff view to next file
1329<$M1T-S> Search for next hit in diff view
1330<$M1T-R> Search for previous hit in diff view
1331<$M1T-KP+> Increase font size
1332<$M1T-plus> Increase font size
1333<$M1T-KP-> Decrease font size
1334<$M1T-minus> Decrease font size
1335<F5> Update
1336" \
1337 -justify left -bg white -border 2 -relief groove
1338 pack $w.m -side top -fill both -padx 2 -pady 2
1339 $w.m configure -font $uifont
1340 button $w.ok -text Close -command "destroy $w" -default active
1341 pack $w.ok -side bottom
1342 $w.ok configure -font $uifont
1343 bind $w <Visibility> "focus $w.ok"
1344 bind $w <Key-Escape> "destroy $w"
1345 bind $w <Key-Return> "destroy $w"
1346}
1347
1348# Procedures for manipulating the file list window at the
1349# bottom right of the overall window.
1350
1351proc treeview {w l openlevs} {
1352 global treecontents treediropen treeheight treeparent treeindex
1353
1354 set ix 0
1355 set treeindex() 0
1356 set lev 0
1357 set prefix {}
1358 set prefixend -1
1359 set prefendstack {}
1360 set htstack {}
1361 set ht 0
1362 set treecontents() {}
1363 $w conf -state normal
1364 foreach f $l {
1365 while {[string range $f 0 $prefixend] ne $prefix} {
1366 if {$lev <= $openlevs} {
1367 $w mark set e:$treeindex($prefix) "end -1c"
1368 $w mark gravity e:$treeindex($prefix) left
1369 }
1370 set treeheight($prefix) $ht
1371 incr ht [lindex $htstack end]
1372 set htstack [lreplace $htstack end end]
1373 set prefixend [lindex $prefendstack end]
1374 set prefendstack [lreplace $prefendstack end end]
1375 set prefix [string range $prefix 0 $prefixend]
1376 incr lev -1
1377 }
1378 set tail [string range $f [expr {$prefixend+1}] end]
1379 while {[set slash [string first "/" $tail]] >= 0} {
1380 lappend htstack $ht
1381 set ht 0
1382 lappend prefendstack $prefixend
1383 incr prefixend [expr {$slash + 1}]
1384 set d [string range $tail 0 $slash]
1385 lappend treecontents($prefix) $d
1386 set oldprefix $prefix
1387 append prefix $d
1388 set treecontents($prefix) {}
1389 set treeindex($prefix) [incr ix]
1390 set treeparent($prefix) $oldprefix
1391 set tail [string range $tail [expr {$slash+1}] end]
1392 if {$lev <= $openlevs} {
1393 set ht 1
1394 set treediropen($prefix) [expr {$lev < $openlevs}]
1395 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1396 $w mark set d:$ix "end -1c"
1397 $w mark gravity d:$ix left
1398 set str "\n"
1399 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1400 $w insert end $str
1401 $w image create end -align center -image $bm -padx 1 \
1402 -name a:$ix
1403 $w insert end $d [highlight_tag $prefix]
1404 $w mark set s:$ix "end -1c"
1405 $w mark gravity s:$ix left
1406 }
1407 incr lev
1408 }
1409 if {$tail ne {}} {
1410 if {$lev <= $openlevs} {
1411 incr ht
1412 set str "\n"
1413 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1414 $w insert end $str
1415 $w insert end $tail [highlight_tag $f]
1416 }
1417 lappend treecontents($prefix) $tail
1418 }
1419 }
1420 while {$htstack ne {}} {
1421 set treeheight($prefix) $ht
1422 incr ht [lindex $htstack end]
1423 set htstack [lreplace $htstack end end]
1424 set prefixend [lindex $prefendstack end]
1425 set prefendstack [lreplace $prefendstack end end]
1426 set prefix [string range $prefix 0 $prefixend]
1427 }
1428 $w conf -state disabled
1429}
1430
1431proc linetoelt {l} {
1432 global treeheight treecontents
1433
1434 set y 2
1435 set prefix {}
1436 while {1} {
1437 foreach e $treecontents($prefix) {
1438 if {$y == $l} {
1439 return "$prefix$e"
1440 }
1441 set n 1
1442 if {[string index $e end] eq "/"} {
1443 set n $treeheight($prefix$e)
1444 if {$y + $n > $l} {
1445 append prefix $e
1446 incr y
1447 break
1448 }
1449 }
1450 incr y $n
1451 }
1452 }
1453}
1454
1455proc highlight_tree {y prefix} {
1456 global treeheight treecontents cflist
1457
1458 foreach e $treecontents($prefix) {
1459 set path $prefix$e
1460 if {[highlight_tag $path] ne {}} {
1461 $cflist tag add bold $y.0 "$y.0 lineend"
1462 }
1463 incr y
1464 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1465 set y [highlight_tree $y $path]
1466 }
1467 }
1468 return $y
1469}
1470
1471proc treeclosedir {w dir} {
1472 global treediropen treeheight treeparent treeindex
1473
1474 set ix $treeindex($dir)
1475 $w conf -state normal
1476 $w delete s:$ix e:$ix
1477 set treediropen($dir) 0
1478 $w image configure a:$ix -image tri-rt
1479 $w conf -state disabled
1480 set n [expr {1 - $treeheight($dir)}]
1481 while {$dir ne {}} {
1482 incr treeheight($dir) $n
1483 set dir $treeparent($dir)
1484 }
1485}
1486
1487proc treeopendir {w dir} {
1488 global treediropen treeheight treeparent treecontents treeindex
1489
1490 set ix $treeindex($dir)
1491 $w conf -state normal
1492 $w image configure a:$ix -image tri-dn
1493 $w mark set e:$ix s:$ix
1494 $w mark gravity e:$ix right
1495 set lev 0
1496 set str "\n"
1497 set n [llength $treecontents($dir)]
1498 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1499 incr lev
1500 append str "\t"
1501 incr treeheight($x) $n
1502 }
1503 foreach e $treecontents($dir) {
1504 set de $dir$e
1505 if {[string index $e end] eq "/"} {
1506 set iy $treeindex($de)
1507 $w mark set d:$iy e:$ix
1508 $w mark gravity d:$iy left
1509 $w insert e:$ix $str
1510 set treediropen($de) 0
1511 $w image create e:$ix -align center -image tri-rt -padx 1 \
1512 -name a:$iy
1513 $w insert e:$ix $e [highlight_tag $de]
1514 $w mark set s:$iy e:$ix
1515 $w mark gravity s:$iy left
1516 set treeheight($de) 1
1517 } else {
1518 $w insert e:$ix $str
1519 $w insert e:$ix $e [highlight_tag $de]
1520 }
1521 }
1522 $w mark gravity e:$ix left
1523 $w conf -state disabled
1524 set treediropen($dir) 1
1525 set top [lindex [split [$w index @0,0] .] 0]
1526 set ht [$w cget -height]
1527 set l [lindex [split [$w index s:$ix] .] 0]
1528 if {$l < $top} {
1529 $w yview $l.0
1530 } elseif {$l + $n + 1 > $top + $ht} {
1531 set top [expr {$l + $n + 2 - $ht}]
1532 if {$l < $top} {
1533 set top $l
1534 }
1535 $w yview $top.0
1536 }
1537}
1538
1539proc treeclick {w x y} {
1540 global treediropen cmitmode ctext cflist cflist_top
1541
1542 if {$cmitmode ne "tree"} return
1543 if {![info exists cflist_top]} return
1544 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1545 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1546 $cflist tag add highlight $l.0 "$l.0 lineend"
1547 set cflist_top $l
1548 if {$l == 1} {
1549 $ctext yview 1.0
1550 return
1551 }
1552 set e [linetoelt $l]
1553 if {[string index $e end] ne "/"} {
1554 showfile $e
1555 } elseif {$treediropen($e)} {
1556 treeclosedir $w $e
1557 } else {
1558 treeopendir $w $e
1559 }
1560}
1561
1562proc setfilelist {id} {
1563 global treefilelist cflist
1564
1565 treeview $cflist $treefilelist($id) 0
1566}
1567
1568image create bitmap tri-rt -background black -foreground blue -data {
1569 #define tri-rt_width 13
1570 #define tri-rt_height 13
1571 static unsigned char tri-rt_bits[] = {
1572 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1573 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1574 0x00, 0x00};
1575} -maskdata {
1576 #define tri-rt-mask_width 13
1577 #define tri-rt-mask_height 13
1578 static unsigned char tri-rt-mask_bits[] = {
1579 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1580 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1581 0x08, 0x00};
1582}
1583image create bitmap tri-dn -background black -foreground blue -data {
1584 #define tri-dn_width 13
1585 #define tri-dn_height 13
1586 static unsigned char tri-dn_bits[] = {
1587 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1588 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1589 0x00, 0x00};
1590} -maskdata {
1591 #define tri-dn-mask_width 13
1592 #define tri-dn-mask_height 13
1593 static unsigned char tri-dn-mask_bits[] = {
1594 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1595 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1596 0x00, 0x00};
1597}
1598
1599image create bitmap reficon-T -background black -foreground yellow -data {
1600 #define tagicon_width 13
1601 #define tagicon_height 9
1602 static unsigned char tagicon_bits[] = {
1603 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1604 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1605} -maskdata {
1606 #define tagicon-mask_width 13
1607 #define tagicon-mask_height 9
1608 static unsigned char tagicon-mask_bits[] = {
1609 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1610 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1611}
1612set rectdata {
1613 #define headicon_width 13
1614 #define headicon_height 9
1615 static unsigned char headicon_bits[] = {
1616 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1617 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1618}
1619set rectmask {
1620 #define headicon-mask_width 13
1621 #define headicon-mask_height 9
1622 static unsigned char headicon-mask_bits[] = {
1623 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1624 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1625}
1626image create bitmap reficon-H -background black -foreground green \
1627 -data $rectdata -maskdata $rectmask
1628image create bitmap reficon-o -background black -foreground "#ddddff" \
1629 -data $rectdata -maskdata $rectmask
1630
1631proc init_flist {first} {
1632 global cflist cflist_top selectedline difffilestart
1633
1634 $cflist conf -state normal
1635 $cflist delete 0.0 end
1636 if {$first ne {}} {
1637 $cflist insert end $first
1638 set cflist_top 1
1639 $cflist tag add highlight 1.0 "1.0 lineend"
1640 } else {
1641 catch {unset cflist_top}
1642 }
1643 $cflist conf -state disabled
1644 set difffilestart {}
1645}
1646
1647proc highlight_tag {f} {
1648 global highlight_paths
1649
1650 foreach p $highlight_paths {
1651 if {[string match $p $f]} {
1652 return "bold"
1653 }
1654 }
1655 return {}
1656}
1657
1658proc highlight_filelist {} {
1659 global cmitmode cflist
1660
1661 $cflist conf -state normal
1662 if {$cmitmode ne "tree"} {
1663 set end [lindex [split [$cflist index end] .] 0]
1664 for {set l 2} {$l < $end} {incr l} {
1665 set line [$cflist get $l.0 "$l.0 lineend"]
1666 if {[highlight_tag $line] ne {}} {
1667 $cflist tag add bold $l.0 "$l.0 lineend"
1668 }
1669 }
1670 } else {
1671 highlight_tree 2 {}
1672 }
1673 $cflist conf -state disabled
1674}
1675
1676proc unhighlight_filelist {} {
1677 global cflist
1678
1679 $cflist conf -state normal
1680 $cflist tag remove bold 1.0 end
1681 $cflist conf -state disabled
1682}
1683
1684proc add_flist {fl} {
1685 global cflist
1686
1687 $cflist conf -state normal
1688 foreach f $fl {
1689 $cflist insert end "\n"
1690 $cflist insert end $f [highlight_tag $f]
1691 }
1692 $cflist conf -state disabled
1693}
1694
1695proc sel_flist {w x y} {
1696 global ctext difffilestart cflist cflist_top cmitmode
1697
1698 if {$cmitmode eq "tree"} return
1699 if {![info exists cflist_top]} return
1700 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1701 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1702 $cflist tag add highlight $l.0 "$l.0 lineend"
1703 set cflist_top $l
1704 if {$l == 1} {
1705 $ctext yview 1.0
1706 } else {
1707 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1708 }
1709}
1710
1711proc pop_flist_menu {w X Y x y} {
1712 global ctext cflist cmitmode flist_menu flist_menu_file
1713 global treediffs diffids
1714
1715 stopfinding
1716 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1717 if {$l <= 1} return
1718 if {$cmitmode eq "tree"} {
1719 set e [linetoelt $l]
1720 if {[string index $e end] eq "/"} return
1721 } else {
1722 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1723 }
1724 set flist_menu_file $e
1725 tk_popup $flist_menu $X $Y
1726}
1727
1728proc flist_hl {only} {
1729 global flist_menu_file findstring gdttype
1730
1731 set x [shellquote $flist_menu_file]
1732 if {$only || $findstring eq {} || $gdttype ne "touching paths:"} {
1733 set findstring $x
1734 } else {
1735 append findstring " " $x
1736 }
1737 set gdttype "touching paths:"
1738}
1739
1740# Functions for adding and removing shell-type quoting
1741
1742proc shellquote {str} {
1743 if {![string match "*\['\"\\ \t]*" $str]} {
1744 return $str
1745 }
1746 if {![string match "*\['\"\\]*" $str]} {
1747 return "\"$str\""
1748 }
1749 if {![string match "*'*" $str]} {
1750 return "'$str'"
1751 }
1752 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1753}
1754
1755proc shellarglist {l} {
1756 set str {}
1757 foreach a $l {
1758 if {$str ne {}} {
1759 append str " "
1760 }
1761 append str [shellquote $a]
1762 }
1763 return $str
1764}
1765
1766proc shelldequote {str} {
1767 set ret {}
1768 set used -1
1769 while {1} {
1770 incr used
1771 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1772 append ret [string range $str $used end]
1773 set used [string length $str]
1774 break
1775 }
1776 set first [lindex $first 0]
1777 set ch [string index $str $first]
1778 if {$first > $used} {
1779 append ret [string range $str $used [expr {$first - 1}]]
1780 set used $first
1781 }
1782 if {$ch eq " " || $ch eq "\t"} break
1783 incr used
1784 if {$ch eq "'"} {
1785 set first [string first "'" $str $used]
1786 if {$first < 0} {
1787 error "unmatched single-quote"
1788 }
1789 append ret [string range $str $used [expr {$first - 1}]]
1790 set used $first
1791 continue
1792 }
1793 if {$ch eq "\\"} {
1794 if {$used >= [string length $str]} {
1795 error "trailing backslash"
1796 }
1797 append ret [string index $str $used]
1798 continue
1799 }
1800 # here ch == "\""
1801 while {1} {
1802 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1803 error "unmatched double-quote"
1804 }
1805 set first [lindex $first 0]
1806 set ch [string index $str $first]
1807 if {$first > $used} {
1808 append ret [string range $str $used [expr {$first - 1}]]
1809 set used $first
1810 }
1811 if {$ch eq "\""} break
1812 incr used
1813 append ret [string index $str $used]
1814 incr used
1815 }
1816 }
1817 return [list $used $ret]
1818}
1819
1820proc shellsplit {str} {
1821 set l {}
1822 while {1} {
1823 set str [string trimleft $str]
1824 if {$str eq {}} break
1825 set dq [shelldequote $str]
1826 set n [lindex $dq 0]
1827 set word [lindex $dq 1]
1828 set str [string range $str $n end]
1829 lappend l $word
1830 }
1831 return $l
1832}
1833
1834# Code to implement multiple views
1835
1836proc newview {ishighlight} {
1837 global nextviewnum newviewname newviewperm uifont newishighlight
1838 global newviewargs revtreeargs
1839
1840 set newishighlight $ishighlight
1841 set top .gitkview
1842 if {[winfo exists $top]} {
1843 raise $top
1844 return
1845 }
1846 set newviewname($nextviewnum) "View $nextviewnum"
1847 set newviewperm($nextviewnum) 0
1848 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1849 vieweditor $top $nextviewnum "Gitk view definition"
1850}
1851
1852proc editview {} {
1853 global curview
1854 global viewname viewperm newviewname newviewperm
1855 global viewargs newviewargs
1856
1857 set top .gitkvedit-$curview
1858 if {[winfo exists $top]} {
1859 raise $top
1860 return
1861 }
1862 set newviewname($curview) $viewname($curview)
1863 set newviewperm($curview) $viewperm($curview)
1864 set newviewargs($curview) [shellarglist $viewargs($curview)]
1865 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1866}
1867
1868proc vieweditor {top n title} {
1869 global newviewname newviewperm viewfiles
1870 global uifont
1871
1872 toplevel $top
1873 wm title $top $title
1874 label $top.nl -text "Name" -font $uifont
1875 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1876 grid $top.nl $top.name -sticky w -pady 5
1877 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1878 -font $uifont
1879 grid $top.perm - -pady 5 -sticky w
1880 message $top.al -aspect 1000 -font $uifont \
1881 -text "Commits to include (arguments to git rev-list):"
1882 grid $top.al - -sticky w -pady 5
1883 entry $top.args -width 50 -textvariable newviewargs($n) \
1884 -background white -font $uifont
1885 grid $top.args - -sticky ew -padx 5
1886 message $top.l -aspect 1000 -font $uifont \
1887 -text "Enter files and directories to include, one per line:"
1888 grid $top.l - -sticky w
1889 text $top.t -width 40 -height 10 -background white -font $uifont
1890 if {[info exists viewfiles($n)]} {
1891 foreach f $viewfiles($n) {
1892 $top.t insert end $f
1893 $top.t insert end "\n"
1894 }
1895 $top.t delete {end - 1c} end
1896 $top.t mark set insert 0.0
1897 }
1898 grid $top.t - -sticky ew -padx 5
1899 frame $top.buts
1900 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1901 -font $uifont
1902 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1903 -font $uifont
1904 grid $top.buts.ok $top.buts.can
1905 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1906 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1907 grid $top.buts - -pady 10 -sticky ew
1908 focus $top.t
1909}
1910
1911proc doviewmenu {m first cmd op argv} {
1912 set nmenu [$m index end]
1913 for {set i $first} {$i <= $nmenu} {incr i} {
1914 if {[$m entrycget $i -command] eq $cmd} {
1915 eval $m $op $i $argv
1916 break
1917 }
1918 }
1919}
1920
1921proc allviewmenus {n op args} {
1922 # global viewhlmenu
1923
1924 doviewmenu .bar.view 5 [list showview $n] $op $args
1925 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1926}
1927
1928proc newviewok {top n} {
1929 global nextviewnum newviewperm newviewname newishighlight
1930 global viewname viewfiles viewperm selectedview curview
1931 global viewargs newviewargs viewhlmenu
1932
1933 if {[catch {
1934 set newargs [shellsplit $newviewargs($n)]
1935 } err]} {
1936 error_popup "Error in commit selection arguments: $err"
1937 wm raise $top
1938 focus $top
1939 return
1940 }
1941 set files {}
1942 foreach f [split [$top.t get 0.0 end] "\n"] {
1943 set ft [string trim $f]
1944 if {$ft ne {}} {
1945 lappend files $ft
1946 }
1947 }
1948 if {![info exists viewfiles($n)]} {
1949 # creating a new view
1950 incr nextviewnum
1951 set viewname($n) $newviewname($n)
1952 set viewperm($n) $newviewperm($n)
1953 set viewfiles($n) $files
1954 set viewargs($n) $newargs
1955 addviewmenu $n
1956 if {!$newishighlight} {
1957 run showview $n
1958 } else {
1959 run addvhighlight $n
1960 }
1961 } else {
1962 # editing an existing view
1963 set viewperm($n) $newviewperm($n)
1964 if {$newviewname($n) ne $viewname($n)} {
1965 set viewname($n) $newviewname($n)
1966 doviewmenu .bar.view 5 [list showview $n] \
1967 entryconf [list -label $viewname($n)]
1968 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1969 # entryconf [list -label $viewname($n) -value $viewname($n)]
1970 }
1971 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1972 set viewfiles($n) $files
1973 set viewargs($n) $newargs
1974 if {$curview == $n} {
1975 run updatecommits
1976 }
1977 }
1978 }
1979 catch {destroy $top}
1980}
1981
1982proc delview {} {
1983 global curview viewdata viewperm hlview selectedhlview
1984
1985 if {$curview == 0} return
1986 if {[info exists hlview] && $hlview == $curview} {
1987 set selectedhlview None
1988 unset hlview
1989 }
1990 allviewmenus $curview delete
1991 set viewdata($curview) {}
1992 set viewperm($curview) 0
1993 showview 0
1994}
1995
1996proc addviewmenu {n} {
1997 global viewname viewhlmenu
1998
1999 .bar.view add radiobutton -label $viewname($n) \
2000 -command [list showview $n] -variable selectedview -value $n
2001 #$viewhlmenu add radiobutton -label $viewname($n) \
2002 # -command [list addvhighlight $n] -variable selectedhlview
2003}
2004
2005proc flatten {var} {
2006 global $var
2007
2008 set ret {}
2009 foreach i [array names $var] {
2010 lappend ret $i [set $var\($i\)]
2011 }
2012 return $ret
2013}
2014
2015proc unflatten {var l} {
2016 global $var
2017
2018 catch {unset $var}
2019 foreach {i v} $l {
2020 set $var\($i\) $v
2021 }
2022}
2023
2024proc showview {n} {
2025 global curview viewdata viewfiles
2026 global displayorder parentlist rowidlist rowisopt rowfinal
2027 global colormap rowtextx commitrow nextcolor canvxmax
2028 global numcommits commitlisted
2029 global selectedline currentid canv canvy0
2030 global treediffs
2031 global pending_select phase
2032 global commitidx
2033 global commfd
2034 global selectedview selectfirst
2035 global vparentlist vdisporder vcmitlisted
2036 global hlview selectedhlview commitinterest
2037
2038 if {$n == $curview} return
2039 set selid {}
2040 if {[info exists selectedline]} {
2041 set selid $currentid
2042 set y [yc $selectedline]
2043 set ymax [lindex [$canv cget -scrollregion] 3]
2044 set span [$canv yview]
2045 set ytop [expr {[lindex $span 0] * $ymax}]
2046 set ybot [expr {[lindex $span 1] * $ymax}]
2047 if {$ytop < $y && $y < $ybot} {
2048 set yscreen [expr {$y - $ytop}]
2049 } else {
2050 set yscreen [expr {($ybot - $ytop) / 2}]
2051 }
2052 } elseif {[info exists pending_select]} {
2053 set selid $pending_select
2054 unset pending_select
2055 }
2056 unselectline
2057 normalline
2058 if {$curview >= 0} {
2059 set vparentlist($curview) $parentlist
2060 set vdisporder($curview) $displayorder
2061 set vcmitlisted($curview) $commitlisted
2062 if {$phase ne {} ||
2063 ![info exists viewdata($curview)] ||
2064 [lindex $viewdata($curview) 0] ne {}} {
2065 set viewdata($curview) \
2066 [list $phase $rowidlist $rowisopt $rowfinal]
2067 }
2068 }
2069 catch {unset treediffs}
2070 clear_display
2071 if {[info exists hlview] && $hlview == $n} {
2072 unset hlview
2073 set selectedhlview None
2074 }
2075 catch {unset commitinterest}
2076
2077 set curview $n
2078 set selectedview $n
2079 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2080 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2081
2082 run refill_reflist
2083 if {![info exists viewdata($n)]} {
2084 if {$selid ne {}} {
2085 set pending_select $selid
2086 }
2087 getcommits
2088 return
2089 }
2090
2091 set v $viewdata($n)
2092 set phase [lindex $v 0]
2093 set displayorder $vdisporder($n)
2094 set parentlist $vparentlist($n)
2095 set commitlisted $vcmitlisted($n)
2096 set rowidlist [lindex $v 1]
2097 set rowisopt [lindex $v 2]
2098 set rowfinal [lindex $v 3]
2099 set numcommits $commitidx($n)
2100
2101 catch {unset colormap}
2102 catch {unset rowtextx}
2103 set nextcolor 0
2104 set canvxmax [$canv cget -width]
2105 set curview $n
2106 set row 0
2107 setcanvscroll
2108 set yf 0
2109 set row {}
2110 set selectfirst 0
2111 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2112 set row $commitrow($n,$selid)
2113 # try to get the selected row in the same position on the screen
2114 set ymax [lindex [$canv cget -scrollregion] 3]
2115 set ytop [expr {[yc $row] - $yscreen}]
2116 if {$ytop < 0} {
2117 set ytop 0
2118 }
2119 set yf [expr {$ytop * 1.0 / $ymax}]
2120 }
2121 allcanvs yview moveto $yf
2122 drawvisible
2123 if {$row ne {}} {
2124 selectline $row 0
2125 } elseif {$selid ne {}} {
2126 set pending_select $selid
2127 } else {
2128 set row [first_real_row]
2129 if {$row < $numcommits} {
2130 selectline $row 0
2131 } else {
2132 set selectfirst 1
2133 }
2134 }
2135 if {$phase ne {}} {
2136 if {$phase eq "getcommits"} {
2137 show_status "Reading commits..."
2138 }
2139 run chewcommits $n
2140 } elseif {$numcommits == 0} {
2141 show_status "No commits selected"
2142 }
2143}
2144
2145# Stuff relating to the highlighting facility
2146
2147proc ishighlighted {row} {
2148 global vhighlights fhighlights nhighlights rhighlights
2149
2150 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2151 return $nhighlights($row)
2152 }
2153 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2154 return $vhighlights($row)
2155 }
2156 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2157 return $fhighlights($row)
2158 }
2159 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2160 return $rhighlights($row)
2161 }
2162 return 0
2163}
2164
2165proc bolden {row font} {
2166 global canv linehtag selectedline boldrows
2167
2168 lappend boldrows $row
2169 $canv itemconf $linehtag($row) -font $font
2170 if {[info exists selectedline] && $row == $selectedline} {
2171 $canv delete secsel
2172 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2173 -outline {{}} -tags secsel \
2174 -fill [$canv cget -selectbackground]]
2175 $canv lower $t
2176 }
2177}
2178
2179proc bolden_name {row font} {
2180 global canv2 linentag selectedline boldnamerows
2181
2182 lappend boldnamerows $row
2183 $canv2 itemconf $linentag($row) -font $font
2184 if {[info exists selectedline] && $row == $selectedline} {
2185 $canv2 delete secsel
2186 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2187 -outline {{}} -tags secsel \
2188 -fill [$canv2 cget -selectbackground]]
2189 $canv2 lower $t
2190 }
2191}
2192
2193proc unbolden {} {
2194 global mainfont boldrows
2195
2196 set stillbold {}
2197 foreach row $boldrows {
2198 if {![ishighlighted $row]} {
2199 bolden $row $mainfont
2200 } else {
2201 lappend stillbold $row
2202 }
2203 }
2204 set boldrows $stillbold
2205}
2206
2207proc addvhighlight {n} {
2208 global hlview curview viewdata vhl_done vhighlights commitidx
2209
2210 if {[info exists hlview]} {
2211 delvhighlight
2212 }
2213 set hlview $n
2214 if {$n != $curview && ![info exists viewdata($n)]} {
2215 set viewdata($n) [list getcommits {{}} 0 0 0]
2216 set vparentlist($n) {}
2217 set vdisporder($n) {}
2218 set vcmitlisted($n) {}
2219 start_rev_list $n
2220 }
2221 set vhl_done $commitidx($hlview)
2222 if {$vhl_done > 0} {
2223 drawvisible
2224 }
2225}
2226
2227proc delvhighlight {} {
2228 global hlview vhighlights
2229
2230 if {![info exists hlview]} return
2231 unset hlview
2232 catch {unset vhighlights}
2233 unbolden
2234}
2235
2236proc vhighlightmore {} {
2237 global hlview vhl_done commitidx vhighlights
2238 global displayorder vdisporder curview mainfont
2239
2240 set font [concat $mainfont bold]
2241 set max $commitidx($hlview)
2242 if {$hlview == $curview} {
2243 set disp $displayorder
2244 } else {
2245 set disp $vdisporder($hlview)
2246 }
2247 set vr [visiblerows]
2248 set r0 [lindex $vr 0]
2249 set r1 [lindex $vr 1]
2250 for {set i $vhl_done} {$i < $max} {incr i} {
2251 set id [lindex $disp $i]
2252 if {[info exists commitrow($curview,$id)]} {
2253 set row $commitrow($curview,$id)
2254 if {$r0 <= $row && $row <= $r1} {
2255 if {![highlighted $row]} {
2256 bolden $row $font
2257 }
2258 set vhighlights($row) 1
2259 }
2260 }
2261 }
2262 set vhl_done $max
2263}
2264
2265proc askvhighlight {row id} {
2266 global hlview vhighlights commitrow iddrawn mainfont
2267
2268 if {[info exists commitrow($hlview,$id)]} {
2269 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2270 bolden $row [concat $mainfont bold]
2271 }
2272 set vhighlights($row) 1
2273 } else {
2274 set vhighlights($row) 0
2275 }
2276}
2277
2278proc hfiles_change {} {
2279 global highlight_files filehighlight fhighlights fh_serial
2280 global mainfont highlight_paths gdttype
2281
2282 if {[info exists filehighlight]} {
2283 # delete previous highlights
2284 catch {close $filehighlight}
2285 unset filehighlight
2286 catch {unset fhighlights}
2287 unbolden
2288 unhighlight_filelist
2289 }
2290 set highlight_paths {}
2291 after cancel do_file_hl $fh_serial
2292 incr fh_serial
2293 if {$highlight_files ne {}} {
2294 after 300 do_file_hl $fh_serial
2295 }
2296}
2297
2298proc gdttype_change {name ix op} {
2299 global gdttype highlight_files findstring findpattern
2300
2301 stopfinding
2302 if {$findstring ne {}} {
2303 if {$gdttype eq "containing:"} {
2304 if {$highlight_files ne {}} {
2305 set highlight_files {}
2306 hfiles_change
2307 }
2308 findcom_change
2309 } else {
2310 if {$findpattern ne {}} {
2311 set findpattern {}
2312 findcom_change
2313 }
2314 set highlight_files $findstring
2315 hfiles_change
2316 }
2317 drawvisible
2318 }
2319 # enable/disable findtype/findloc menus too
2320}
2321
2322proc find_change {name ix op} {
2323 global gdttype findstring highlight_files
2324
2325 stopfinding
2326 if {$gdttype eq "containing:"} {
2327 findcom_change
2328 } else {
2329 if {$highlight_files ne $findstring} {
2330 set highlight_files $findstring
2331 hfiles_change
2332 }
2333 }
2334 drawvisible
2335}
2336
2337proc findcom_change {} {
2338 global nhighlights mainfont boldnamerows
2339 global findpattern findtype findstring gdttype
2340
2341 stopfinding
2342 # delete previous highlights, if any
2343 foreach row $boldnamerows {
2344 bolden_name $row $mainfont
2345 }
2346 set boldnamerows {}
2347 catch {unset nhighlights}
2348 unbolden
2349 unmarkmatches
2350 if {$gdttype ne "containing:" || $findstring eq {}} {
2351 set findpattern {}
2352 } elseif {$findtype eq "Regexp"} {
2353 set findpattern $findstring
2354 } else {
2355 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2356 $findstring]
2357 set findpattern "*$e*"
2358 }
2359}
2360
2361proc makepatterns {l} {
2362 set ret {}
2363 foreach e $l {
2364 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2365 if {[string index $ee end] eq "/"} {
2366 lappend ret "$ee*"
2367 } else {
2368 lappend ret $ee
2369 lappend ret "$ee/*"
2370 }
2371 }
2372 return $ret
2373}
2374
2375proc do_file_hl {serial} {
2376 global highlight_files filehighlight highlight_paths gdttype fhl_list
2377
2378 if {$gdttype eq "touching paths:"} {
2379 if {[catch {set paths [shellsplit $highlight_files]}]} return
2380 set highlight_paths [makepatterns $paths]
2381 highlight_filelist
2382 set gdtargs [concat -- $paths]
2383 } elseif {$gdttype eq "adding/removing string:"} {
2384 set gdtargs [list "-S$highlight_files"]
2385 } else {
2386 # must be "containing:", i.e. we're searching commit info
2387 return
2388 }
2389 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2390 set filehighlight [open $cmd r+]
2391 fconfigure $filehighlight -blocking 0
2392 filerun $filehighlight readfhighlight
2393 set fhl_list {}
2394 drawvisible
2395 flushhighlights
2396}
2397
2398proc flushhighlights {} {
2399 global filehighlight fhl_list
2400
2401 if {[info exists filehighlight]} {
2402 lappend fhl_list {}
2403 puts $filehighlight ""
2404 flush $filehighlight
2405 }
2406}
2407
2408proc askfilehighlight {row id} {
2409 global filehighlight fhighlights fhl_list
2410
2411 lappend fhl_list $id
2412 set fhighlights($row) -1
2413 puts $filehighlight $id
2414}
2415
2416proc readfhighlight {} {
2417 global filehighlight fhighlights commitrow curview mainfont iddrawn
2418 global fhl_list find_dirn
2419
2420 if {![info exists filehighlight]} {
2421 return 0
2422 }
2423 set nr 0
2424 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2425 set line [string trim $line]
2426 set i [lsearch -exact $fhl_list $line]
2427 if {$i < 0} continue
2428 for {set j 0} {$j < $i} {incr j} {
2429 set id [lindex $fhl_list $j]
2430 if {[info exists commitrow($curview,$id)]} {
2431 set fhighlights($commitrow($curview,$id)) 0
2432 }
2433 }
2434 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2435 if {$line eq {}} continue
2436 if {![info exists commitrow($curview,$line)]} continue
2437 set row $commitrow($curview,$line)
2438 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2439 bolden $row [concat $mainfont bold]
2440 }
2441 set fhighlights($row) 1
2442 }
2443 if {[eof $filehighlight]} {
2444 # strange...
2445 puts "oops, git diff-tree died"
2446 catch {close $filehighlight}
2447 unset filehighlight
2448 return 0
2449 }
2450 if {[info exists find_dirn]} {
2451 if {$find_dirn > 0} {
2452 run findmore
2453 } else {
2454 run findmorerev
2455 }
2456 }
2457 return 1
2458}
2459
2460proc doesmatch {f} {
2461 global findtype findpattern
2462
2463 if {$findtype eq "Regexp"} {
2464 return [regexp $findpattern $f]
2465 } elseif {$findtype eq "IgnCase"} {
2466 return [string match -nocase $findpattern $f]
2467 } else {
2468 return [string match $findpattern $f]
2469 }
2470}
2471
2472proc askfindhighlight {row id} {
2473 global nhighlights commitinfo iddrawn mainfont
2474 global findloc
2475 global markingmatches
2476
2477 if {![info exists commitinfo($id)]} {
2478 getcommit $id
2479 }
2480 set info $commitinfo($id)
2481 set isbold 0
2482 set fldtypes {Headline Author Date Committer CDate Comments}
2483 foreach f $info ty $fldtypes {
2484 if {($findloc eq "All fields" || $findloc eq $ty) &&
2485 [doesmatch $f]} {
2486 if {$ty eq "Author"} {
2487 set isbold 2
2488 break
2489 }
2490 set isbold 1
2491 }
2492 }
2493 if {$isbold && [info exists iddrawn($id)]} {
2494 set f [concat $mainfont bold]
2495 if {![ishighlighted $row]} {
2496 bolden $row $f
2497 if {$isbold > 1} {
2498 bolden_name $row $f
2499 }
2500 }
2501 if {$markingmatches} {
2502 markrowmatches $row $id
2503 }
2504 }
2505 set nhighlights($row) $isbold
2506}
2507
2508proc markrowmatches {row id} {
2509 global canv canv2 linehtag linentag commitinfo findloc
2510
2511 set headline [lindex $commitinfo($id) 0]
2512 set author [lindex $commitinfo($id) 1]
2513 $canv delete match$row
2514 $canv2 delete match$row
2515 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2516 set m [findmatches $headline]
2517 if {$m ne {}} {
2518 markmatches $canv $row $headline $linehtag($row) $m \
2519 [$canv itemcget $linehtag($row) -font] $row
2520 }
2521 }
2522 if {$findloc eq "All fields" || $findloc eq "Author"} {
2523 set m [findmatches $author]
2524 if {$m ne {}} {
2525 markmatches $canv2 $row $author $linentag($row) $m \
2526 [$canv2 itemcget $linentag($row) -font] $row
2527 }
2528 }
2529}
2530
2531proc vrel_change {name ix op} {
2532 global highlight_related
2533
2534 rhighlight_none
2535 if {$highlight_related ne "None"} {
2536 run drawvisible
2537 }
2538}
2539
2540# prepare for testing whether commits are descendents or ancestors of a
2541proc rhighlight_sel {a} {
2542 global descendent desc_todo ancestor anc_todo
2543 global highlight_related rhighlights
2544
2545 catch {unset descendent}
2546 set desc_todo [list $a]
2547 catch {unset ancestor}
2548 set anc_todo [list $a]
2549 if {$highlight_related ne "None"} {
2550 rhighlight_none
2551 run drawvisible
2552 }
2553}
2554
2555proc rhighlight_none {} {
2556 global rhighlights
2557
2558 catch {unset rhighlights}
2559 unbolden
2560}
2561
2562proc is_descendent {a} {
2563 global curview children commitrow descendent desc_todo
2564
2565 set v $curview
2566 set la $commitrow($v,$a)
2567 set todo $desc_todo
2568 set leftover {}
2569 set done 0
2570 for {set i 0} {$i < [llength $todo]} {incr i} {
2571 set do [lindex $todo $i]
2572 if {$commitrow($v,$do) < $la} {
2573 lappend leftover $do
2574 continue
2575 }
2576 foreach nk $children($v,$do) {
2577 if {![info exists descendent($nk)]} {
2578 set descendent($nk) 1
2579 lappend todo $nk
2580 if {$nk eq $a} {
2581 set done 1
2582 }
2583 }
2584 }
2585 if {$done} {
2586 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2587 return
2588 }
2589 }
2590 set descendent($a) 0
2591 set desc_todo $leftover
2592}
2593
2594proc is_ancestor {a} {
2595 global curview parentlist commitrow ancestor anc_todo
2596
2597 set v $curview
2598 set la $commitrow($v,$a)
2599 set todo $anc_todo
2600 set leftover {}
2601 set done 0
2602 for {set i 0} {$i < [llength $todo]} {incr i} {
2603 set do [lindex $todo $i]
2604 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2605 lappend leftover $do
2606 continue
2607 }
2608 foreach np [lindex $parentlist $commitrow($v,$do)] {
2609 if {![info exists ancestor($np)]} {
2610 set ancestor($np) 1
2611 lappend todo $np
2612 if {$np eq $a} {
2613 set done 1
2614 }
2615 }
2616 }
2617 if {$done} {
2618 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2619 return
2620 }
2621 }
2622 set ancestor($a) 0
2623 set anc_todo $leftover
2624}
2625
2626proc askrelhighlight {row id} {
2627 global descendent highlight_related iddrawn mainfont rhighlights
2628 global selectedline ancestor
2629
2630 if {![info exists selectedline]} return
2631 set isbold 0
2632 if {$highlight_related eq "Descendent" ||
2633 $highlight_related eq "Not descendent"} {
2634 if {![info exists descendent($id)]} {
2635 is_descendent $id
2636 }
2637 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2638 set isbold 1
2639 }
2640 } elseif {$highlight_related eq "Ancestor" ||
2641 $highlight_related eq "Not ancestor"} {
2642 if {![info exists ancestor($id)]} {
2643 is_ancestor $id
2644 }
2645 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2646 set isbold 1
2647 }
2648 }
2649 if {[info exists iddrawn($id)]} {
2650 if {$isbold && ![ishighlighted $row]} {
2651 bolden $row [concat $mainfont bold]
2652 }
2653 }
2654 set rhighlights($row) $isbold
2655}
2656
2657# Graph layout functions
2658
2659proc shortids {ids} {
2660 set res {}
2661 foreach id $ids {
2662 if {[llength $id] > 1} {
2663 lappend res [shortids $id]
2664 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2665 lappend res [string range $id 0 7]
2666 } else {
2667 lappend res $id
2668 }
2669 }
2670 return $res
2671}
2672
2673proc ntimes {n o} {
2674 set ret {}
2675 set o [list $o]
2676 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2677 if {($n & $mask) != 0} {
2678 set ret [concat $ret $o]
2679 }
2680 set o [concat $o $o]
2681 }
2682 return $ret
2683}
2684
2685# Work out where id should go in idlist so that order-token
2686# values increase from left to right
2687proc idcol {idlist id {i 0}} {
2688 global ordertok curview
2689
2690 set t $ordertok($curview,$id)
2691 if {$i >= [llength $idlist] ||
2692 $t < $ordertok($curview,[lindex $idlist $i])} {
2693 if {$i > [llength $idlist]} {
2694 set i [llength $idlist]
2695 }
2696 while {[incr i -1] >= 0 &&
2697 $t < $ordertok($curview,[lindex $idlist $i])} {}
2698 incr i
2699 } else {
2700 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2701 while {[incr i] < [llength $idlist] &&
2702 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2703 }
2704 }
2705 return $i
2706}
2707
2708proc initlayout {} {
2709 global rowidlist rowisopt rowfinal displayorder commitlisted
2710 global numcommits canvxmax canv
2711 global nextcolor
2712 global parentlist
2713 global colormap rowtextx
2714 global selectfirst
2715
2716 set numcommits 0
2717 set displayorder {}
2718 set commitlisted {}
2719 set parentlist {}
2720 set nextcolor 0
2721 set rowidlist {}
2722 set rowisopt {}
2723 set rowfinal {}
2724 set canvxmax [$canv cget -width]
2725 catch {unset colormap}
2726 catch {unset rowtextx}
2727 set selectfirst 1
2728}
2729
2730proc setcanvscroll {} {
2731 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2732
2733 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2734 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2735 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2736 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2737}
2738
2739proc visiblerows {} {
2740 global canv numcommits linespc
2741
2742 set ymax [lindex [$canv cget -scrollregion] 3]
2743 if {$ymax eq {} || $ymax == 0} return
2744 set f [$canv yview]
2745 set y0 [expr {int([lindex $f 0] * $ymax)}]
2746 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2747 if {$r0 < 0} {
2748 set r0 0
2749 }
2750 set y1 [expr {int([lindex $f 1] * $ymax)}]
2751 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2752 if {$r1 >= $numcommits} {
2753 set r1 [expr {$numcommits - 1}]
2754 }
2755 return [list $r0 $r1]
2756}
2757
2758proc layoutmore {} {
2759 global commitidx viewcomplete numcommits
2760 global uparrowlen downarrowlen mingaplen curview
2761
2762 set show $commitidx($curview)
2763 if {$show > $numcommits} {
2764 showstuff $show $viewcomplete($curview)
2765 }
2766}
2767
2768proc showstuff {canshow last} {
2769 global numcommits commitrow pending_select selectedline curview
2770 global mainheadid displayorder selectfirst
2771 global lastscrollset commitinterest
2772
2773 if {$numcommits == 0} {
2774 global phase
2775 set phase "incrdraw"
2776 allcanvs delete all
2777 }
2778 set r0 $numcommits
2779 set prev $numcommits
2780 set numcommits $canshow
2781 set t [clock clicks -milliseconds]
2782 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2783 set lastscrollset $t
2784 setcanvscroll
2785 }
2786 set rows [visiblerows]
2787 set r1 [lindex $rows 1]
2788 if {$r1 >= $canshow} {
2789 set r1 [expr {$canshow - 1}]
2790 }
2791 if {$r0 <= $r1} {
2792 drawcommits $r0 $r1
2793 }
2794 if {[info exists pending_select] &&
2795 [info exists commitrow($curview,$pending_select)] &&
2796 $commitrow($curview,$pending_select) < $numcommits} {
2797 selectline $commitrow($curview,$pending_select) 1
2798 }
2799 if {$selectfirst} {
2800 if {[info exists selectedline] || [info exists pending_select]} {
2801 set selectfirst 0
2802 } else {
2803 set l [first_real_row]
2804 selectline $l 1
2805 set selectfirst 0
2806 }
2807 }
2808}
2809
2810proc doshowlocalchanges {} {
2811 global curview mainheadid phase commitrow
2812
2813 if {[info exists commitrow($curview,$mainheadid)] &&
2814 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2815 dodiffindex
2816 } elseif {$phase ne {}} {
2817 lappend commitinterest($mainheadid) {}
2818 }
2819}
2820
2821proc dohidelocalchanges {} {
2822 global localfrow localirow lserial
2823
2824 if {$localfrow >= 0} {
2825 removerow $localfrow
2826 set localfrow -1
2827 if {$localirow > 0} {
2828 incr localirow -1
2829 }
2830 }
2831 if {$localirow >= 0} {
2832 removerow $localirow
2833 set localirow -1
2834 }
2835 incr lserial
2836}
2837
2838# spawn off a process to do git diff-index --cached HEAD
2839proc dodiffindex {} {
2840 global localirow localfrow lserial showlocalchanges
2841
2842 if {!$showlocalchanges} return
2843 incr lserial
2844 set localfrow -1
2845 set localirow -1
2846 set fd [open "|git diff-index --cached HEAD" r]
2847 fconfigure $fd -blocking 0
2848 filerun $fd [list readdiffindex $fd $lserial]
2849}
2850
2851proc readdiffindex {fd serial} {
2852 global localirow commitrow mainheadid nullid2 curview
2853 global commitinfo commitdata lserial
2854
2855 set isdiff 1
2856 if {[gets $fd line] < 0} {
2857 if {![eof $fd]} {
2858 return 1
2859 }
2860 set isdiff 0
2861 }
2862 # we only need to see one line and we don't really care what it says...
2863 close $fd
2864
2865 # now see if there are any local changes not checked in to the index
2866 if {$serial == $lserial} {
2867 set fd [open "|git diff-files" r]
2868 fconfigure $fd -blocking 0
2869 filerun $fd [list readdifffiles $fd $serial]
2870 }
2871
2872 if {$isdiff && $serial == $lserial && $localirow == -1} {
2873 # add the line for the changes in the index to the graph
2874 set localirow $commitrow($curview,$mainheadid)
2875 set hl "Local changes checked in to index but not committed"
2876 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2877 set commitdata($nullid2) "\n $hl\n"
2878 insertrow $localirow $nullid2
2879 }
2880 return 0
2881}
2882
2883proc readdifffiles {fd serial} {
2884 global localirow localfrow commitrow mainheadid nullid curview
2885 global commitinfo commitdata lserial
2886
2887 set isdiff 1
2888 if {[gets $fd line] < 0} {
2889 if {![eof $fd]} {
2890 return 1
2891 }
2892 set isdiff 0
2893 }
2894 # we only need to see one line and we don't really care what it says...
2895 close $fd
2896
2897 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2898 # add the line for the local diff to the graph
2899 if {$localirow >= 0} {
2900 set localfrow $localirow
2901 incr localirow
2902 } else {
2903 set localfrow $commitrow($curview,$mainheadid)
2904 }
2905 set hl "Local uncommitted changes, not checked in to index"
2906 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2907 set commitdata($nullid) "\n $hl\n"
2908 insertrow $localfrow $nullid
2909 }
2910 return 0
2911}
2912
2913proc nextuse {id row} {
2914 global commitrow curview children
2915
2916 if {[info exists children($curview,$id)]} {
2917 foreach kid $children($curview,$id) {
2918 if {![info exists commitrow($curview,$kid)]} {
2919 return -1
2920 }
2921 if {$commitrow($curview,$kid) > $row} {
2922 return $commitrow($curview,$kid)
2923 }
2924 }
2925 }
2926 if {[info exists commitrow($curview,$id)]} {
2927 return $commitrow($curview,$id)
2928 }
2929 return -1
2930}
2931
2932proc prevuse {id row} {
2933 global commitrow curview children
2934
2935 set ret -1
2936 if {[info exists children($curview,$id)]} {
2937 foreach kid $children($curview,$id) {
2938 if {![info exists commitrow($curview,$kid)]} break
2939 if {$commitrow($curview,$kid) < $row} {
2940 set ret $commitrow($curview,$kid)
2941 }
2942 }
2943 }
2944 return $ret
2945}
2946
2947proc make_idlist {row} {
2948 global displayorder parentlist uparrowlen downarrowlen mingaplen
2949 global commitidx curview ordertok children commitrow
2950
2951 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2952 if {$r < 0} {
2953 set r 0
2954 }
2955 set ra [expr {$row - $downarrowlen}]
2956 if {$ra < 0} {
2957 set ra 0
2958 }
2959 set rb [expr {$row + $uparrowlen}]
2960 if {$rb > $commitidx($curview)} {
2961 set rb $commitidx($curview)
2962 }
2963 set ids {}
2964 for {} {$r < $ra} {incr r} {
2965 set nextid [lindex $displayorder [expr {$r + 1}]]
2966 foreach p [lindex $parentlist $r] {
2967 if {$p eq $nextid} continue
2968 set rn [nextuse $p $r]
2969 if {$rn >= $row &&
2970 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2971 lappend ids [list $ordertok($curview,$p) $p]
2972 }
2973 }
2974 }
2975 for {} {$r < $row} {incr r} {
2976 set nextid [lindex $displayorder [expr {$r + 1}]]
2977 foreach p [lindex $parentlist $r] {
2978 if {$p eq $nextid} continue
2979 set rn [nextuse $p $r]
2980 if {$rn < 0 || $rn >= $row} {
2981 lappend ids [list $ordertok($curview,$p) $p]
2982 }
2983 }
2984 }
2985 set id [lindex $displayorder $row]
2986 lappend ids [list $ordertok($curview,$id) $id]
2987 while {$r < $rb} {
2988 foreach p [lindex $parentlist $r] {
2989 set firstkid [lindex $children($curview,$p) 0]
2990 if {$commitrow($curview,$firstkid) < $row} {
2991 lappend ids [list $ordertok($curview,$p) $p]
2992 }
2993 }
2994 incr r
2995 set id [lindex $displayorder $r]
2996 if {$id ne {}} {
2997 set firstkid [lindex $children($curview,$id) 0]
2998 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
2999 lappend ids [list $ordertok($curview,$id) $id]
3000 }
3001 }
3002 }
3003 set idlist {}
3004 foreach idx [lsort -unique $ids] {
3005 lappend idlist [lindex $idx 1]
3006 }
3007 return $idlist
3008}
3009
3010proc rowsequal {a b} {
3011 while {[set i [lsearch -exact $a {}]] >= 0} {
3012 set a [lreplace $a $i $i]
3013 }
3014 while {[set i [lsearch -exact $b {}]] >= 0} {
3015 set b [lreplace $b $i $i]
3016 }
3017 return [expr {$a eq $b}]
3018}
3019
3020proc makeupline {id row rend col} {
3021 global rowidlist uparrowlen downarrowlen mingaplen
3022
3023 for {set r $rend} {1} {set r $rstart} {
3024 set rstart [prevuse $id $r]
3025 if {$rstart < 0} return
3026 if {$rstart < $row} break
3027 }
3028 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3029 set rstart [expr {$rend - $uparrowlen - 1}]
3030 }
3031 for {set r $rstart} {[incr r] <= $row} {} {
3032 set idlist [lindex $rowidlist $r]
3033 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3034 set col [idcol $idlist $id $col]
3035 lset rowidlist $r [linsert $idlist $col $id]
3036 changedrow $r
3037 }
3038 }
3039}
3040
3041proc layoutrows {row endrow} {
3042 global rowidlist rowisopt rowfinal displayorder
3043 global uparrowlen downarrowlen maxwidth mingaplen
3044 global children parentlist
3045 global commitidx viewcomplete curview commitrow
3046
3047 set idlist {}
3048 if {$row > 0} {
3049 set rm1 [expr {$row - 1}]
3050 foreach id [lindex $rowidlist $rm1] {
3051 if {$id ne {}} {
3052 lappend idlist $id
3053 }
3054 }
3055 set final [lindex $rowfinal $rm1]
3056 }
3057 for {} {$row < $endrow} {incr row} {
3058 set rm1 [expr {$row - 1}]
3059 if {$rm1 < 0 || $idlist eq {}} {
3060 set idlist [make_idlist $row]
3061 set final 1
3062 } else {
3063 set id [lindex $displayorder $rm1]
3064 set col [lsearch -exact $idlist $id]
3065 set idlist [lreplace $idlist $col $col]
3066 foreach p [lindex $parentlist $rm1] {
3067 if {[lsearch -exact $idlist $p] < 0} {
3068 set col [idcol $idlist $p $col]
3069 set idlist [linsert $idlist $col $p]
3070 # if not the first child, we have to insert a line going up
3071 if {$id ne [lindex $children($curview,$p) 0]} {
3072 makeupline $p $rm1 $row $col
3073 }
3074 }
3075 }
3076 set id [lindex $displayorder $row]
3077 if {$row > $downarrowlen} {
3078 set termrow [expr {$row - $downarrowlen - 1}]
3079 foreach p [lindex $parentlist $termrow] {
3080 set i [lsearch -exact $idlist $p]
3081 if {$i < 0} continue
3082 set nr [nextuse $p $termrow]
3083 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3084 set idlist [lreplace $idlist $i $i]
3085 }
3086 }
3087 }
3088 set col [lsearch -exact $idlist $id]
3089 if {$col < 0} {
3090 set col [idcol $idlist $id]
3091 set idlist [linsert $idlist $col $id]
3092 if {$children($curview,$id) ne {}} {
3093 makeupline $id $rm1 $row $col
3094 }
3095 }
3096 set r [expr {$row + $uparrowlen - 1}]
3097 if {$r < $commitidx($curview)} {
3098 set x $col
3099 foreach p [lindex $parentlist $r] {
3100 if {[lsearch -exact $idlist $p] >= 0} continue
3101 set fk [lindex $children($curview,$p) 0]
3102 if {$commitrow($curview,$fk) < $row} {
3103 set x [idcol $idlist $p $x]
3104 set idlist [linsert $idlist $x $p]
3105 }
3106 }
3107 if {[incr r] < $commitidx($curview)} {
3108 set p [lindex $displayorder $r]
3109 if {[lsearch -exact $idlist $p] < 0} {
3110 set fk [lindex $children($curview,$p) 0]
3111 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3112 set x [idcol $idlist $p $x]
3113 set idlist [linsert $idlist $x $p]
3114 }
3115 }
3116 }
3117 }
3118 }
3119 if {$final && !$viewcomplete($curview) &&
3120 $row + $uparrowlen + $mingaplen + $downarrowlen
3121 >= $commitidx($curview)} {
3122 set final 0
3123 }
3124 set l [llength $rowidlist]
3125 if {$row == $l} {
3126 lappend rowidlist $idlist
3127 lappend rowisopt 0
3128 lappend rowfinal $final
3129 } elseif {$row < $l} {
3130 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3131 lset rowidlist $row $idlist
3132 changedrow $row
3133 }
3134 lset rowfinal $row $final
3135 } else {
3136 set pad [ntimes [expr {$row - $l}] {}]
3137 set rowidlist [concat $rowidlist $pad]
3138 lappend rowidlist $idlist
3139 set rowfinal [concat $rowfinal $pad]
3140 lappend rowfinal $final
3141 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3142 }
3143 }
3144 return $row
3145}
3146
3147proc changedrow {row} {
3148 global displayorder iddrawn rowisopt need_redisplay
3149
3150 set l [llength $rowisopt]
3151 if {$row < $l} {
3152 lset rowisopt $row 0
3153 if {$row + 1 < $l} {
3154 lset rowisopt [expr {$row + 1}] 0
3155 if {$row + 2 < $l} {
3156 lset rowisopt [expr {$row + 2}] 0
3157 }
3158 }
3159 }
3160 set id [lindex $displayorder $row]
3161 if {[info exists iddrawn($id)]} {
3162 set need_redisplay 1
3163 }
3164}
3165
3166proc insert_pad {row col npad} {
3167 global rowidlist
3168
3169 set pad [ntimes $npad {}]
3170 set idlist [lindex $rowidlist $row]
3171 set bef [lrange $idlist 0 [expr {$col - 1}]]
3172 set aft [lrange $idlist $col end]
3173 set i [lsearch -exact $aft {}]
3174 if {$i > 0} {
3175 set aft [lreplace $aft $i $i]
3176 }
3177 lset rowidlist $row [concat $bef $pad $aft]
3178 changedrow $row
3179}
3180
3181proc optimize_rows {row col endrow} {
3182 global rowidlist rowisopt displayorder curview children
3183
3184 if {$row < 1} {
3185 set row 1
3186 }
3187 for {} {$row < $endrow} {incr row; set col 0} {
3188 if {[lindex $rowisopt $row]} continue
3189 set haspad 0
3190 set y0 [expr {$row - 1}]
3191 set ym [expr {$row - 2}]
3192 set idlist [lindex $rowidlist $row]
3193 set previdlist [lindex $rowidlist $y0]
3194 if {$idlist eq {} || $previdlist eq {}} continue
3195 if {$ym >= 0} {
3196 set pprevidlist [lindex $rowidlist $ym]
3197 if {$pprevidlist eq {}} continue
3198 } else {
3199 set pprevidlist {}
3200 }
3201 set x0 -1
3202 set xm -1
3203 for {} {$col < [llength $idlist]} {incr col} {
3204 set id [lindex $idlist $col]
3205 if {[lindex $previdlist $col] eq $id} continue
3206 if {$id eq {}} {
3207 set haspad 1
3208 continue
3209 }
3210 set x0 [lsearch -exact $previdlist $id]
3211 if {$x0 < 0} continue
3212 set z [expr {$x0 - $col}]
3213 set isarrow 0
3214 set z0 {}
3215 if {$ym >= 0} {
3216 set xm [lsearch -exact $pprevidlist $id]
3217 if {$xm >= 0} {
3218 set z0 [expr {$xm - $x0}]
3219 }
3220 }
3221 if {$z0 eq {}} {
3222 # if row y0 is the first child of $id then it's not an arrow
3223 if {[lindex $children($curview,$id) 0] ne
3224 [lindex $displayorder $y0]} {
3225 set isarrow 1
3226 }
3227 }
3228 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3229 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3230 set isarrow 1
3231 }
3232 # Looking at lines from this row to the previous row,
3233 # make them go straight up if they end in an arrow on
3234 # the previous row; otherwise make them go straight up
3235 # or at 45 degrees.
3236 if {$z < -1 || ($z < 0 && $isarrow)} {
3237 # Line currently goes left too much;
3238 # insert pads in the previous row, then optimize it
3239 set npad [expr {-1 - $z + $isarrow}]
3240 insert_pad $y0 $x0 $npad
3241 if {$y0 > 0} {
3242 optimize_rows $y0 $x0 $row
3243 }
3244 set previdlist [lindex $rowidlist $y0]
3245 set x0 [lsearch -exact $previdlist $id]
3246 set z [expr {$x0 - $col}]
3247 if {$z0 ne {}} {
3248 set pprevidlist [lindex $rowidlist $ym]
3249 set xm [lsearch -exact $pprevidlist $id]
3250 set z0 [expr {$xm - $x0}]
3251 }
3252 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3253 # Line currently goes right too much;
3254 # insert pads in this line
3255 set npad [expr {$z - 1 + $isarrow}]
3256 insert_pad $row $col $npad
3257 set idlist [lindex $rowidlist $row]
3258 incr col $npad
3259 set z [expr {$x0 - $col}]
3260 set haspad 1
3261 }
3262 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3263 # this line links to its first child on row $row-2
3264 set id [lindex $displayorder $ym]
3265 set xc [lsearch -exact $pprevidlist $id]
3266 if {$xc >= 0} {
3267 set z0 [expr {$xc - $x0}]
3268 }
3269 }
3270 # avoid lines jigging left then immediately right
3271 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3272 insert_pad $y0 $x0 1
3273 incr x0
3274 optimize_rows $y0 $x0 $row
3275 set previdlist [lindex $rowidlist $y0]
3276 }
3277 }
3278 if {!$haspad} {
3279 # Find the first column that doesn't have a line going right
3280 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3281 set id [lindex $idlist $col]
3282 if {$id eq {}} break
3283 set x0 [lsearch -exact $previdlist $id]
3284 if {$x0 < 0} {
3285 # check if this is the link to the first child
3286 set kid [lindex $displayorder $y0]
3287 if {[lindex $children($curview,$id) 0] eq $kid} {
3288 # it is, work out offset to child
3289 set x0 [lsearch -exact $previdlist $kid]
3290 }
3291 }
3292 if {$x0 <= $col} break
3293 }
3294 # Insert a pad at that column as long as it has a line and
3295 # isn't the last column
3296 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3297 set idlist [linsert $idlist $col {}]
3298 lset rowidlist $row $idlist
3299 changedrow $row
3300 }
3301 }
3302 }
3303}
3304
3305proc xc {row col} {
3306 global canvx0 linespc
3307 return [expr {$canvx0 + $col * $linespc}]
3308}
3309
3310proc yc {row} {
3311 global canvy0 linespc
3312 return [expr {$canvy0 + $row * $linespc}]
3313}
3314
3315proc linewidth {id} {
3316 global thickerline lthickness
3317
3318 set wid $lthickness
3319 if {[info exists thickerline] && $id eq $thickerline} {
3320 set wid [expr {2 * $lthickness}]
3321 }
3322 return $wid
3323}
3324
3325proc rowranges {id} {
3326 global commitrow curview children uparrowlen downarrowlen
3327 global rowidlist
3328
3329 set kids $children($curview,$id)
3330 if {$kids eq {}} {
3331 return {}
3332 }
3333 set ret {}
3334 lappend kids $id
3335 foreach child $kids {
3336 if {![info exists commitrow($curview,$child)]} break
3337 set row $commitrow($curview,$child)
3338 if {![info exists prev]} {
3339 lappend ret [expr {$row + 1}]
3340 } else {
3341 if {$row <= $prevrow} {
3342 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3343 }
3344 # see if the line extends the whole way from prevrow to row
3345 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3346 [lsearch -exact [lindex $rowidlist \
3347 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3348 # it doesn't, see where it ends
3349 set r [expr {$prevrow + $downarrowlen}]
3350 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3351 while {[incr r -1] > $prevrow &&
3352 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3353 } else {
3354 while {[incr r] <= $row &&
3355 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3356 incr r -1
3357 }
3358 lappend ret $r
3359 # see where it starts up again
3360 set r [expr {$row - $uparrowlen}]
3361 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3362 while {[incr r] < $row &&
3363 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3364 } else {
3365 while {[incr r -1] >= $prevrow &&
3366 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3367 incr r
3368 }
3369 lappend ret $r
3370 }
3371 }
3372 if {$child eq $id} {
3373 lappend ret $row
3374 }
3375 set prev $id
3376 set prevrow $row
3377 }
3378 return $ret
3379}
3380
3381proc drawlineseg {id row endrow arrowlow} {
3382 global rowidlist displayorder iddrawn linesegs
3383 global canv colormap linespc curview maxlinelen parentlist
3384
3385 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3386 set le [expr {$row + 1}]
3387 set arrowhigh 1
3388 while {1} {
3389 set c [lsearch -exact [lindex $rowidlist $le] $id]
3390 if {$c < 0} {
3391 incr le -1
3392 break
3393 }
3394 lappend cols $c
3395 set x [lindex $displayorder $le]
3396 if {$x eq $id} {
3397 set arrowhigh 0
3398 break
3399 }
3400 if {[info exists iddrawn($x)] || $le == $endrow} {
3401 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3402 if {$c >= 0} {
3403 lappend cols $c
3404 set arrowhigh 0
3405 }
3406 break
3407 }
3408 incr le
3409 }
3410 if {$le <= $row} {
3411 return $row
3412 }
3413
3414 set lines {}
3415 set i 0
3416 set joinhigh 0
3417 if {[info exists linesegs($id)]} {
3418 set lines $linesegs($id)
3419 foreach li $lines {
3420 set r0 [lindex $li 0]
3421 if {$r0 > $row} {
3422 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3423 set joinhigh 1
3424 }
3425 break
3426 }
3427 incr i
3428 }
3429 }
3430 set joinlow 0
3431 if {$i > 0} {
3432 set li [lindex $lines [expr {$i-1}]]
3433 set r1 [lindex $li 1]
3434 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3435 set joinlow 1
3436 }
3437 }
3438
3439 set x [lindex $cols [expr {$le - $row}]]
3440 set xp [lindex $cols [expr {$le - 1 - $row}]]
3441 set dir [expr {$xp - $x}]
3442 if {$joinhigh} {
3443 set ith [lindex $lines $i 2]
3444 set coords [$canv coords $ith]
3445 set ah [$canv itemcget $ith -arrow]
3446 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3447 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3448 if {$x2 ne {} && $x - $x2 == $dir} {
3449 set coords [lrange $coords 0 end-2]
3450 }
3451 } else {
3452 set coords [list [xc $le $x] [yc $le]]
3453 }
3454 if {$joinlow} {
3455 set itl [lindex $lines [expr {$i-1}] 2]
3456 set al [$canv itemcget $itl -arrow]
3457 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3458 } elseif {$arrowlow} {
3459 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3460 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3461 set arrowlow 0
3462 }
3463 }
3464 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3465 for {set y $le} {[incr y -1] > $row} {} {
3466 set x $xp
3467 set xp [lindex $cols [expr {$y - 1 - $row}]]
3468 set ndir [expr {$xp - $x}]
3469 if {$dir != $ndir || $xp < 0} {
3470 lappend coords [xc $y $x] [yc $y]
3471 }
3472 set dir $ndir
3473 }
3474 if {!$joinlow} {
3475 if {$xp < 0} {
3476 # join parent line to first child
3477 set ch [lindex $displayorder $row]
3478 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3479 if {$xc < 0} {
3480 puts "oops: drawlineseg: child $ch not on row $row"
3481 } elseif {$xc != $x} {
3482 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3483 set d [expr {int(0.5 * $linespc)}]
3484 set x1 [xc $row $x]
3485 if {$xc < $x} {
3486 set x2 [expr {$x1 - $d}]
3487 } else {
3488 set x2 [expr {$x1 + $d}]
3489 }
3490 set y2 [yc $row]
3491 set y1 [expr {$y2 + $d}]
3492 lappend coords $x1 $y1 $x2 $y2
3493 } elseif {$xc < $x - 1} {
3494 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3495 } elseif {$xc > $x + 1} {
3496 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3497 }
3498 set x $xc
3499 }
3500 lappend coords [xc $row $x] [yc $row]
3501 } else {
3502 set xn [xc $row $xp]
3503 set yn [yc $row]
3504 lappend coords $xn $yn
3505 }
3506 if {!$joinhigh} {
3507 assigncolor $id
3508 set t [$canv create line $coords -width [linewidth $id] \
3509 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3510 $canv lower $t
3511 bindline $t $id
3512 set lines [linsert $lines $i [list $row $le $t]]
3513 } else {
3514 $canv coords $ith $coords
3515 if {$arrow ne $ah} {
3516 $canv itemconf $ith -arrow $arrow
3517 }
3518 lset lines $i 0 $row
3519 }
3520 } else {
3521 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3522 set ndir [expr {$xo - $xp}]
3523 set clow [$canv coords $itl]
3524 if {$dir == $ndir} {
3525 set clow [lrange $clow 2 end]
3526 }
3527 set coords [concat $coords $clow]
3528 if {!$joinhigh} {
3529 lset lines [expr {$i-1}] 1 $le
3530 } else {
3531 # coalesce two pieces
3532 $canv delete $ith
3533 set b [lindex $lines [expr {$i-1}] 0]
3534 set e [lindex $lines $i 1]
3535 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3536 }
3537 $canv coords $itl $coords
3538 if {$arrow ne $al} {
3539 $canv itemconf $itl -arrow $arrow
3540 }
3541 }
3542
3543 set linesegs($id) $lines
3544 return $le
3545}
3546
3547proc drawparentlinks {id row} {
3548 global rowidlist canv colormap curview parentlist
3549 global idpos linespc
3550
3551 set rowids [lindex $rowidlist $row]
3552 set col [lsearch -exact $rowids $id]
3553 if {$col < 0} return
3554 set olds [lindex $parentlist $row]
3555 set row2 [expr {$row + 1}]
3556 set x [xc $row $col]
3557 set y [yc $row]
3558 set y2 [yc $row2]
3559 set d [expr {int(0.5 * $linespc)}]
3560 set ymid [expr {$y + $d}]
3561 set ids [lindex $rowidlist $row2]
3562 # rmx = right-most X coord used
3563 set rmx 0
3564 foreach p $olds {
3565 set i [lsearch -exact $ids $p]
3566 if {$i < 0} {
3567 puts "oops, parent $p of $id not in list"
3568 continue
3569 }
3570 set x2 [xc $row2 $i]
3571 if {$x2 > $rmx} {
3572 set rmx $x2
3573 }
3574 set j [lsearch -exact $rowids $p]
3575 if {$j < 0} {
3576 # drawlineseg will do this one for us
3577 continue
3578 }
3579 assigncolor $p
3580 # should handle duplicated parents here...
3581 set coords [list $x $y]
3582 if {$i != $col} {
3583 # if attaching to a vertical segment, draw a smaller
3584 # slant for visual distinctness
3585 if {$i == $j} {
3586 if {$i < $col} {
3587 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3588 } else {
3589 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3590 }
3591 } elseif {$i < $col && $i < $j} {
3592 # segment slants towards us already
3593 lappend coords [xc $row $j] $y
3594 } else {
3595 if {$i < $col - 1} {
3596 lappend coords [expr {$x2 + $linespc}] $y
3597 } elseif {$i > $col + 1} {
3598 lappend coords [expr {$x2 - $linespc}] $y
3599 }
3600 lappend coords $x2 $y2
3601 }
3602 } else {
3603 lappend coords $x2 $y2
3604 }
3605 set t [$canv create line $coords -width [linewidth $p] \
3606 -fill $colormap($p) -tags lines.$p]
3607 $canv lower $t
3608 bindline $t $p
3609 }
3610 if {$rmx > [lindex $idpos($id) 1]} {
3611 lset idpos($id) 1 $rmx
3612 redrawtags $id
3613 }
3614}
3615
3616proc drawlines {id} {
3617 global canv
3618
3619 $canv itemconf lines.$id -width [linewidth $id]
3620}
3621
3622proc drawcmittext {id row col} {
3623 global linespc canv canv2 canv3 canvy0 fgcolor curview
3624 global commitlisted commitinfo rowidlist parentlist
3625 global rowtextx idpos idtags idheads idotherrefs
3626 global linehtag linentag linedtag selectedline
3627 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3628
3629 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3630 set listed [lindex $commitlisted $row]
3631 if {$id eq $nullid} {
3632 set ofill red
3633 } elseif {$id eq $nullid2} {
3634 set ofill green
3635 } else {
3636 set ofill [expr {$listed != 0? "blue": "white"}]
3637 }
3638 set x [xc $row $col]
3639 set y [yc $row]
3640 set orad [expr {$linespc / 3}]
3641 if {$listed <= 1} {
3642 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3643 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3644 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3645 } elseif {$listed == 2} {
3646 # triangle pointing left for left-side commits
3647 set t [$canv create polygon \
3648 [expr {$x - $orad}] $y \
3649 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3650 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3651 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3652 } else {
3653 # triangle pointing right for right-side commits
3654 set t [$canv create polygon \
3655 [expr {$x + $orad - 1}] $y \
3656 [expr {$x - $orad}] [expr {$y - $orad}] \
3657 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3658 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3659 }
3660 $canv raise $t
3661 $canv bind $t <1> {selcanvline {} %x %y}
3662 set rmx [llength [lindex $rowidlist $row]]
3663 set olds [lindex $parentlist $row]
3664 if {$olds ne {}} {
3665 set nextids [lindex $rowidlist [expr {$row + 1}]]
3666 foreach p $olds {
3667 set i [lsearch -exact $nextids $p]
3668 if {$i > $rmx} {
3669 set rmx $i
3670 }
3671 }
3672 }
3673 set xt [xc $row $rmx]
3674 set rowtextx($row) $xt
3675 set idpos($id) [list $x $xt $y]
3676 if {[info exists idtags($id)] || [info exists idheads($id)]
3677 || [info exists idotherrefs($id)]} {
3678 set xt [drawtags $id $x $xt $y]
3679 }
3680 set headline [lindex $commitinfo($id) 0]
3681 set name [lindex $commitinfo($id) 1]
3682 set date [lindex $commitinfo($id) 2]
3683 set date [formatdate $date]
3684 set font $mainfont
3685 set nfont $mainfont
3686 set isbold [ishighlighted $row]
3687 if {$isbold > 0} {
3688 lappend boldrows $row
3689 lappend font bold
3690 if {$isbold > 1} {
3691 lappend boldnamerows $row
3692 lappend nfont bold
3693 }
3694 }
3695 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3696 -text $headline -font $font -tags text]
3697 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3698 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3699 -text $name -font $nfont -tags text]
3700 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3701 -text $date -font $mainfont -tags text]
3702 if {[info exists selectedline] && $selectedline == $row} {
3703 make_secsel $row
3704 }
3705 set xr [expr {$xt + [font measure $mainfont $headline]}]
3706 if {$xr > $canvxmax} {
3707 set canvxmax $xr
3708 setcanvscroll
3709 }
3710}
3711
3712proc drawcmitrow {row} {
3713 global displayorder rowidlist nrows_drawn
3714 global iddrawn markingmatches
3715 global commitinfo parentlist numcommits
3716 global filehighlight fhighlights findpattern nhighlights
3717 global hlview vhighlights
3718 global highlight_related rhighlights
3719
3720 if {$row >= $numcommits} return
3721
3722 set id [lindex $displayorder $row]
3723 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3724 askvhighlight $row $id
3725 }
3726 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3727 askfilehighlight $row $id
3728 }
3729 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3730 askfindhighlight $row $id
3731 }
3732 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3733 askrelhighlight $row $id
3734 }
3735 if {![info exists iddrawn($id)]} {
3736 set col [lsearch -exact [lindex $rowidlist $row] $id]
3737 if {$col < 0} {
3738 puts "oops, row $row id $id not in list"
3739 return
3740 }
3741 if {![info exists commitinfo($id)]} {
3742 getcommit $id
3743 }
3744 assigncolor $id
3745 drawcmittext $id $row $col
3746 set iddrawn($id) 1
3747 incr nrows_drawn
3748 }
3749 if {$markingmatches} {
3750 markrowmatches $row $id
3751 }
3752}
3753
3754proc drawcommits {row {endrow {}}} {
3755 global numcommits iddrawn displayorder curview need_redisplay
3756 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3757
3758 if {$row < 0} {
3759 set row 0
3760 }
3761 if {$endrow eq {}} {
3762 set endrow $row
3763 }
3764 if {$endrow >= $numcommits} {
3765 set endrow [expr {$numcommits - 1}]
3766 }
3767
3768 set rl1 [expr {$row - $downarrowlen - 3}]
3769 if {$rl1 < 0} {
3770 set rl1 0
3771 }
3772 set ro1 [expr {$row - 3}]
3773 if {$ro1 < 0} {
3774 set ro1 0
3775 }
3776 set r2 [expr {$endrow + $uparrowlen + 3}]
3777 if {$r2 > $numcommits} {
3778 set r2 $numcommits
3779 }
3780 for {set r $rl1} {$r < $r2} {incr r} {
3781 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3782 if {$rl1 < $r} {
3783 layoutrows $rl1 $r
3784 }
3785 set rl1 [expr {$r + 1}]
3786 }
3787 }
3788 if {$rl1 < $r} {
3789 layoutrows $rl1 $r
3790 }
3791 optimize_rows $ro1 0 $r2
3792 if {$need_redisplay || $nrows_drawn > 2000} {
3793 clear_display
3794 drawvisible
3795 }
3796
3797 # make the lines join to already-drawn rows either side
3798 set r [expr {$row - 1}]
3799 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3800 set r $row
3801 }
3802 set er [expr {$endrow + 1}]
3803 if {$er >= $numcommits ||
3804 ![info exists iddrawn([lindex $displayorder $er])]} {
3805 set er $endrow
3806 }
3807 for {} {$r <= $er} {incr r} {
3808 set id [lindex $displayorder $r]
3809 set wasdrawn [info exists iddrawn($id)]
3810 drawcmitrow $r
3811 if {$r == $er} break
3812 set nextid [lindex $displayorder [expr {$r + 1}]]
3813 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3814 catch {unset prevlines}
3815 continue
3816 }
3817 drawparentlinks $id $r
3818
3819 if {[info exists lineends($r)]} {
3820 foreach lid $lineends($r) {
3821 unset prevlines($lid)
3822 }
3823 }
3824 set rowids [lindex $rowidlist $r]
3825 foreach lid $rowids {
3826 if {$lid eq {}} continue
3827 if {$lid eq $id} {
3828 # see if this is the first child of any of its parents
3829 foreach p [lindex $parentlist $r] {
3830 if {[lsearch -exact $rowids $p] < 0} {
3831 # make this line extend up to the child
3832 set le [drawlineseg $p $r $er 0]
3833 lappend lineends($le) $p
3834 set prevlines($p) 1
3835 }
3836 }
3837 } elseif {![info exists prevlines($lid)]} {
3838 set le [drawlineseg $lid $r $er 1]
3839 lappend lineends($le) $lid
3840 set prevlines($lid) 1
3841 }
3842 }
3843 }
3844}
3845
3846proc drawfrac {f0 f1} {
3847 global canv linespc
3848
3849 set ymax [lindex [$canv cget -scrollregion] 3]
3850 if {$ymax eq {} || $ymax == 0} return
3851 set y0 [expr {int($f0 * $ymax)}]
3852 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3853 set y1 [expr {int($f1 * $ymax)}]
3854 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3855 drawcommits $row $endrow
3856}
3857
3858proc drawvisible {} {
3859 global canv
3860 eval drawfrac [$canv yview]
3861}
3862
3863proc clear_display {} {
3864 global iddrawn linesegs need_redisplay nrows_drawn
3865 global vhighlights fhighlights nhighlights rhighlights
3866
3867 allcanvs delete all
3868 catch {unset iddrawn}
3869 catch {unset linesegs}
3870 catch {unset vhighlights}
3871 catch {unset fhighlights}
3872 catch {unset nhighlights}
3873 catch {unset rhighlights}
3874 set need_redisplay 0
3875 set nrows_drawn 0
3876}
3877
3878proc findcrossings {id} {
3879 global rowidlist parentlist numcommits displayorder
3880
3881 set cross {}
3882 set ccross {}
3883 foreach {s e} [rowranges $id] {
3884 if {$e >= $numcommits} {
3885 set e [expr {$numcommits - 1}]
3886 }
3887 if {$e <= $s} continue
3888 for {set row $e} {[incr row -1] >= $s} {} {
3889 set x [lsearch -exact [lindex $rowidlist $row] $id]
3890 if {$x < 0} break
3891 set olds [lindex $parentlist $row]
3892 set kid [lindex $displayorder $row]
3893 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3894 if {$kidx < 0} continue
3895 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3896 foreach p $olds {
3897 set px [lsearch -exact $nextrow $p]
3898 if {$px < 0} continue
3899 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3900 if {[lsearch -exact $ccross $p] >= 0} continue
3901 if {$x == $px + ($kidx < $px? -1: 1)} {
3902 lappend ccross $p
3903 } elseif {[lsearch -exact $cross $p] < 0} {
3904 lappend cross $p
3905 }
3906 }
3907 }
3908 }
3909 }
3910 return [concat $ccross {{}} $cross]
3911}
3912
3913proc assigncolor {id} {
3914 global colormap colors nextcolor
3915 global commitrow parentlist children children curview
3916
3917 if {[info exists colormap($id)]} return
3918 set ncolors [llength $colors]
3919 if {[info exists children($curview,$id)]} {
3920 set kids $children($curview,$id)
3921 } else {
3922 set kids {}
3923 }
3924 if {[llength $kids] == 1} {
3925 set child [lindex $kids 0]
3926 if {[info exists colormap($child)]
3927 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3928 set colormap($id) $colormap($child)
3929 return
3930 }
3931 }
3932 set badcolors {}
3933 set origbad {}
3934 foreach x [findcrossings $id] {
3935 if {$x eq {}} {
3936 # delimiter between corner crossings and other crossings
3937 if {[llength $badcolors] >= $ncolors - 1} break
3938 set origbad $badcolors
3939 }
3940 if {[info exists colormap($x)]
3941 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3942 lappend badcolors $colormap($x)
3943 }
3944 }
3945 if {[llength $badcolors] >= $ncolors} {
3946 set badcolors $origbad
3947 }
3948 set origbad $badcolors
3949 if {[llength $badcolors] < $ncolors - 1} {
3950 foreach child $kids {
3951 if {[info exists colormap($child)]
3952 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3953 lappend badcolors $colormap($child)
3954 }
3955 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3956 if {[info exists colormap($p)]
3957 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3958 lappend badcolors $colormap($p)
3959 }
3960 }
3961 }
3962 if {[llength $badcolors] >= $ncolors} {
3963 set badcolors $origbad
3964 }
3965 }
3966 for {set i 0} {$i <= $ncolors} {incr i} {
3967 set c [lindex $colors $nextcolor]
3968 if {[incr nextcolor] >= $ncolors} {
3969 set nextcolor 0
3970 }
3971 if {[lsearch -exact $badcolors $c]} break
3972 }
3973 set colormap($id) $c
3974}
3975
3976proc bindline {t id} {
3977 global canv
3978
3979 $canv bind $t <Enter> "lineenter %x %y $id"
3980 $canv bind $t <Motion> "linemotion %x %y $id"
3981 $canv bind $t <Leave> "lineleave $id"
3982 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3983}
3984
3985proc drawtags {id x xt y1} {
3986 global idtags idheads idotherrefs mainhead
3987 global linespc lthickness
3988 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3989
3990 set marks {}
3991 set ntags 0
3992 set nheads 0
3993 if {[info exists idtags($id)]} {
3994 set marks $idtags($id)
3995 set ntags [llength $marks]
3996 }
3997 if {[info exists idheads($id)]} {
3998 set marks [concat $marks $idheads($id)]
3999 set nheads [llength $idheads($id)]
4000 }
4001 if {[info exists idotherrefs($id)]} {
4002 set marks [concat $marks $idotherrefs($id)]
4003 }
4004 if {$marks eq {}} {
4005 return $xt
4006 }
4007
4008 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4009 set yt [expr {$y1 - 0.5 * $linespc}]
4010 set yb [expr {$yt + $linespc - 1}]
4011 set xvals {}
4012 set wvals {}
4013 set i -1
4014 foreach tag $marks {
4015 incr i
4016 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4017 set wid [font measure [concat $mainfont bold] $tag]
4018 } else {
4019 set wid [font measure $mainfont $tag]
4020 }
4021 lappend xvals $xt
4022 lappend wvals $wid
4023 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4024 }
4025 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4026 -width $lthickness -fill black -tags tag.$id]
4027 $canv lower $t
4028 foreach tag $marks x $xvals wid $wvals {
4029 set xl [expr {$x + $delta}]
4030 set xr [expr {$x + $delta + $wid + $lthickness}]
4031 set font $mainfont
4032 if {[incr ntags -1] >= 0} {
4033 # draw a tag
4034 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4035 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4036 -width 1 -outline black -fill yellow -tags tag.$id]
4037 $canv bind $t <1> [list showtag $tag 1]
4038 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4039 } else {
4040 # draw a head or other ref
4041 if {[incr nheads -1] >= 0} {
4042 set col green
4043 if {$tag eq $mainhead} {
4044 lappend font bold
4045 }
4046 } else {
4047 set col "#ddddff"
4048 }
4049 set xl [expr {$xl - $delta/2}]
4050 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4051 -width 1 -outline black -fill $col -tags tag.$id
4052 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4053 set rwid [font measure $mainfont $remoteprefix]
4054 set xi [expr {$x + 1}]
4055 set yti [expr {$yt + 1}]
4056 set xri [expr {$x + $rwid}]
4057 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4058 -width 0 -fill "#ffddaa" -tags tag.$id
4059 }
4060 }
4061 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4062 -font $font -tags [list tag.$id text]]
4063 if {$ntags >= 0} {
4064 $canv bind $t <1> [list showtag $tag 1]
4065 } elseif {$nheads >= 0} {
4066 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4067 }
4068 }
4069 return $xt
4070}
4071
4072proc xcoord {i level ln} {
4073 global canvx0 xspc1 xspc2
4074
4075 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4076 if {$i > 0 && $i == $level} {
4077 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4078 } elseif {$i > $level} {
4079 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4080 }
4081 return $x
4082}
4083
4084proc show_status {msg} {
4085 global canv mainfont fgcolor
4086
4087 clear_display
4088 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
4089 -tags text -fill $fgcolor
4090}
4091
4092# Insert a new commit as the child of the commit on row $row.
4093# The new commit will be displayed on row $row and the commits
4094# on that row and below will move down one row.
4095proc insertrow {row newcmit} {
4096 global displayorder parentlist commitlisted children
4097 global commitrow curview rowidlist rowisopt rowfinal numcommits
4098 global numcommits
4099 global selectedline commitidx ordertok
4100
4101 if {$row >= $numcommits} {
4102 puts "oops, inserting new row $row but only have $numcommits rows"
4103 return
4104 }
4105 set p [lindex $displayorder $row]
4106 set displayorder [linsert $displayorder $row $newcmit]
4107 set parentlist [linsert $parentlist $row $p]
4108 set kids $children($curview,$p)
4109 lappend kids $newcmit
4110 set children($curview,$p) $kids
4111 set children($curview,$newcmit) {}
4112 set commitlisted [linsert $commitlisted $row 1]
4113 set l [llength $displayorder]
4114 for {set r $row} {$r < $l} {incr r} {
4115 set id [lindex $displayorder $r]
4116 set commitrow($curview,$id) $r
4117 }
4118 incr commitidx($curview)
4119 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4120
4121 if {$row < [llength $rowidlist]} {
4122 set idlist [lindex $rowidlist $row]
4123 if {$idlist ne {}} {
4124 if {[llength $kids] == 1} {
4125 set col [lsearch -exact $idlist $p]
4126 lset idlist $col $newcmit
4127 } else {
4128 set col [llength $idlist]
4129 lappend idlist $newcmit
4130 }
4131 }
4132 set rowidlist [linsert $rowidlist $row $idlist]
4133 set rowisopt [linsert $rowisopt $row 0]
4134 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4135 }
4136
4137 incr numcommits
4138
4139 if {[info exists selectedline] && $selectedline >= $row} {
4140 incr selectedline
4141 }
4142 redisplay
4143}
4144
4145# Remove a commit that was inserted with insertrow on row $row.
4146proc removerow {row} {
4147 global displayorder parentlist commitlisted children
4148 global commitrow curview rowidlist rowisopt rowfinal numcommits
4149 global numcommits
4150 global linesegends selectedline commitidx
4151
4152 if {$row >= $numcommits} {
4153 puts "oops, removing row $row but only have $numcommits rows"
4154 return
4155 }
4156 set rp1 [expr {$row + 1}]
4157 set id [lindex $displayorder $row]
4158 set p [lindex $parentlist $row]
4159 set displayorder [lreplace $displayorder $row $row]
4160 set parentlist [lreplace $parentlist $row $row]
4161 set commitlisted [lreplace $commitlisted $row $row]
4162 set kids $children($curview,$p)
4163 set i [lsearch -exact $kids $id]
4164 if {$i >= 0} {
4165 set kids [lreplace $kids $i $i]
4166 set children($curview,$p) $kids
4167 }
4168 set l [llength $displayorder]
4169 for {set r $row} {$r < $l} {incr r} {
4170 set id [lindex $displayorder $r]
4171 set commitrow($curview,$id) $r
4172 }
4173 incr commitidx($curview) -1
4174
4175 if {$row < [llength $rowidlist]} {
4176 set rowidlist [lreplace $rowidlist $row $row]
4177 set rowisopt [lreplace $rowisopt $row $row]
4178 set rowfinal [lreplace $rowfinal $row $row]
4179 }
4180
4181 incr numcommits -1
4182
4183 if {[info exists selectedline] && $selectedline > $row} {
4184 incr selectedline -1
4185 }
4186 redisplay
4187}
4188
4189# Don't change the text pane cursor if it is currently the hand cursor,
4190# showing that we are over a sha1 ID link.
4191proc settextcursor {c} {
4192 global ctext curtextcursor
4193
4194 if {[$ctext cget -cursor] == $curtextcursor} {
4195 $ctext config -cursor $c
4196 }
4197 set curtextcursor $c
4198}
4199
4200proc nowbusy {what} {
4201 global isbusy
4202
4203 if {[array names isbusy] eq {}} {
4204 . config -cursor watch
4205 settextcursor watch
4206 }
4207 set isbusy($what) 1
4208}
4209
4210proc notbusy {what} {
4211 global isbusy maincursor textcursor
4212
4213 catch {unset isbusy($what)}
4214 if {[array names isbusy] eq {}} {
4215 . config -cursor $maincursor
4216 settextcursor $textcursor
4217 }
4218}
4219
4220proc findmatches {f} {
4221 global findtype findstring
4222 if {$findtype == "Regexp"} {
4223 set matches [regexp -indices -all -inline $findstring $f]
4224 } else {
4225 set fs $findstring
4226 if {$findtype == "IgnCase"} {
4227 set f [string tolower $f]
4228 set fs [string tolower $fs]
4229 }
4230 set matches {}
4231 set i 0
4232 set l [string length $fs]
4233 while {[set j [string first $fs $f $i]] >= 0} {
4234 lappend matches [list $j [expr {$j+$l-1}]]
4235 set i [expr {$j + $l}]
4236 }
4237 }
4238 return $matches
4239}
4240
4241proc dofind {{rev 0}} {
4242 global findstring findstartline findcurline selectedline numcommits
4243 global gdttype filehighlight fh_serial find_dirn
4244
4245 unmarkmatches
4246 focus .
4247 if {$findstring eq {} || $numcommits == 0} return
4248 if {![info exists selectedline]} {
4249 set findstartline [lindex [visiblerows] $rev]
4250 } else {
4251 set findstartline $selectedline
4252 }
4253 set findcurline $findstartline
4254 nowbusy finding
4255 if {$gdttype ne "containing:" && ![info exists filehighlight]} {
4256 after cancel do_file_hl $fh_serial
4257 do_file_hl $fh_serial
4258 }
4259 if {!$rev} {
4260 set find_dirn 1
4261 run findmore
4262 } else {
4263 set find_dirn -1
4264 run findmorerev
4265 }
4266}
4267
4268proc stopfinding {} {
4269 global find_dirn findcurline fprogcoord
4270
4271 if {[info exists find_dirn]} {
4272 unset find_dirn
4273 unset findcurline
4274 notbusy finding
4275 set fprogcoord 0
4276 adjustprogress
4277 }
4278}
4279
4280proc findnext {restart} {
4281 global findcurline find_dirn
4282
4283 if {[info exists find_dirn]} return
4284 set find_dirn 1
4285 if {![info exists findcurline]} {
4286 if {$restart} {
4287 dofind
4288 } else {
4289 bell
4290 }
4291 } else {
4292 run findmore
4293 nowbusy finding
4294 }
4295}
4296
4297proc findprev {} {
4298 global findcurline find_dirn
4299
4300 if {[info exists find_dirn]} return
4301 set find_dirn -1
4302 if {![info exists findcurline]} {
4303 dofind 1
4304 } else {
4305 run findmorerev
4306 nowbusy finding
4307 }
4308}
4309
4310proc findmore {} {
4311 global commitdata commitinfo numcommits findpattern findloc
4312 global findstartline findcurline displayorder
4313 global find_dirn gdttype fhighlights fprogcoord
4314
4315 if {![info exists find_dirn]} {
4316 return 0
4317 }
4318 set fldtypes {Headline Author Date Committer CDate Comments}
4319 set l [expr {$findcurline + 1}]
4320 if {$l >= $numcommits} {
4321 set l 0
4322 }
4323 if {$l <= $findstartline} {
4324 set lim [expr {$findstartline + 1}]
4325 } else {
4326 set lim $numcommits
4327 }
4328 if {$lim - $l > 500} {
4329 set lim [expr {$l + 500}]
4330 }
4331 set found 0
4332 set domore 1
4333 if {$gdttype eq "containing:"} {
4334 for {} {$l < $lim} {incr l} {
4335 set id [lindex $displayorder $l]
4336 # shouldn't happen unless git log doesn't give all the commits...
4337 if {![info exists commitdata($id)]} continue
4338 if {![doesmatch $commitdata($id)]} continue
4339 if {![info exists commitinfo($id)]} {
4340 getcommit $id
4341 }
4342 set info $commitinfo($id)
4343 foreach f $info ty $fldtypes {
4344 if {($findloc eq "All fields" || $findloc eq $ty) &&
4345 [doesmatch $f]} {
4346 set found 1
4347 break
4348 }
4349 }
4350 if {$found} break
4351 }
4352 } else {
4353 for {} {$l < $lim} {incr l} {
4354 set id [lindex $displayorder $l]
4355 if {![info exists fhighlights($l)]} {
4356 askfilehighlight $l $id
4357 if {$domore} {
4358 set domore 0
4359 set findcurline [expr {$l - 1}]
4360 }
4361 } elseif {$fhighlights($l)} {
4362 set found $domore
4363 break
4364 }
4365 }
4366 }
4367 if {$found || ($domore && $l == $findstartline + 1)} {
4368 unset findcurline
4369 unset find_dirn
4370 notbusy finding
4371 set fprogcoord 0
4372 adjustprogress
4373 if {$found} {
4374 findselectline $l
4375 } else {
4376 bell
4377 }
4378 return 0
4379 }
4380 if {!$domore} {
4381 flushhighlights
4382 } else {
4383 set findcurline [expr {$l - 1}]
4384 }
4385 set n [expr {$findcurline - ($findstartline + 1)}]
4386 if {$n < 0} {
4387 incr n $numcommits
4388 }
4389 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4390 adjustprogress
4391 return $domore
4392}
4393
4394proc findmorerev {} {
4395 global commitdata commitinfo numcommits findpattern findloc
4396 global findstartline findcurline displayorder
4397 global find_dirn gdttype fhighlights fprogcoord
4398
4399 if {![info exists find_dirn]} {
4400 return 0
4401 }
4402 set fldtypes {Headline Author Date Committer CDate Comments}
4403 set l $findcurline
4404 if {$l == 0} {
4405 set l $numcommits
4406 }
4407 incr l -1
4408 if {$l >= $findstartline} {
4409 set lim [expr {$findstartline - 1}]
4410 } else {
4411 set lim -1
4412 }
4413 if {$l - $lim > 500} {
4414 set lim [expr {$l - 500}]
4415 }
4416 set found 0
4417 set domore 1
4418 if {$gdttype eq "containing:"} {
4419 for {} {$l > $lim} {incr l -1} {
4420 set id [lindex $displayorder $l]
4421 if {![info exists commitdata($id)]} continue
4422 if {![doesmatch $commitdata($id)]} continue
4423 if {![info exists commitinfo($id)]} {
4424 getcommit $id
4425 }
4426 set info $commitinfo($id)
4427 foreach f $info ty $fldtypes {
4428 if {($findloc eq "All fields" || $findloc eq $ty) &&
4429 [doesmatch $f]} {
4430 set found 1
4431 break
4432 }
4433 }
4434 if {$found} break
4435 }
4436 } else {
4437 for {} {$l > $lim} {incr l -1} {
4438 set id [lindex $displayorder $l]
4439 if {![info exists fhighlights($l)]} {
4440 askfilehighlight $l $id
4441 if {$domore} {
4442 set domore 0
4443 set findcurline [expr {$l + 1}]
4444 }
4445 } elseif {$fhighlights($l)} {
4446 set found $domore
4447 break
4448 }
4449 }
4450 }
4451 if {$found || ($domore && $l == $findstartline - 1)} {
4452 unset findcurline
4453 unset find_dirn
4454 notbusy finding
4455 set fprogcoord 0
4456 adjustprogress
4457 if {$found} {
4458 findselectline $l
4459 } else {
4460 bell
4461 }
4462 return 0
4463 }
4464 if {!$domore} {
4465 flushhighlights
4466 } else {
4467 set findcurline [expr {$l + 1}]
4468 }
4469 set n [expr {($findstartline - 1) - $findcurline}]
4470 if {$n < 0} {
4471 incr n $numcommits
4472 }
4473 set fprogcoord [expr {$n * 1.0 / $numcommits}]
4474 adjustprogress
4475 return $domore
4476}
4477
4478proc findselectline {l} {
4479 global findloc commentend ctext findcurline markingmatches gdttype
4480
4481 set markingmatches 1
4482 set findcurline $l
4483 selectline $l 1
4484 if {$findloc == "All fields" || $findloc == "Comments"} {
4485 # highlight the matches in the comments
4486 set f [$ctext get 1.0 $commentend]
4487 set matches [findmatches $f]
4488 foreach match $matches {
4489 set start [lindex $match 0]
4490 set end [expr {[lindex $match 1] + 1}]
4491 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4492 }
4493 }
4494 drawvisible
4495}
4496
4497# mark the bits of a headline or author that match a find string
4498proc markmatches {canv l str tag matches font row} {
4499 global selectedline
4500
4501 set bbox [$canv bbox $tag]
4502 set x0 [lindex $bbox 0]
4503 set y0 [lindex $bbox 1]
4504 set y1 [lindex $bbox 3]
4505 foreach match $matches {
4506 set start [lindex $match 0]
4507 set end [lindex $match 1]
4508 if {$start > $end} continue
4509 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4510 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4511 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4512 [expr {$x0+$xlen+2}] $y1 \
4513 -outline {} -tags [list match$l matches] -fill yellow]
4514 $canv lower $t
4515 if {[info exists selectedline] && $row == $selectedline} {
4516 $canv raise $t secsel
4517 }
4518 }
4519}
4520
4521proc unmarkmatches {} {
4522 global markingmatches
4523
4524 allcanvs delete matches
4525 set markingmatches 0
4526 stopfinding
4527}
4528
4529proc selcanvline {w x y} {
4530 global canv canvy0 ctext linespc
4531 global rowtextx
4532 set ymax [lindex [$canv cget -scrollregion] 3]
4533 if {$ymax == {}} return
4534 set yfrac [lindex [$canv yview] 0]
4535 set y [expr {$y + $yfrac * $ymax}]
4536 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4537 if {$l < 0} {
4538 set l 0
4539 }
4540 if {$w eq $canv} {
4541 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4542 }
4543 unmarkmatches
4544 selectline $l 1
4545}
4546
4547proc commit_descriptor {p} {
4548 global commitinfo
4549 if {![info exists commitinfo($p)]} {
4550 getcommit $p
4551 }
4552 set l "..."
4553 if {[llength $commitinfo($p)] > 1} {
4554 set l [lindex $commitinfo($p) 0]
4555 }
4556 return "$p ($l)\n"
4557}
4558
4559# append some text to the ctext widget, and make any SHA1 ID
4560# that we know about be a clickable link.
4561proc appendwithlinks {text tags} {
4562 global ctext commitrow linknum curview pendinglinks
4563
4564 set start [$ctext index "end - 1c"]
4565 $ctext insert end $text $tags
4566 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4567 foreach l $links {
4568 set s [lindex $l 0]
4569 set e [lindex $l 1]
4570 set linkid [string range $text $s $e]
4571 incr e
4572 $ctext tag delete link$linknum
4573 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4574 setlink $linkid link$linknum
4575 incr linknum
4576 }
4577}
4578
4579proc setlink {id lk} {
4580 global curview commitrow ctext pendinglinks commitinterest
4581
4582 if {[info exists commitrow($curview,$id)]} {
4583 $ctext tag conf $lk -foreground blue -underline 1
4584 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4585 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4586 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4587 } else {
4588 lappend pendinglinks($id) $lk
4589 lappend commitinterest($id) {makelink %I}
4590 }
4591}
4592
4593proc makelink {id} {
4594 global pendinglinks
4595
4596 if {![info exists pendinglinks($id)]} return
4597 foreach lk $pendinglinks($id) {
4598 setlink $id $lk
4599 }
4600 unset pendinglinks($id)
4601}
4602
4603proc linkcursor {w inc} {
4604 global linkentercount curtextcursor
4605
4606 if {[incr linkentercount $inc] > 0} {
4607 $w configure -cursor hand2
4608 } else {
4609 $w configure -cursor $curtextcursor
4610 if {$linkentercount < 0} {
4611 set linkentercount 0
4612 }
4613 }
4614}
4615
4616proc viewnextline {dir} {
4617 global canv linespc
4618
4619 $canv delete hover
4620 set ymax [lindex [$canv cget -scrollregion] 3]
4621 set wnow [$canv yview]
4622 set wtop [expr {[lindex $wnow 0] * $ymax}]
4623 set newtop [expr {$wtop + $dir * $linespc}]
4624 if {$newtop < 0} {
4625 set newtop 0
4626 } elseif {$newtop > $ymax} {
4627 set newtop $ymax
4628 }
4629 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4630}
4631
4632# add a list of tag or branch names at position pos
4633# returns the number of names inserted
4634proc appendrefs {pos ids var} {
4635 global ctext commitrow linknum curview $var maxrefs
4636
4637 if {[catch {$ctext index $pos}]} {
4638 return 0
4639 }
4640 $ctext conf -state normal
4641 $ctext delete $pos "$pos lineend"
4642 set tags {}
4643 foreach id $ids {
4644 foreach tag [set $var\($id\)] {
4645 lappend tags [list $tag $id]
4646 }
4647 }
4648 if {[llength $tags] > $maxrefs} {
4649 $ctext insert $pos "many ([llength $tags])"
4650 } else {
4651 set tags [lsort -index 0 -decreasing $tags]
4652 set sep {}
4653 foreach ti $tags {
4654 set id [lindex $ti 1]
4655 set lk link$linknum
4656 incr linknum
4657 $ctext tag delete $lk
4658 $ctext insert $pos $sep
4659 $ctext insert $pos [lindex $ti 0] $lk
4660 setlink $id $lk
4661 set sep ", "
4662 }
4663 }
4664 $ctext conf -state disabled
4665 return [llength $tags]
4666}
4667
4668# called when we have finished computing the nearby tags
4669proc dispneartags {delay} {
4670 global selectedline currentid showneartags tagphase
4671
4672 if {![info exists selectedline] || !$showneartags} return
4673 after cancel dispnexttag
4674 if {$delay} {
4675 after 200 dispnexttag
4676 set tagphase -1
4677 } else {
4678 after idle dispnexttag
4679 set tagphase 0
4680 }
4681}
4682
4683proc dispnexttag {} {
4684 global selectedline currentid showneartags tagphase ctext
4685
4686 if {![info exists selectedline] || !$showneartags} return
4687 switch -- $tagphase {
4688 0 {
4689 set dtags [desctags $currentid]
4690 if {$dtags ne {}} {
4691 appendrefs precedes $dtags idtags
4692 }
4693 }
4694 1 {
4695 set atags [anctags $currentid]
4696 if {$atags ne {}} {
4697 appendrefs follows $atags idtags
4698 }
4699 }
4700 2 {
4701 set dheads [descheads $currentid]
4702 if {$dheads ne {}} {
4703 if {[appendrefs branch $dheads idheads] > 1
4704 && [$ctext get "branch -3c"] eq "h"} {
4705 # turn "Branch" into "Branches"
4706 $ctext conf -state normal
4707 $ctext insert "branch -2c" "es"
4708 $ctext conf -state disabled
4709 }
4710 }
4711 }
4712 }
4713 if {[incr tagphase] <= 2} {
4714 after idle dispnexttag
4715 }
4716}
4717
4718proc make_secsel {l} {
4719 global linehtag linentag linedtag canv canv2 canv3
4720
4721 if {![info exists linehtag($l)]} return
4722 $canv delete secsel
4723 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4724 -tags secsel -fill [$canv cget -selectbackground]]
4725 $canv lower $t
4726 $canv2 delete secsel
4727 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4728 -tags secsel -fill [$canv2 cget -selectbackground]]
4729 $canv2 lower $t
4730 $canv3 delete secsel
4731 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4732 -tags secsel -fill [$canv3 cget -selectbackground]]
4733 $canv3 lower $t
4734}
4735
4736proc selectline {l isnew} {
4737 global canv ctext commitinfo selectedline
4738 global displayorder
4739 global canvy0 linespc parentlist children curview
4740 global currentid sha1entry
4741 global commentend idtags linknum
4742 global mergemax numcommits pending_select
4743 global cmitmode showneartags allcommits
4744
4745 catch {unset pending_select}
4746 $canv delete hover
4747 normalline
4748 unsel_reflist
4749 stopfinding
4750 if {$l < 0 || $l >= $numcommits} return
4751 set y [expr {$canvy0 + $l * $linespc}]
4752 set ymax [lindex [$canv cget -scrollregion] 3]
4753 set ytop [expr {$y - $linespc - 1}]
4754 set ybot [expr {$y + $linespc + 1}]
4755 set wnow [$canv yview]
4756 set wtop [expr {[lindex $wnow 0] * $ymax}]
4757 set wbot [expr {[lindex $wnow 1] * $ymax}]
4758 set wh [expr {$wbot - $wtop}]
4759 set newtop $wtop
4760 if {$ytop < $wtop} {
4761 if {$ybot < $wtop} {
4762 set newtop [expr {$y - $wh / 2.0}]
4763 } else {
4764 set newtop $ytop
4765 if {$newtop > $wtop - $linespc} {
4766 set newtop [expr {$wtop - $linespc}]
4767 }
4768 }
4769 } elseif {$ybot > $wbot} {
4770 if {$ytop > $wbot} {
4771 set newtop [expr {$y - $wh / 2.0}]
4772 } else {
4773 set newtop [expr {$ybot - $wh}]
4774 if {$newtop < $wtop + $linespc} {
4775 set newtop [expr {$wtop + $linespc}]
4776 }
4777 }
4778 }
4779 if {$newtop != $wtop} {
4780 if {$newtop < 0} {
4781 set newtop 0
4782 }
4783 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4784 drawvisible
4785 }
4786
4787 make_secsel $l
4788
4789 if {$isnew} {
4790 addtohistory [list selectline $l 0]
4791 }
4792
4793 set selectedline $l
4794
4795 set id [lindex $displayorder $l]
4796 set currentid $id
4797 $sha1entry delete 0 end
4798 $sha1entry insert 0 $id
4799 $sha1entry selection from 0
4800 $sha1entry selection to end
4801 rhighlight_sel $id
4802
4803 $ctext conf -state normal
4804 clear_ctext
4805 set linknum 0
4806 set info $commitinfo($id)
4807 set date [formatdate [lindex $info 2]]
4808 $ctext insert end "Author: [lindex $info 1] $date\n"
4809 set date [formatdate [lindex $info 4]]
4810 $ctext insert end "Committer: [lindex $info 3] $date\n"
4811 if {[info exists idtags($id)]} {
4812 $ctext insert end "Tags:"
4813 foreach tag $idtags($id) {
4814 $ctext insert end " $tag"
4815 }
4816 $ctext insert end "\n"
4817 }
4818
4819 set headers {}
4820 set olds [lindex $parentlist $l]
4821 if {[llength $olds] > 1} {
4822 set np 0
4823 foreach p $olds {
4824 if {$np >= $mergemax} {
4825 set tag mmax
4826 } else {
4827 set tag m$np
4828 }
4829 $ctext insert end "Parent: " $tag
4830 appendwithlinks [commit_descriptor $p] {}
4831 incr np
4832 }
4833 } else {
4834 foreach p $olds {
4835 append headers "Parent: [commit_descriptor $p]"
4836 }
4837 }
4838
4839 foreach c $children($curview,$id) {
4840 append headers "Child: [commit_descriptor $c]"
4841 }
4842
4843 # make anything that looks like a SHA1 ID be a clickable link
4844 appendwithlinks $headers {}
4845 if {$showneartags} {
4846 if {![info exists allcommits]} {
4847 getallcommits
4848 }
4849 $ctext insert end "Branch: "
4850 $ctext mark set branch "end -1c"
4851 $ctext mark gravity branch left
4852 $ctext insert end "\nFollows: "
4853 $ctext mark set follows "end -1c"
4854 $ctext mark gravity follows left
4855 $ctext insert end "\nPrecedes: "
4856 $ctext mark set precedes "end -1c"
4857 $ctext mark gravity precedes left
4858 $ctext insert end "\n"
4859 dispneartags 1
4860 }
4861 $ctext insert end "\n"
4862 set comment [lindex $info 5]
4863 if {[string first "\r" $comment] >= 0} {
4864 set comment [string map {"\r" "\n "} $comment]
4865 }
4866 appendwithlinks $comment {comment}
4867
4868 $ctext tag remove found 1.0 end
4869 $ctext conf -state disabled
4870 set commentend [$ctext index "end - 1c"]
4871
4872 init_flist "Comments"
4873 if {$cmitmode eq "tree"} {
4874 gettree $id
4875 } elseif {[llength $olds] <= 1} {
4876 startdiff $id
4877 } else {
4878 mergediff $id $l
4879 }
4880}
4881
4882proc selfirstline {} {
4883 unmarkmatches
4884 selectline 0 1
4885}
4886
4887proc sellastline {} {
4888 global numcommits
4889 unmarkmatches
4890 set l [expr {$numcommits - 1}]
4891 selectline $l 1
4892}
4893
4894proc selnextline {dir} {
4895 global selectedline
4896 focus .
4897 if {![info exists selectedline]} return
4898 set l [expr {$selectedline + $dir}]
4899 unmarkmatches
4900 selectline $l 1
4901}
4902
4903proc selnextpage {dir} {
4904 global canv linespc selectedline numcommits
4905
4906 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4907 if {$lpp < 1} {
4908 set lpp 1
4909 }
4910 allcanvs yview scroll [expr {$dir * $lpp}] units
4911 drawvisible
4912 if {![info exists selectedline]} return
4913 set l [expr {$selectedline + $dir * $lpp}]
4914 if {$l < 0} {
4915 set l 0
4916 } elseif {$l >= $numcommits} {
4917 set l [expr $numcommits - 1]
4918 }
4919 unmarkmatches
4920 selectline $l 1
4921}
4922
4923proc unselectline {} {
4924 global selectedline currentid
4925
4926 catch {unset selectedline}
4927 catch {unset currentid}
4928 allcanvs delete secsel
4929 rhighlight_none
4930}
4931
4932proc reselectline {} {
4933 global selectedline
4934
4935 if {[info exists selectedline]} {
4936 selectline $selectedline 0
4937 }
4938}
4939
4940proc addtohistory {cmd} {
4941 global history historyindex curview
4942
4943 set elt [list $curview $cmd]
4944 if {$historyindex > 0
4945 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4946 return
4947 }
4948
4949 if {$historyindex < [llength $history]} {
4950 set history [lreplace $history $historyindex end $elt]
4951 } else {
4952 lappend history $elt
4953 }
4954 incr historyindex
4955 if {$historyindex > 1} {
4956 .tf.bar.leftbut conf -state normal
4957 } else {
4958 .tf.bar.leftbut conf -state disabled
4959 }
4960 .tf.bar.rightbut conf -state disabled
4961}
4962
4963proc godo {elt} {
4964 global curview
4965
4966 set view [lindex $elt 0]
4967 set cmd [lindex $elt 1]
4968 if {$curview != $view} {
4969 showview $view
4970 }
4971 eval $cmd
4972}
4973
4974proc goback {} {
4975 global history historyindex
4976 focus .
4977
4978 if {$historyindex > 1} {
4979 incr historyindex -1
4980 godo [lindex $history [expr {$historyindex - 1}]]
4981 .tf.bar.rightbut conf -state normal
4982 }
4983 if {$historyindex <= 1} {
4984 .tf.bar.leftbut conf -state disabled
4985 }
4986}
4987
4988proc goforw {} {
4989 global history historyindex
4990 focus .
4991
4992 if {$historyindex < [llength $history]} {
4993 set cmd [lindex $history $historyindex]
4994 incr historyindex
4995 godo $cmd
4996 .tf.bar.leftbut conf -state normal
4997 }
4998 if {$historyindex >= [llength $history]} {
4999 .tf.bar.rightbut conf -state disabled
5000 }
5001}
5002
5003proc gettree {id} {
5004 global treefilelist treeidlist diffids diffmergeid treepending
5005 global nullid nullid2
5006
5007 set diffids $id
5008 catch {unset diffmergeid}
5009 if {![info exists treefilelist($id)]} {
5010 if {![info exists treepending]} {
5011 if {$id eq $nullid} {
5012 set cmd [list | git ls-files]
5013 } elseif {$id eq $nullid2} {
5014 set cmd [list | git ls-files --stage -t]
5015 } else {
5016 set cmd [list | git ls-tree -r $id]
5017 }
5018 if {[catch {set gtf [open $cmd r]}]} {
5019 return
5020 }
5021 set treepending $id
5022 set treefilelist($id) {}
5023 set treeidlist($id) {}
5024 fconfigure $gtf -blocking 0
5025 filerun $gtf [list gettreeline $gtf $id]
5026 }
5027 } else {
5028 setfilelist $id
5029 }
5030}
5031
5032proc gettreeline {gtf id} {
5033 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5034
5035 set nl 0
5036 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5037 if {$diffids eq $nullid} {
5038 set fname $line
5039 } else {
5040 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5041 set i [string first "\t" $line]
5042 if {$i < 0} continue
5043 set sha1 [lindex $line 2]
5044 set fname [string range $line [expr {$i+1}] end]
5045 if {[string index $fname 0] eq "\""} {
5046 set fname [lindex $fname 0]
5047 }
5048 lappend treeidlist($id) $sha1
5049 }
5050 lappend treefilelist($id) $fname
5051 }
5052 if {![eof $gtf]} {
5053 return [expr {$nl >= 1000? 2: 1}]
5054 }
5055 close $gtf
5056 unset treepending
5057 if {$cmitmode ne "tree"} {
5058 if {![info exists diffmergeid]} {
5059 gettreediffs $diffids
5060 }
5061 } elseif {$id ne $diffids} {
5062 gettree $diffids
5063 } else {
5064 setfilelist $id
5065 }
5066 return 0
5067}
5068
5069proc showfile {f} {
5070 global treefilelist treeidlist diffids nullid nullid2
5071 global ctext commentend
5072
5073 set i [lsearch -exact $treefilelist($diffids) $f]
5074 if {$i < 0} {
5075 puts "oops, $f not in list for id $diffids"
5076 return
5077 }
5078 if {$diffids eq $nullid} {
5079 if {[catch {set bf [open $f r]} err]} {
5080 puts "oops, can't read $f: $err"
5081 return
5082 }
5083 } else {
5084 set blob [lindex $treeidlist($diffids) $i]
5085 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5086 puts "oops, error reading blob $blob: $err"
5087 return
5088 }
5089 }
5090 fconfigure $bf -blocking 0
5091 filerun $bf [list getblobline $bf $diffids]
5092 $ctext config -state normal
5093 clear_ctext $commentend
5094 $ctext insert end "\n"
5095 $ctext insert end "$f\n" filesep
5096 $ctext config -state disabled
5097 $ctext yview $commentend
5098 settabs 0
5099}
5100
5101proc getblobline {bf id} {
5102 global diffids cmitmode ctext
5103
5104 if {$id ne $diffids || $cmitmode ne "tree"} {
5105 catch {close $bf}
5106 return 0
5107 }
5108 $ctext config -state normal
5109 set nl 0
5110 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5111 $ctext insert end "$line\n"
5112 }
5113 if {[eof $bf]} {
5114 # delete last newline
5115 $ctext delete "end - 2c" "end - 1c"
5116 close $bf
5117 return 0
5118 }
5119 $ctext config -state disabled
5120 return [expr {$nl >= 1000? 2: 1}]
5121}
5122
5123proc mergediff {id l} {
5124 global diffmergeid diffopts mdifffd
5125 global diffids
5126 global parentlist
5127
5128 set diffmergeid $id
5129 set diffids $id
5130 # this doesn't seem to actually affect anything...
5131 set env(GIT_DIFF_OPTS) $diffopts
5132 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5133 if {[catch {set mdf [open $cmd r]} err]} {
5134 error_popup "Error getting merge diffs: $err"
5135 return
5136 }
5137 fconfigure $mdf -blocking 0
5138 set mdifffd($id) $mdf
5139 set np [llength [lindex $parentlist $l]]
5140 settabs $np
5141 filerun $mdf [list getmergediffline $mdf $id $np]
5142}
5143
5144proc getmergediffline {mdf id np} {
5145 global diffmergeid ctext cflist mergemax
5146 global difffilestart mdifffd
5147
5148 $ctext conf -state normal
5149 set nr 0
5150 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5151 if {![info exists diffmergeid] || $id != $diffmergeid
5152 || $mdf != $mdifffd($id)} {
5153 close $mdf
5154 return 0
5155 }
5156 if {[regexp {^diff --cc (.*)} $line match fname]} {
5157 # start of a new file
5158 $ctext insert end "\n"
5159 set here [$ctext index "end - 1c"]
5160 lappend difffilestart $here
5161 add_flist [list $fname]
5162 set l [expr {(78 - [string length $fname]) / 2}]
5163 set pad [string range "----------------------------------------" 1 $l]
5164 $ctext insert end "$pad $fname $pad\n" filesep
5165 } elseif {[regexp {^@@} $line]} {
5166 $ctext insert end "$line\n" hunksep
5167 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5168 # do nothing
5169 } else {
5170 # parse the prefix - one ' ', '-' or '+' for each parent
5171 set spaces {}
5172 set minuses {}
5173 set pluses {}
5174 set isbad 0
5175 for {set j 0} {$j < $np} {incr j} {
5176 set c [string range $line $j $j]
5177 if {$c == " "} {
5178 lappend spaces $j
5179 } elseif {$c == "-"} {
5180 lappend minuses $j
5181 } elseif {$c == "+"} {
5182 lappend pluses $j
5183 } else {
5184 set isbad 1
5185 break
5186 }
5187 }
5188 set tags {}
5189 set num {}
5190 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5191 # line doesn't appear in result, parents in $minuses have the line
5192 set num [lindex $minuses 0]
5193 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5194 # line appears in result, parents in $pluses don't have the line
5195 lappend tags mresult
5196 set num [lindex $spaces 0]
5197 }
5198 if {$num ne {}} {
5199 if {$num >= $mergemax} {
5200 set num "max"
5201 }
5202 lappend tags m$num
5203 }
5204 $ctext insert end "$line\n" $tags
5205 }
5206 }
5207 $ctext conf -state disabled
5208 if {[eof $mdf]} {
5209 close $mdf
5210 return 0
5211 }
5212 return [expr {$nr >= 1000? 2: 1}]
5213}
5214
5215proc startdiff {ids} {
5216 global treediffs diffids treepending diffmergeid nullid nullid2
5217
5218 settabs 1
5219 set diffids $ids
5220 catch {unset diffmergeid}
5221 if {![info exists treediffs($ids)] ||
5222 [lsearch -exact $ids $nullid] >= 0 ||
5223 [lsearch -exact $ids $nullid2] >= 0} {
5224 if {![info exists treepending]} {
5225 gettreediffs $ids
5226 }
5227 } else {
5228 addtocflist $ids
5229 }
5230}
5231
5232proc addtocflist {ids} {
5233 global treediffs cflist
5234 add_flist $treediffs($ids)
5235 getblobdiffs $ids
5236}
5237
5238proc diffcmd {ids flags} {
5239 global nullid nullid2
5240
5241 set i [lsearch -exact $ids $nullid]
5242 set j [lsearch -exact $ids $nullid2]
5243 if {$i >= 0} {
5244 if {[llength $ids] > 1 && $j < 0} {
5245 # comparing working directory with some specific revision
5246 set cmd [concat | git diff-index $flags]
5247 if {$i == 0} {
5248 lappend cmd -R [lindex $ids 1]
5249 } else {
5250 lappend cmd [lindex $ids 0]
5251 }
5252 } else {
5253 # comparing working directory with index
5254 set cmd [concat | git diff-files $flags]
5255 if {$j == 1} {
5256 lappend cmd -R
5257 }
5258 }
5259 } elseif {$j >= 0} {
5260 set cmd [concat | git diff-index --cached $flags]
5261 if {[llength $ids] > 1} {
5262 # comparing index with specific revision
5263 if {$i == 0} {
5264 lappend cmd -R [lindex $ids 1]
5265 } else {
5266 lappend cmd [lindex $ids 0]
5267 }
5268 } else {
5269 # comparing index with HEAD
5270 lappend cmd HEAD
5271 }
5272 } else {
5273 set cmd [concat | git diff-tree -r $flags $ids]
5274 }
5275 return $cmd
5276}
5277
5278proc gettreediffs {ids} {
5279 global treediff treepending
5280
5281 set treepending $ids
5282 set treediff {}
5283 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5284 fconfigure $gdtf -blocking 0
5285 filerun $gdtf [list gettreediffline $gdtf $ids]
5286}
5287
5288proc gettreediffline {gdtf ids} {
5289 global treediff treediffs treepending diffids diffmergeid
5290 global cmitmode
5291
5292 set nr 0
5293 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5294 set i [string first "\t" $line]
5295 if {$i >= 0} {
5296 set file [string range $line [expr {$i+1}] end]
5297 if {[string index $file 0] eq "\""} {
5298 set file [lindex $file 0]
5299 }
5300 lappend treediff $file
5301 }
5302 }
5303 if {![eof $gdtf]} {
5304 return [expr {$nr >= 1000? 2: 1}]
5305 }
5306 close $gdtf
5307 set treediffs($ids) $treediff
5308 unset treepending
5309 if {$cmitmode eq "tree"} {
5310 gettree $diffids
5311 } elseif {$ids != $diffids} {
5312 if {![info exists diffmergeid]} {
5313 gettreediffs $diffids
5314 }
5315 } else {
5316 addtocflist $ids
5317 }
5318 return 0
5319}
5320
5321# empty string or positive integer
5322proc diffcontextvalidate {v} {
5323 return [regexp {^(|[1-9][0-9]*)$} $v]
5324}
5325
5326proc diffcontextchange {n1 n2 op} {
5327 global diffcontextstring diffcontext
5328
5329 if {[string is integer -strict $diffcontextstring]} {
5330 if {$diffcontextstring > 0} {
5331 set diffcontext $diffcontextstring
5332 reselectline
5333 }
5334 }
5335}
5336
5337proc getblobdiffs {ids} {
5338 global diffopts blobdifffd diffids env
5339 global diffinhdr treediffs
5340 global diffcontext
5341
5342 set env(GIT_DIFF_OPTS) $diffopts
5343 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5344 puts "error getting diffs: $err"
5345 return
5346 }
5347 set diffinhdr 0
5348 fconfigure $bdf -blocking 0
5349 set blobdifffd($ids) $bdf
5350 filerun $bdf [list getblobdiffline $bdf $diffids]
5351}
5352
5353proc setinlist {var i val} {
5354 global $var
5355
5356 while {[llength [set $var]] < $i} {
5357 lappend $var {}
5358 }
5359 if {[llength [set $var]] == $i} {
5360 lappend $var $val
5361 } else {
5362 lset $var $i $val
5363 }
5364}
5365
5366proc makediffhdr {fname ids} {
5367 global ctext curdiffstart treediffs
5368
5369 set i [lsearch -exact $treediffs($ids) $fname]
5370 if {$i >= 0} {
5371 setinlist difffilestart $i $curdiffstart
5372 }
5373 set l [expr {(78 - [string length $fname]) / 2}]
5374 set pad [string range "----------------------------------------" 1 $l]
5375 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5376}
5377
5378proc getblobdiffline {bdf ids} {
5379 global diffids blobdifffd ctext curdiffstart
5380 global diffnexthead diffnextnote difffilestart
5381 global diffinhdr treediffs
5382
5383 set nr 0
5384 $ctext conf -state normal
5385 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5386 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5387 close $bdf
5388 return 0
5389 }
5390 if {![string compare -length 11 "diff --git " $line]} {
5391 # trim off "diff --git "
5392 set line [string range $line 11 end]
5393 set diffinhdr 1
5394 # start of a new file
5395 $ctext insert end "\n"
5396 set curdiffstart [$ctext index "end - 1c"]
5397 $ctext insert end "\n" filesep
5398 # If the name hasn't changed the length will be odd,
5399 # the middle char will be a space, and the two bits either
5400 # side will be a/name and b/name, or "a/name" and "b/name".
5401 # If the name has changed we'll get "rename from" and
5402 # "rename to" or "copy from" and "copy to" lines following this,
5403 # and we'll use them to get the filenames.
5404 # This complexity is necessary because spaces in the filename(s)
5405 # don't get escaped.
5406 set l [string length $line]
5407 set i [expr {$l / 2}]
5408 if {!(($l & 1) && [string index $line $i] eq " " &&
5409 [string range $line 2 [expr {$i - 1}]] eq \
5410 [string range $line [expr {$i + 3}] end])} {
5411 continue
5412 }
5413 # unescape if quoted and chop off the a/ from the front
5414 if {[string index $line 0] eq "\""} {
5415 set fname [string range [lindex $line 0] 2 end]
5416 } else {
5417 set fname [string range $line 2 [expr {$i - 1}]]
5418 }
5419 makediffhdr $fname $ids
5420
5421 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5422 $line match f1l f1c f2l f2c rest]} {
5423 $ctext insert end "$line\n" hunksep
5424 set diffinhdr 0
5425
5426 } elseif {$diffinhdr} {
5427 if {![string compare -length 12 "rename from " $line] ||
5428 ![string compare -length 10 "copy from " $line]} {
5429 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5430 if {[string index $fname 0] eq "\""} {
5431 set fname [lindex $fname 0]
5432 }
5433 set i [lsearch -exact $treediffs($ids) $fname]
5434 if {$i >= 0} {
5435 setinlist difffilestart $i $curdiffstart
5436 }
5437 } elseif {![string compare -length 10 $line "rename to "] ||
5438 ![string compare -length 8 $line "copy to "]} {
5439 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5440 if {[string index $fname 0] eq "\""} {
5441 set fname [lindex $fname 0]
5442 }
5443 makediffhdr $fname $ids
5444 } elseif {[string compare -length 3 $line "---"] == 0} {
5445 # do nothing
5446 continue
5447 } elseif {[string compare -length 3 $line "+++"] == 0} {
5448 set diffinhdr 0
5449 continue
5450 }
5451 $ctext insert end "$line\n" filesep
5452
5453 } else {
5454 set x [string range $line 0 0]
5455 if {$x == "-" || $x == "+"} {
5456 set tag [expr {$x == "+"}]
5457 $ctext insert end "$line\n" d$tag
5458 } elseif {$x == " "} {
5459 $ctext insert end "$line\n"
5460 } else {
5461 # "\ No newline at end of file",
5462 # or something else we don't recognize
5463 $ctext insert end "$line\n" hunksep
5464 }
5465 }
5466 }
5467 $ctext conf -state disabled
5468 if {[eof $bdf]} {
5469 close $bdf
5470 return 0
5471 }
5472 return [expr {$nr >= 1000? 2: 1}]
5473}
5474
5475proc changediffdisp {} {
5476 global ctext diffelide
5477
5478 $ctext tag conf d0 -elide [lindex $diffelide 0]
5479 $ctext tag conf d1 -elide [lindex $diffelide 1]
5480}
5481
5482proc prevfile {} {
5483 global difffilestart ctext
5484 set prev [lindex $difffilestart 0]
5485 set here [$ctext index @0,0]
5486 foreach loc $difffilestart {
5487 if {[$ctext compare $loc >= $here]} {
5488 $ctext yview $prev
5489 return
5490 }
5491 set prev $loc
5492 }
5493 $ctext yview $prev
5494}
5495
5496proc nextfile {} {
5497 global difffilestart ctext
5498 set here [$ctext index @0,0]
5499 foreach loc $difffilestart {
5500 if {[$ctext compare $loc > $here]} {
5501 $ctext yview $loc
5502 return
5503 }
5504 }
5505}
5506
5507proc clear_ctext {{first 1.0}} {
5508 global ctext smarktop smarkbot
5509 global pendinglinks
5510
5511 set l [lindex [split $first .] 0]
5512 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5513 set smarktop $l
5514 }
5515 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5516 set smarkbot $l
5517 }
5518 $ctext delete $first end
5519 if {$first eq "1.0"} {
5520 catch {unset pendinglinks}
5521 }
5522}
5523
5524proc settabs {{firstab {}}} {
5525 global firsttabstop tabstop textfont ctext have_tk85
5526
5527 if {$firstab ne {} && $have_tk85} {
5528 set firsttabstop $firstab
5529 }
5530 set w [font measure $textfont "0"]
5531 if {$firsttabstop != 0} {
5532 $ctext conf -tabs [list [expr {$firsttabstop * $w}] \
5533 [expr {($firsttabstop + $tabstop) * $w}]]
5534 } elseif {$have_tk85 || $tabstop != 8} {
5535 $ctext conf -tabs [expr {$tabstop * $w}]
5536 } else {
5537 $ctext conf -tabs {}
5538 }
5539}
5540
5541proc incrsearch {name ix op} {
5542 global ctext searchstring searchdirn
5543
5544 $ctext tag remove found 1.0 end
5545 if {[catch {$ctext index anchor}]} {
5546 # no anchor set, use start of selection, or of visible area
5547 set sel [$ctext tag ranges sel]
5548 if {$sel ne {}} {
5549 $ctext mark set anchor [lindex $sel 0]
5550 } elseif {$searchdirn eq "-forwards"} {
5551 $ctext mark set anchor @0,0
5552 } else {
5553 $ctext mark set anchor @0,[winfo height $ctext]
5554 }
5555 }
5556 if {$searchstring ne {}} {
5557 set here [$ctext search $searchdirn -- $searchstring anchor]
5558 if {$here ne {}} {
5559 $ctext see $here
5560 }
5561 searchmarkvisible 1
5562 }
5563}
5564
5565proc dosearch {} {
5566 global sstring ctext searchstring searchdirn
5567
5568 focus $sstring
5569 $sstring icursor end
5570 set searchdirn -forwards
5571 if {$searchstring ne {}} {
5572 set sel [$ctext tag ranges sel]
5573 if {$sel ne {}} {
5574 set start "[lindex $sel 0] + 1c"
5575 } elseif {[catch {set start [$ctext index anchor]}]} {
5576 set start "@0,0"
5577 }
5578 set match [$ctext search -count mlen -- $searchstring $start]
5579 $ctext tag remove sel 1.0 end
5580 if {$match eq {}} {
5581 bell
5582 return
5583 }
5584 $ctext see $match
5585 set mend "$match + $mlen c"
5586 $ctext tag add sel $match $mend
5587 $ctext mark unset anchor
5588 }
5589}
5590
5591proc dosearchback {} {
5592 global sstring ctext searchstring searchdirn
5593
5594 focus $sstring
5595 $sstring icursor end
5596 set searchdirn -backwards
5597 if {$searchstring ne {}} {
5598 set sel [$ctext tag ranges sel]
5599 if {$sel ne {}} {
5600 set start [lindex $sel 0]
5601 } elseif {[catch {set start [$ctext index anchor]}]} {
5602 set start @0,[winfo height $ctext]
5603 }
5604 set match [$ctext search -backwards -count ml -- $searchstring $start]
5605 $ctext tag remove sel 1.0 end
5606 if {$match eq {}} {
5607 bell
5608 return
5609 }
5610 $ctext see $match
5611 set mend "$match + $ml c"
5612 $ctext tag add sel $match $mend
5613 $ctext mark unset anchor
5614 }
5615}
5616
5617proc searchmark {first last} {
5618 global ctext searchstring
5619
5620 set mend $first.0
5621 while {1} {
5622 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5623 if {$match eq {}} break
5624 set mend "$match + $mlen c"
5625 $ctext tag add found $match $mend
5626 }
5627}
5628
5629proc searchmarkvisible {doall} {
5630 global ctext smarktop smarkbot
5631
5632 set topline [lindex [split [$ctext index @0,0] .] 0]
5633 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5634 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5635 # no overlap with previous
5636 searchmark $topline $botline
5637 set smarktop $topline
5638 set smarkbot $botline
5639 } else {
5640 if {$topline < $smarktop} {
5641 searchmark $topline [expr {$smarktop-1}]
5642 set smarktop $topline
5643 }
5644 if {$botline > $smarkbot} {
5645 searchmark [expr {$smarkbot+1}] $botline
5646 set smarkbot $botline
5647 }
5648 }
5649}
5650
5651proc scrolltext {f0 f1} {
5652 global searchstring
5653
5654 .bleft.sb set $f0 $f1
5655 if {$searchstring ne {}} {
5656 searchmarkvisible 0
5657 }
5658}
5659
5660proc setcoords {} {
5661 global linespc charspc canvx0 canvy0 mainfont
5662 global xspc1 xspc2 lthickness
5663
5664 set linespc [font metrics $mainfont -linespace]
5665 set charspc [font measure $mainfont "m"]
5666 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5667 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5668 set lthickness [expr {int($linespc / 9) + 1}]
5669 set xspc1(0) $linespc
5670 set xspc2 $linespc
5671}
5672
5673proc redisplay {} {
5674 global canv
5675 global selectedline
5676
5677 set ymax [lindex [$canv cget -scrollregion] 3]
5678 if {$ymax eq {} || $ymax == 0} return
5679 set span [$canv yview]
5680 clear_display
5681 setcanvscroll
5682 allcanvs yview moveto [lindex $span 0]
5683 drawvisible
5684 if {[info exists selectedline]} {
5685 selectline $selectedline 0
5686 allcanvs yview moveto [lindex $span 0]
5687 }
5688}
5689
5690proc incrfont {inc} {
5691 global mainfont textfont ctext canv phase cflist showrefstop
5692 global stopped entries
5693 unmarkmatches
5694 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5695 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5696 setcoords
5697 settabs
5698 $cflist conf -font $textfont
5699 $ctext tag conf filesep -font [concat $textfont bold]
5700 foreach e $entries {
5701 $e conf -font $mainfont
5702 }
5703 if {$phase eq "getcommits"} {
5704 $canv itemconf textitems -font $mainfont
5705 }
5706 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5707 $showrefstop.list conf -font $mainfont
5708 }
5709 redisplay
5710}
5711
5712proc clearsha1 {} {
5713 global sha1entry sha1string
5714 if {[string length $sha1string] == 40} {
5715 $sha1entry delete 0 end
5716 }
5717}
5718
5719proc sha1change {n1 n2 op} {
5720 global sha1string currentid sha1but
5721 if {$sha1string == {}
5722 || ([info exists currentid] && $sha1string == $currentid)} {
5723 set state disabled
5724 } else {
5725 set state normal
5726 }
5727 if {[$sha1but cget -state] == $state} return
5728 if {$state == "normal"} {
5729 $sha1but conf -state normal -relief raised -text "Goto: "
5730 } else {
5731 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5732 }
5733}
5734
5735proc gotocommit {} {
5736 global sha1string currentid commitrow tagids headids
5737 global displayorder numcommits curview
5738
5739 if {$sha1string == {}
5740 || ([info exists currentid] && $sha1string == $currentid)} return
5741 if {[info exists tagids($sha1string)]} {
5742 set id $tagids($sha1string)
5743 } elseif {[info exists headids($sha1string)]} {
5744 set id $headids($sha1string)
5745 } else {
5746 set id [string tolower $sha1string]
5747 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5748 set matches {}
5749 foreach i $displayorder {
5750 if {[string match $id* $i]} {
5751 lappend matches $i
5752 }
5753 }
5754 if {$matches ne {}} {
5755 if {[llength $matches] > 1} {
5756 error_popup "Short SHA1 id $id is ambiguous"
5757 return
5758 }
5759 set id [lindex $matches 0]
5760 }
5761 }
5762 }
5763 if {[info exists commitrow($curview,$id)]} {
5764 selectline $commitrow($curview,$id) 1
5765 return
5766 }
5767 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5768 set type "SHA1 id"
5769 } else {
5770 set type "Tag/Head"
5771 }
5772 error_popup "$type $sha1string is not known"
5773}
5774
5775proc lineenter {x y id} {
5776 global hoverx hovery hoverid hovertimer
5777 global commitinfo canv
5778
5779 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5780 set hoverx $x
5781 set hovery $y
5782 set hoverid $id
5783 if {[info exists hovertimer]} {
5784 after cancel $hovertimer
5785 }
5786 set hovertimer [after 500 linehover]
5787 $canv delete hover
5788}
5789
5790proc linemotion {x y id} {
5791 global hoverx hovery hoverid hovertimer
5792
5793 if {[info exists hoverid] && $id == $hoverid} {
5794 set hoverx $x
5795 set hovery $y
5796 if {[info exists hovertimer]} {
5797 after cancel $hovertimer
5798 }
5799 set hovertimer [after 500 linehover]
5800 }
5801}
5802
5803proc lineleave {id} {
5804 global hoverid hovertimer canv
5805
5806 if {[info exists hoverid] && $id == $hoverid} {
5807 $canv delete hover
5808 if {[info exists hovertimer]} {
5809 after cancel $hovertimer
5810 unset hovertimer
5811 }
5812 unset hoverid
5813 }
5814}
5815
5816proc linehover {} {
5817 global hoverx hovery hoverid hovertimer
5818 global canv linespc lthickness
5819 global commitinfo mainfont
5820
5821 set text [lindex $commitinfo($hoverid) 0]
5822 set ymax [lindex [$canv cget -scrollregion] 3]
5823 if {$ymax == {}} return
5824 set yfrac [lindex [$canv yview] 0]
5825 set x [expr {$hoverx + 2 * $linespc}]
5826 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5827 set x0 [expr {$x - 2 * $lthickness}]
5828 set y0 [expr {$y - 2 * $lthickness}]
5829 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5830 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5831 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5832 -fill \#ffff80 -outline black -width 1 -tags hover]
5833 $canv raise $t
5834 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5835 -font $mainfont]
5836 $canv raise $t
5837}
5838
5839proc clickisonarrow {id y} {
5840 global lthickness
5841
5842 set ranges [rowranges $id]
5843 set thresh [expr {2 * $lthickness + 6}]
5844 set n [expr {[llength $ranges] - 1}]
5845 for {set i 1} {$i < $n} {incr i} {
5846 set row [lindex $ranges $i]
5847 if {abs([yc $row] - $y) < $thresh} {
5848 return $i
5849 }
5850 }
5851 return {}
5852}
5853
5854proc arrowjump {id n y} {
5855 global canv
5856
5857 # 1 <-> 2, 3 <-> 4, etc...
5858 set n [expr {(($n - 1) ^ 1) + 1}]
5859 set row [lindex [rowranges $id] $n]
5860 set yt [yc $row]
5861 set ymax [lindex [$canv cget -scrollregion] 3]
5862 if {$ymax eq {} || $ymax <= 0} return
5863 set view [$canv yview]
5864 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5865 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5866 if {$yfrac < 0} {
5867 set yfrac 0
5868 }
5869 allcanvs yview moveto $yfrac
5870}
5871
5872proc lineclick {x y id isnew} {
5873 global ctext commitinfo children canv thickerline curview commitrow
5874
5875 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5876 unmarkmatches
5877 unselectline
5878 normalline
5879 $canv delete hover
5880 # draw this line thicker than normal
5881 set thickerline $id
5882 drawlines $id
5883 if {$isnew} {
5884 set ymax [lindex [$canv cget -scrollregion] 3]
5885 if {$ymax eq {}} return
5886 set yfrac [lindex [$canv yview] 0]
5887 set y [expr {$y + $yfrac * $ymax}]
5888 }
5889 set dirn [clickisonarrow $id $y]
5890 if {$dirn ne {}} {
5891 arrowjump $id $dirn $y
5892 return
5893 }
5894
5895 if {$isnew} {
5896 addtohistory [list lineclick $x $y $id 0]
5897 }
5898 # fill the details pane with info about this line
5899 $ctext conf -state normal
5900 clear_ctext
5901 settabs 0
5902 $ctext insert end "Parent:\t"
5903 $ctext insert end $id link0
5904 setlink $id link0
5905 set info $commitinfo($id)
5906 $ctext insert end "\n\t[lindex $info 0]\n"
5907 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5908 set date [formatdate [lindex $info 2]]
5909 $ctext insert end "\tDate:\t$date\n"
5910 set kids $children($curview,$id)
5911 if {$kids ne {}} {
5912 $ctext insert end "\nChildren:"
5913 set i 0
5914 foreach child $kids {
5915 incr i
5916 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5917 set info $commitinfo($child)
5918 $ctext insert end "\n\t"
5919 $ctext insert end $child link$i
5920 setlink $child link$i
5921 $ctext insert end "\n\t[lindex $info 0]"
5922 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5923 set date [formatdate [lindex $info 2]]
5924 $ctext insert end "\n\tDate:\t$date\n"
5925 }
5926 }
5927 $ctext conf -state disabled
5928 init_flist {}
5929}
5930
5931proc normalline {} {
5932 global thickerline
5933 if {[info exists thickerline]} {
5934 set id $thickerline
5935 unset thickerline
5936 drawlines $id
5937 }
5938}
5939
5940proc selbyid {id} {
5941 global commitrow curview
5942 if {[info exists commitrow($curview,$id)]} {
5943 selectline $commitrow($curview,$id) 1
5944 }
5945}
5946
5947proc mstime {} {
5948 global startmstime
5949 if {![info exists startmstime]} {
5950 set startmstime [clock clicks -milliseconds]
5951 }
5952 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5953}
5954
5955proc rowmenu {x y id} {
5956 global rowctxmenu commitrow selectedline rowmenuid curview
5957 global nullid nullid2 fakerowmenu mainhead
5958
5959 stopfinding
5960 set rowmenuid $id
5961 if {![info exists selectedline]
5962 || $commitrow($curview,$id) eq $selectedline} {
5963 set state disabled
5964 } else {
5965 set state normal
5966 }
5967 if {$id ne $nullid && $id ne $nullid2} {
5968 set menu $rowctxmenu
5969 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5970 } else {
5971 set menu $fakerowmenu
5972 }
5973 $menu entryconfigure "Diff this*" -state $state
5974 $menu entryconfigure "Diff selected*" -state $state
5975 $menu entryconfigure "Make patch" -state $state
5976 tk_popup $menu $x $y
5977}
5978
5979proc diffvssel {dirn} {
5980 global rowmenuid selectedline displayorder
5981
5982 if {![info exists selectedline]} return
5983 if {$dirn} {
5984 set oldid [lindex $displayorder $selectedline]
5985 set newid $rowmenuid
5986 } else {
5987 set oldid $rowmenuid
5988 set newid [lindex $displayorder $selectedline]
5989 }
5990 addtohistory [list doseldiff $oldid $newid]
5991 doseldiff $oldid $newid
5992}
5993
5994proc doseldiff {oldid newid} {
5995 global ctext
5996 global commitinfo
5997
5998 $ctext conf -state normal
5999 clear_ctext
6000 init_flist "Top"
6001 $ctext insert end "From "
6002 $ctext insert end $oldid link0
6003 setlink $oldid link0
6004 $ctext insert end "\n "
6005 $ctext insert end [lindex $commitinfo($oldid) 0]
6006 $ctext insert end "\n\nTo "
6007 $ctext insert end $newid link1
6008 setlink $newid link1
6009 $ctext insert end "\n "
6010 $ctext insert end [lindex $commitinfo($newid) 0]
6011 $ctext insert end "\n"
6012 $ctext conf -state disabled
6013 $ctext tag remove found 1.0 end
6014 startdiff [list $oldid $newid]
6015}
6016
6017proc mkpatch {} {
6018 global rowmenuid currentid commitinfo patchtop patchnum
6019
6020 if {![info exists currentid]} return
6021 set oldid $currentid
6022 set oldhead [lindex $commitinfo($oldid) 0]
6023 set newid $rowmenuid
6024 set newhead [lindex $commitinfo($newid) 0]
6025 set top .patch
6026 set patchtop $top
6027 catch {destroy $top}
6028 toplevel $top
6029 label $top.title -text "Generate patch"
6030 grid $top.title - -pady 10
6031 label $top.from -text "From:"
6032 entry $top.fromsha1 -width 40 -relief flat
6033 $top.fromsha1 insert 0 $oldid
6034 $top.fromsha1 conf -state readonly
6035 grid $top.from $top.fromsha1 -sticky w
6036 entry $top.fromhead -width 60 -relief flat
6037 $top.fromhead insert 0 $oldhead
6038 $top.fromhead conf -state readonly
6039 grid x $top.fromhead -sticky w
6040 label $top.to -text "To:"
6041 entry $top.tosha1 -width 40 -relief flat
6042 $top.tosha1 insert 0 $newid
6043 $top.tosha1 conf -state readonly
6044 grid $top.to $top.tosha1 -sticky w
6045 entry $top.tohead -width 60 -relief flat
6046 $top.tohead insert 0 $newhead
6047 $top.tohead conf -state readonly
6048 grid x $top.tohead -sticky w
6049 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
6050 grid $top.rev x -pady 10
6051 label $top.flab -text "Output file:"
6052 entry $top.fname -width 60
6053 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6054 incr patchnum
6055 grid $top.flab $top.fname -sticky w
6056 frame $top.buts
6057 button $top.buts.gen -text "Generate" -command mkpatchgo
6058 button $top.buts.can -text "Cancel" -command mkpatchcan
6059 grid $top.buts.gen $top.buts.can
6060 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6061 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6062 grid $top.buts - -pady 10 -sticky ew
6063 focus $top.fname
6064}
6065
6066proc mkpatchrev {} {
6067 global patchtop
6068
6069 set oldid [$patchtop.fromsha1 get]
6070 set oldhead [$patchtop.fromhead get]
6071 set newid [$patchtop.tosha1 get]
6072 set newhead [$patchtop.tohead get]
6073 foreach e [list fromsha1 fromhead tosha1 tohead] \
6074 v [list $newid $newhead $oldid $oldhead] {
6075 $patchtop.$e conf -state normal
6076 $patchtop.$e delete 0 end
6077 $patchtop.$e insert 0 $v
6078 $patchtop.$e conf -state readonly
6079 }
6080}
6081
6082proc mkpatchgo {} {
6083 global patchtop nullid nullid2
6084
6085 set oldid [$patchtop.fromsha1 get]
6086 set newid [$patchtop.tosha1 get]
6087 set fname [$patchtop.fname get]
6088 set cmd [diffcmd [list $oldid $newid] -p]
6089 # trim off the initial "|"
6090 set cmd [lrange $cmd 1 end]
6091 lappend cmd >$fname &
6092 if {[catch {eval exec $cmd} err]} {
6093 error_popup "Error creating patch: $err"
6094 }
6095 catch {destroy $patchtop}
6096 unset patchtop
6097}
6098
6099proc mkpatchcan {} {
6100 global patchtop
6101
6102 catch {destroy $patchtop}
6103 unset patchtop
6104}
6105
6106proc mktag {} {
6107 global rowmenuid mktagtop commitinfo
6108
6109 set top .maketag
6110 set mktagtop $top
6111 catch {destroy $top}
6112 toplevel $top
6113 label $top.title -text "Create tag"
6114 grid $top.title - -pady 10
6115 label $top.id -text "ID:"
6116 entry $top.sha1 -width 40 -relief flat
6117 $top.sha1 insert 0 $rowmenuid
6118 $top.sha1 conf -state readonly
6119 grid $top.id $top.sha1 -sticky w
6120 entry $top.head -width 60 -relief flat
6121 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6122 $top.head conf -state readonly
6123 grid x $top.head -sticky w
6124 label $top.tlab -text "Tag name:"
6125 entry $top.tag -width 60
6126 grid $top.tlab $top.tag -sticky w
6127 frame $top.buts
6128 button $top.buts.gen -text "Create" -command mktaggo
6129 button $top.buts.can -text "Cancel" -command mktagcan
6130 grid $top.buts.gen $top.buts.can
6131 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6132 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6133 grid $top.buts - -pady 10 -sticky ew
6134 focus $top.tag
6135}
6136
6137proc domktag {} {
6138 global mktagtop env tagids idtags
6139
6140 set id [$mktagtop.sha1 get]
6141 set tag [$mktagtop.tag get]
6142 if {$tag == {}} {
6143 error_popup "No tag name specified"
6144 return
6145 }
6146 if {[info exists tagids($tag)]} {
6147 error_popup "Tag \"$tag\" already exists"
6148 return
6149 }
6150 if {[catch {
6151 set dir [gitdir]
6152 set fname [file join $dir "refs/tags" $tag]
6153 set f [open $fname w]
6154 puts $f $id
6155 close $f
6156 } err]} {
6157 error_popup "Error creating tag: $err"
6158 return
6159 }
6160
6161 set tagids($tag) $id
6162 lappend idtags($id) $tag
6163 redrawtags $id
6164 addedtag $id
6165 dispneartags 0
6166 run refill_reflist
6167}
6168
6169proc redrawtags {id} {
6170 global canv linehtag commitrow idpos selectedline curview
6171 global mainfont canvxmax iddrawn
6172
6173 if {![info exists commitrow($curview,$id)]} return
6174 if {![info exists iddrawn($id)]} return
6175 drawcommits $commitrow($curview,$id)
6176 $canv delete tag.$id
6177 set xt [eval drawtags $id $idpos($id)]
6178 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6179 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6180 set xr [expr {$xt + [font measure $mainfont $text]}]
6181 if {$xr > $canvxmax} {
6182 set canvxmax $xr
6183 setcanvscroll
6184 }
6185 if {[info exists selectedline]
6186 && $selectedline == $commitrow($curview,$id)} {
6187 selectline $selectedline 0
6188 }
6189}
6190
6191proc mktagcan {} {
6192 global mktagtop
6193
6194 catch {destroy $mktagtop}
6195 unset mktagtop
6196}
6197
6198proc mktaggo {} {
6199 domktag
6200 mktagcan
6201}
6202
6203proc writecommit {} {
6204 global rowmenuid wrcomtop commitinfo wrcomcmd
6205
6206 set top .writecommit
6207 set wrcomtop $top
6208 catch {destroy $top}
6209 toplevel $top
6210 label $top.title -text "Write commit to file"
6211 grid $top.title - -pady 10
6212 label $top.id -text "ID:"
6213 entry $top.sha1 -width 40 -relief flat
6214 $top.sha1 insert 0 $rowmenuid
6215 $top.sha1 conf -state readonly
6216 grid $top.id $top.sha1 -sticky w
6217 entry $top.head -width 60 -relief flat
6218 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6219 $top.head conf -state readonly
6220 grid x $top.head -sticky w
6221 label $top.clab -text "Command:"
6222 entry $top.cmd -width 60 -textvariable wrcomcmd
6223 grid $top.clab $top.cmd -sticky w -pady 10
6224 label $top.flab -text "Output file:"
6225 entry $top.fname -width 60
6226 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6227 grid $top.flab $top.fname -sticky w
6228 frame $top.buts
6229 button $top.buts.gen -text "Write" -command wrcomgo
6230 button $top.buts.can -text "Cancel" -command wrcomcan
6231 grid $top.buts.gen $top.buts.can
6232 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6233 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6234 grid $top.buts - -pady 10 -sticky ew
6235 focus $top.fname
6236}
6237
6238proc wrcomgo {} {
6239 global wrcomtop
6240
6241 set id [$wrcomtop.sha1 get]
6242 set cmd "echo $id | [$wrcomtop.cmd get]"
6243 set fname [$wrcomtop.fname get]
6244 if {[catch {exec sh -c $cmd >$fname &} err]} {
6245 error_popup "Error writing commit: $err"
6246 }
6247 catch {destroy $wrcomtop}
6248 unset wrcomtop
6249}
6250
6251proc wrcomcan {} {
6252 global wrcomtop
6253
6254 catch {destroy $wrcomtop}
6255 unset wrcomtop
6256}
6257
6258proc mkbranch {} {
6259 global rowmenuid mkbrtop
6260
6261 set top .makebranch
6262 catch {destroy $top}
6263 toplevel $top
6264 label $top.title -text "Create new branch"
6265 grid $top.title - -pady 10
6266 label $top.id -text "ID:"
6267 entry $top.sha1 -width 40 -relief flat
6268 $top.sha1 insert 0 $rowmenuid
6269 $top.sha1 conf -state readonly
6270 grid $top.id $top.sha1 -sticky w
6271 label $top.nlab -text "Name:"
6272 entry $top.name -width 40
6273 grid $top.nlab $top.name -sticky w
6274 frame $top.buts
6275 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6276 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6277 grid $top.buts.go $top.buts.can
6278 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6279 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6280 grid $top.buts - -pady 10 -sticky ew
6281 focus $top.name
6282}
6283
6284proc mkbrgo {top} {
6285 global headids idheads
6286
6287 set name [$top.name get]
6288 set id [$top.sha1 get]
6289 if {$name eq {}} {
6290 error_popup "Please specify a name for the new branch"
6291 return
6292 }
6293 catch {destroy $top}
6294 nowbusy newbranch
6295 update
6296 if {[catch {
6297 exec git branch $name $id
6298 } err]} {
6299 notbusy newbranch
6300 error_popup $err
6301 } else {
6302 set headids($name) $id
6303 lappend idheads($id) $name
6304 addedhead $id $name
6305 notbusy newbranch
6306 redrawtags $id
6307 dispneartags 0
6308 run refill_reflist
6309 }
6310}
6311
6312proc cherrypick {} {
6313 global rowmenuid curview commitrow
6314 global mainhead
6315
6316 set oldhead [exec git rev-parse HEAD]
6317 set dheads [descheads $rowmenuid]
6318 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6319 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6320 included in branch $mainhead -- really re-apply it?"]
6321 if {!$ok} return
6322 }
6323 nowbusy cherrypick
6324 update
6325 # Unfortunately git-cherry-pick writes stuff to stderr even when
6326 # no error occurs, and exec takes that as an indication of error...
6327 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6328 notbusy cherrypick
6329 error_popup $err
6330 return
6331 }
6332 set newhead [exec git rev-parse HEAD]
6333 if {$newhead eq $oldhead} {
6334 notbusy cherrypick
6335 error_popup "No changes committed"
6336 return
6337 }
6338 addnewchild $newhead $oldhead
6339 if {[info exists commitrow($curview,$oldhead)]} {
6340 insertrow $commitrow($curview,$oldhead) $newhead
6341 if {$mainhead ne {}} {
6342 movehead $newhead $mainhead
6343 movedhead $newhead $mainhead
6344 }
6345 redrawtags $oldhead
6346 redrawtags $newhead
6347 }
6348 notbusy cherrypick
6349}
6350
6351proc resethead {} {
6352 global mainheadid mainhead rowmenuid confirm_ok resettype
6353
6354 set confirm_ok 0
6355 set w ".confirmreset"
6356 toplevel $w
6357 wm transient $w .
6358 wm title $w "Confirm reset"
6359 message $w.m -text \
6360 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6361 -justify center -aspect 1000
6362 pack $w.m -side top -fill x -padx 20 -pady 20
6363 frame $w.f -relief sunken -border 2
6364 message $w.f.rt -text "Reset type:" -aspect 1000
6365 grid $w.f.rt -sticky w
6366 set resettype mixed
6367 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6368 -text "Soft: Leave working tree and index untouched"
6369 grid $w.f.soft -sticky w
6370 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6371 -text "Mixed: Leave working tree untouched, reset index"
6372 grid $w.f.mixed -sticky w
6373 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6374 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6375 grid $w.f.hard -sticky w
6376 pack $w.f -side top -fill x
6377 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6378 pack $w.ok -side left -fill x -padx 20 -pady 20
6379 button $w.cancel -text Cancel -command "destroy $w"
6380 pack $w.cancel -side right -fill x -padx 20 -pady 20
6381 bind $w <Visibility> "grab $w; focus $w"
6382 tkwait window $w
6383 if {!$confirm_ok} return
6384 if {[catch {set fd [open \
6385 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6386 error_popup $err
6387 } else {
6388 dohidelocalchanges
6389 set w ".resetprogress"
6390 filerun $fd [list readresetstat $fd $w]
6391 toplevel $w
6392 wm transient $w
6393 wm title $w "Reset progress"
6394 message $w.m -text "Reset in progress, please wait..." \
6395 -justify center -aspect 1000
6396 pack $w.m -side top -fill x -padx 20 -pady 5
6397 canvas $w.c -width 150 -height 20 -bg white
6398 $w.c create rect 0 0 0 20 -fill green -tags rect
6399 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6400 nowbusy reset
6401 }
6402}
6403
6404proc readresetstat {fd w} {
6405 global mainhead mainheadid showlocalchanges
6406
6407 if {[gets $fd line] >= 0} {
6408 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6409 set x [expr {($m * 150) / $n}]
6410 $w.c coords rect 0 0 $x 20
6411 }
6412 return 1
6413 }
6414 destroy $w
6415 notbusy reset
6416 if {[catch {close $fd} err]} {
6417 error_popup $err
6418 }
6419 set oldhead $mainheadid
6420 set newhead [exec git rev-parse HEAD]
6421 if {$newhead ne $oldhead} {
6422 movehead $newhead $mainhead
6423 movedhead $newhead $mainhead
6424 set mainheadid $newhead
6425 redrawtags $oldhead
6426 redrawtags $newhead
6427 }
6428 if {$showlocalchanges} {
6429 doshowlocalchanges
6430 }
6431 return 0
6432}
6433
6434# context menu for a head
6435proc headmenu {x y id head} {
6436 global headmenuid headmenuhead headctxmenu mainhead
6437
6438 stopfinding
6439 set headmenuid $id
6440 set headmenuhead $head
6441 set state normal
6442 if {$head eq $mainhead} {
6443 set state disabled
6444 }
6445 $headctxmenu entryconfigure 0 -state $state
6446 $headctxmenu entryconfigure 1 -state $state
6447 tk_popup $headctxmenu $x $y
6448}
6449
6450proc cobranch {} {
6451 global headmenuid headmenuhead mainhead headids
6452 global showlocalchanges mainheadid
6453
6454 # check the tree is clean first??
6455 set oldmainhead $mainhead
6456 nowbusy checkout
6457 update
6458 dohidelocalchanges
6459 if {[catch {
6460 exec git checkout -q $headmenuhead
6461 } err]} {
6462 notbusy checkout
6463 error_popup $err
6464 } else {
6465 notbusy checkout
6466 set mainhead $headmenuhead
6467 set mainheadid $headmenuid
6468 if {[info exists headids($oldmainhead)]} {
6469 redrawtags $headids($oldmainhead)
6470 }
6471 redrawtags $headmenuid
6472 }
6473 if {$showlocalchanges} {
6474 dodiffindex
6475 }
6476}
6477
6478proc rmbranch {} {
6479 global headmenuid headmenuhead mainhead
6480 global idheads
6481
6482 set head $headmenuhead
6483 set id $headmenuid
6484 # this check shouldn't be needed any more...
6485 if {$head eq $mainhead} {
6486 error_popup "Cannot delete the currently checked-out branch"
6487 return
6488 }
6489 set dheads [descheads $id]
6490 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6491 # the stuff on this branch isn't on any other branch
6492 if {![confirm_popup "The commits on branch $head aren't on any other\
6493 branch.\nReally delete branch $head?"]} return
6494 }
6495 nowbusy rmbranch
6496 update
6497 if {[catch {exec git branch -D $head} err]} {
6498 notbusy rmbranch
6499 error_popup $err
6500 return
6501 }
6502 removehead $id $head
6503 removedhead $id $head
6504 redrawtags $id
6505 notbusy rmbranch
6506 dispneartags 0
6507 run refill_reflist
6508}
6509
6510# Display a list of tags and heads
6511proc showrefs {} {
6512 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6513 global bglist fglist uifont reflistfilter reflist maincursor
6514
6515 set top .showrefs
6516 set showrefstop $top
6517 if {[winfo exists $top]} {
6518 raise $top
6519 refill_reflist
6520 return
6521 }
6522 toplevel $top
6523 wm title $top "Tags and heads: [file tail [pwd]]"
6524 text $top.list -background $bgcolor -foreground $fgcolor \
6525 -selectbackground $selectbgcolor -font $mainfont \
6526 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6527 -width 30 -height 20 -cursor $maincursor \
6528 -spacing1 1 -spacing3 1 -state disabled
6529 $top.list tag configure highlight -background $selectbgcolor
6530 lappend bglist $top.list
6531 lappend fglist $top.list
6532 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6533 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6534 grid $top.list $top.ysb -sticky nsew
6535 grid $top.xsb x -sticky ew
6536 frame $top.f
6537 label $top.f.l -text "Filter: " -font $uifont
6538 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6539 set reflistfilter "*"
6540 trace add variable reflistfilter write reflistfilter_change
6541 pack $top.f.e -side right -fill x -expand 1
6542 pack $top.f.l -side left
6543 grid $top.f - -sticky ew -pady 2
6544 button $top.close -command [list destroy $top] -text "Close" \
6545 -font $uifont
6546 grid $top.close -
6547 grid columnconfigure $top 0 -weight 1
6548 grid rowconfigure $top 0 -weight 1
6549 bind $top.list <1> {break}
6550 bind $top.list <B1-Motion> {break}
6551 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6552 set reflist {}
6553 refill_reflist
6554}
6555
6556proc sel_reflist {w x y} {
6557 global showrefstop reflist headids tagids otherrefids
6558
6559 if {![winfo exists $showrefstop]} return
6560 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6561 set ref [lindex $reflist [expr {$l-1}]]
6562 set n [lindex $ref 0]
6563 switch -- [lindex $ref 1] {
6564 "H" {selbyid $headids($n)}
6565 "T" {selbyid $tagids($n)}
6566 "o" {selbyid $otherrefids($n)}
6567 }
6568 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6569}
6570
6571proc unsel_reflist {} {
6572 global showrefstop
6573
6574 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6575 $showrefstop.list tag remove highlight 0.0 end
6576}
6577
6578proc reflistfilter_change {n1 n2 op} {
6579 global reflistfilter
6580
6581 after cancel refill_reflist
6582 after 200 refill_reflist
6583}
6584
6585proc refill_reflist {} {
6586 global reflist reflistfilter showrefstop headids tagids otherrefids
6587 global commitrow curview commitinterest
6588
6589 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6590 set refs {}
6591 foreach n [array names headids] {
6592 if {[string match $reflistfilter $n]} {
6593 if {[info exists commitrow($curview,$headids($n))]} {
6594 lappend refs [list $n H]
6595 } else {
6596 set commitinterest($headids($n)) {run refill_reflist}
6597 }
6598 }
6599 }
6600 foreach n [array names tagids] {
6601 if {[string match $reflistfilter $n]} {
6602 if {[info exists commitrow($curview,$tagids($n))]} {
6603 lappend refs [list $n T]
6604 } else {
6605 set commitinterest($tagids($n)) {run refill_reflist}
6606 }
6607 }
6608 }
6609 foreach n [array names otherrefids] {
6610 if {[string match $reflistfilter $n]} {
6611 if {[info exists commitrow($curview,$otherrefids($n))]} {
6612 lappend refs [list $n o]
6613 } else {
6614 set commitinterest($otherrefids($n)) {run refill_reflist}
6615 }
6616 }
6617 }
6618 set refs [lsort -index 0 $refs]
6619 if {$refs eq $reflist} return
6620
6621 # Update the contents of $showrefstop.list according to the
6622 # differences between $reflist (old) and $refs (new)
6623 $showrefstop.list conf -state normal
6624 $showrefstop.list insert end "\n"
6625 set i 0
6626 set j 0
6627 while {$i < [llength $reflist] || $j < [llength $refs]} {
6628 if {$i < [llength $reflist]} {
6629 if {$j < [llength $refs]} {
6630 set cmp [string compare [lindex $reflist $i 0] \
6631 [lindex $refs $j 0]]
6632 if {$cmp == 0} {
6633 set cmp [string compare [lindex $reflist $i 1] \
6634 [lindex $refs $j 1]]
6635 }
6636 } else {
6637 set cmp -1
6638 }
6639 } else {
6640 set cmp 1
6641 }
6642 switch -- $cmp {
6643 -1 {
6644 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6645 incr i
6646 }
6647 0 {
6648 incr i
6649 incr j
6650 }
6651 1 {
6652 set l [expr {$j + 1}]
6653 $showrefstop.list image create $l.0 -align baseline \
6654 -image reficon-[lindex $refs $j 1] -padx 2
6655 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6656 incr j
6657 }
6658 }
6659 }
6660 set reflist $refs
6661 # delete last newline
6662 $showrefstop.list delete end-2c end-1c
6663 $showrefstop.list conf -state disabled
6664}
6665
6666# Stuff for finding nearby tags
6667proc getallcommits {} {
6668 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6669 global idheads idtags idotherrefs allparents tagobjid
6670
6671 if {![info exists allcommits]} {
6672 set nextarc 0
6673 set allcommits 0
6674 set seeds {}
6675 set allcwait 0
6676 set cachedarcs 0
6677 set allccache [file join [gitdir] "gitk.cache"]
6678 if {![catch {
6679 set f [open $allccache r]
6680 set allcwait 1
6681 getcache $f
6682 }]} return
6683 }
6684
6685 if {$allcwait} {
6686 return
6687 }
6688 set cmd [list | git rev-list --parents]
6689 set allcupdate [expr {$seeds ne {}}]
6690 if {!$allcupdate} {
6691 set ids "--all"
6692 } else {
6693 set refs [concat [array names idheads] [array names idtags] \
6694 [array names idotherrefs]]
6695 set ids {}
6696 set tagobjs {}
6697 foreach name [array names tagobjid] {
6698 lappend tagobjs $tagobjid($name)
6699 }
6700 foreach id [lsort -unique $refs] {
6701 if {![info exists allparents($id)] &&
6702 [lsearch -exact $tagobjs $id] < 0} {
6703 lappend ids $id
6704 }
6705 }
6706 if {$ids ne {}} {
6707 foreach id $seeds {
6708 lappend ids "^$id"
6709 }
6710 }
6711 }
6712 if {$ids ne {}} {
6713 set fd [open [concat $cmd $ids] r]
6714 fconfigure $fd -blocking 0
6715 incr allcommits
6716 nowbusy allcommits
6717 filerun $fd [list getallclines $fd]
6718 } else {
6719 dispneartags 0
6720 }
6721}
6722
6723# Since most commits have 1 parent and 1 child, we group strings of
6724# such commits into "arcs" joining branch/merge points (BMPs), which
6725# are commits that either don't have 1 parent or don't have 1 child.
6726#
6727# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6728# arcout(id) - outgoing arcs for BMP
6729# arcids(a) - list of IDs on arc including end but not start
6730# arcstart(a) - BMP ID at start of arc
6731# arcend(a) - BMP ID at end of arc
6732# growing(a) - arc a is still growing
6733# arctags(a) - IDs out of arcids (excluding end) that have tags
6734# archeads(a) - IDs out of arcids (excluding end) that have heads
6735# The start of an arc is at the descendent end, so "incoming" means
6736# coming from descendents, and "outgoing" means going towards ancestors.
6737
6738proc getallclines {fd} {
6739 global allparents allchildren idtags idheads nextarc
6740 global arcnos arcids arctags arcout arcend arcstart archeads growing
6741 global seeds allcommits cachedarcs allcupdate
6742
6743 set nid 0
6744 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6745 set id [lindex $line 0]
6746 if {[info exists allparents($id)]} {
6747 # seen it already
6748 continue
6749 }
6750 set cachedarcs 0
6751 set olds [lrange $line 1 end]
6752 set allparents($id) $olds
6753 if {![info exists allchildren($id)]} {
6754 set allchildren($id) {}
6755 set arcnos($id) {}
6756 lappend seeds $id
6757 } else {
6758 set a $arcnos($id)
6759 if {[llength $olds] == 1 && [llength $a] == 1} {
6760 lappend arcids($a) $id
6761 if {[info exists idtags($id)]} {
6762 lappend arctags($a) $id
6763 }
6764 if {[info exists idheads($id)]} {
6765 lappend archeads($a) $id
6766 }
6767 if {[info exists allparents($olds)]} {
6768 # seen parent already
6769 if {![info exists arcout($olds)]} {
6770 splitarc $olds
6771 }
6772 lappend arcids($a) $olds
6773 set arcend($a) $olds
6774 unset growing($a)
6775 }
6776 lappend allchildren($olds) $id
6777 lappend arcnos($olds) $a
6778 continue
6779 }
6780 }
6781 foreach a $arcnos($id) {
6782 lappend arcids($a) $id
6783 set arcend($a) $id
6784 unset growing($a)
6785 }
6786
6787 set ao {}
6788 foreach p $olds {
6789 lappend allchildren($p) $id
6790 set a [incr nextarc]
6791 set arcstart($a) $id
6792 set archeads($a) {}
6793 set arctags($a) {}
6794 set archeads($a) {}
6795 set arcids($a) {}
6796 lappend ao $a
6797 set growing($a) 1
6798 if {[info exists allparents($p)]} {
6799 # seen it already, may need to make a new branch
6800 if {![info exists arcout($p)]} {
6801 splitarc $p
6802 }
6803 lappend arcids($a) $p
6804 set arcend($a) $p
6805 unset growing($a)
6806 }
6807 lappend arcnos($p) $a
6808 }
6809 set arcout($id) $ao
6810 }
6811 if {$nid > 0} {
6812 global cached_dheads cached_dtags cached_atags
6813 catch {unset cached_dheads}
6814 catch {unset cached_dtags}
6815 catch {unset cached_atags}
6816 }
6817 if {![eof $fd]} {
6818 return [expr {$nid >= 1000? 2: 1}]
6819 }
6820 set cacheok 1
6821 if {[catch {
6822 fconfigure $fd -blocking 1
6823 close $fd
6824 } err]} {
6825 # got an error reading the list of commits
6826 # if we were updating, try rereading the whole thing again
6827 if {$allcupdate} {
6828 incr allcommits -1
6829 dropcache $err
6830 return
6831 }
6832 error_popup "Error reading commit topology information;\
6833 branch and preceding/following tag information\
6834 will be incomplete.\n($err)"
6835 set cacheok 0
6836 }
6837 if {[incr allcommits -1] == 0} {
6838 notbusy allcommits
6839 if {$cacheok} {
6840 run savecache
6841 }
6842 }
6843 dispneartags 0
6844 return 0
6845}
6846
6847proc recalcarc {a} {
6848 global arctags archeads arcids idtags idheads
6849
6850 set at {}
6851 set ah {}
6852 foreach id [lrange $arcids($a) 0 end-1] {
6853 if {[info exists idtags($id)]} {
6854 lappend at $id
6855 }
6856 if {[info exists idheads($id)]} {
6857 lappend ah $id
6858 }
6859 }
6860 set arctags($a) $at
6861 set archeads($a) $ah
6862}
6863
6864proc splitarc {p} {
6865 global arcnos arcids nextarc arctags archeads idtags idheads
6866 global arcstart arcend arcout allparents growing
6867
6868 set a $arcnos($p)
6869 if {[llength $a] != 1} {
6870 puts "oops splitarc called but [llength $a] arcs already"
6871 return
6872 }
6873 set a [lindex $a 0]
6874 set i [lsearch -exact $arcids($a) $p]
6875 if {$i < 0} {
6876 puts "oops splitarc $p not in arc $a"
6877 return
6878 }
6879 set na [incr nextarc]
6880 if {[info exists arcend($a)]} {
6881 set arcend($na) $arcend($a)
6882 } else {
6883 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6884 set j [lsearch -exact $arcnos($l) $a]
6885 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6886 }
6887 set tail [lrange $arcids($a) [expr {$i+1}] end]
6888 set arcids($a) [lrange $arcids($a) 0 $i]
6889 set arcend($a) $p
6890 set arcstart($na) $p
6891 set arcout($p) $na
6892 set arcids($na) $tail
6893 if {[info exists growing($a)]} {
6894 set growing($na) 1
6895 unset growing($a)
6896 }
6897
6898 foreach id $tail {
6899 if {[llength $arcnos($id)] == 1} {
6900 set arcnos($id) $na
6901 } else {
6902 set j [lsearch -exact $arcnos($id) $a]
6903 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6904 }
6905 }
6906
6907 # reconstruct tags and heads lists
6908 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6909 recalcarc $a
6910 recalcarc $na
6911 } else {
6912 set arctags($na) {}
6913 set archeads($na) {}
6914 }
6915}
6916
6917# Update things for a new commit added that is a child of one
6918# existing commit. Used when cherry-picking.
6919proc addnewchild {id p} {
6920 global allparents allchildren idtags nextarc
6921 global arcnos arcids arctags arcout arcend arcstart archeads growing
6922 global seeds allcommits
6923
6924 if {![info exists allcommits]} return
6925 set allparents($id) [list $p]
6926 set allchildren($id) {}
6927 set arcnos($id) {}
6928 lappend seeds $id
6929 lappend allchildren($p) $id
6930 set a [incr nextarc]
6931 set arcstart($a) $id
6932 set archeads($a) {}
6933 set arctags($a) {}
6934 set arcids($a) [list $p]
6935 set arcend($a) $p
6936 if {![info exists arcout($p)]} {
6937 splitarc $p
6938 }
6939 lappend arcnos($p) $a
6940 set arcout($id) [list $a]
6941}
6942
6943# This implements a cache for the topology information.
6944# The cache saves, for each arc, the start and end of the arc,
6945# the ids on the arc, and the outgoing arcs from the end.
6946proc readcache {f} {
6947 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6948 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6949 global allcwait
6950
6951 set a $nextarc
6952 set lim $cachedarcs
6953 if {$lim - $a > 500} {
6954 set lim [expr {$a + 500}]
6955 }
6956 if {[catch {
6957 if {$a == $lim} {
6958 # finish reading the cache and setting up arctags, etc.
6959 set line [gets $f]
6960 if {$line ne "1"} {error "bad final version"}
6961 close $f
6962 foreach id [array names idtags] {
6963 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6964 [llength $allparents($id)] == 1} {
6965 set a [lindex $arcnos($id) 0]
6966 if {$arctags($a) eq {}} {
6967 recalcarc $a
6968 }
6969 }
6970 }
6971 foreach id [array names idheads] {
6972 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6973 [llength $allparents($id)] == 1} {
6974 set a [lindex $arcnos($id) 0]
6975 if {$archeads($a) eq {}} {
6976 recalcarc $a
6977 }
6978 }
6979 }
6980 foreach id [lsort -unique $possible_seeds] {
6981 if {$arcnos($id) eq {}} {
6982 lappend seeds $id
6983 }
6984 }
6985 set allcwait 0
6986 } else {
6987 while {[incr a] <= $lim} {
6988 set line [gets $f]
6989 if {[llength $line] != 3} {error "bad line"}
6990 set s [lindex $line 0]
6991 set arcstart($a) $s
6992 lappend arcout($s) $a
6993 if {![info exists arcnos($s)]} {
6994 lappend possible_seeds $s
6995 set arcnos($s) {}
6996 }
6997 set e [lindex $line 1]
6998 if {$e eq {}} {
6999 set growing($a) 1
7000 } else {
7001 set arcend($a) $e
7002 if {![info exists arcout($e)]} {
7003 set arcout($e) {}
7004 }
7005 }
7006 set arcids($a) [lindex $line 2]
7007 foreach id $arcids($a) {
7008 lappend allparents($s) $id
7009 set s $id
7010 lappend arcnos($id) $a
7011 }
7012 if {![info exists allparents($s)]} {
7013 set allparents($s) {}
7014 }
7015 set arctags($a) {}
7016 set archeads($a) {}
7017 }
7018 set nextarc [expr {$a - 1}]
7019 }
7020 } err]} {
7021 dropcache $err
7022 return 0
7023 }
7024 if {!$allcwait} {
7025 getallcommits
7026 }
7027 return $allcwait
7028}
7029
7030proc getcache {f} {
7031 global nextarc cachedarcs possible_seeds
7032
7033 if {[catch {
7034 set line [gets $f]
7035 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7036 # make sure it's an integer
7037 set cachedarcs [expr {int([lindex $line 1])}]
7038 if {$cachedarcs < 0} {error "bad number of arcs"}
7039 set nextarc 0
7040 set possible_seeds {}
7041 run readcache $f
7042 } err]} {
7043 dropcache $err
7044 }
7045 return 0
7046}
7047
7048proc dropcache {err} {
7049 global allcwait nextarc cachedarcs seeds
7050
7051 #puts "dropping cache ($err)"
7052 foreach v {arcnos arcout arcids arcstart arcend growing \
7053 arctags archeads allparents allchildren} {
7054 global $v
7055 catch {unset $v}
7056 }
7057 set allcwait 0
7058 set nextarc 0
7059 set cachedarcs 0
7060 set seeds {}
7061 getallcommits
7062}
7063
7064proc writecache {f} {
7065 global cachearc cachedarcs allccache
7066 global arcstart arcend arcnos arcids arcout
7067
7068 set a $cachearc
7069 set lim $cachedarcs
7070 if {$lim - $a > 1000} {
7071 set lim [expr {$a + 1000}]
7072 }
7073 if {[catch {
7074 while {[incr a] <= $lim} {
7075 if {[info exists arcend($a)]} {
7076 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7077 } else {
7078 puts $f [list $arcstart($a) {} $arcids($a)]
7079 }
7080 }
7081 } err]} {
7082 catch {close $f}
7083 catch {file delete $allccache}
7084 #puts "writing cache failed ($err)"
7085 return 0
7086 }
7087 set cachearc [expr {$a - 1}]
7088 if {$a > $cachedarcs} {
7089 puts $f "1"
7090 close $f
7091 return 0
7092 }
7093 return 1
7094}
7095
7096proc savecache {} {
7097 global nextarc cachedarcs cachearc allccache
7098
7099 if {$nextarc == $cachedarcs} return
7100 set cachearc 0
7101 set cachedarcs $nextarc
7102 catch {
7103 set f [open $allccache w]
7104 puts $f [list 1 $cachedarcs]
7105 run writecache $f
7106 }
7107}
7108
7109# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7110# or 0 if neither is true.
7111proc anc_or_desc {a b} {
7112 global arcout arcstart arcend arcnos cached_isanc
7113
7114 if {$arcnos($a) eq $arcnos($b)} {
7115 # Both are on the same arc(s); either both are the same BMP,
7116 # or if one is not a BMP, the other is also not a BMP or is
7117 # the BMP at end of the arc (and it only has 1 incoming arc).
7118 # Or both can be BMPs with no incoming arcs.
7119 if {$a eq $b || $arcnos($a) eq {}} {
7120 return 0
7121 }
7122 # assert {[llength $arcnos($a)] == 1}
7123 set arc [lindex $arcnos($a) 0]
7124 set i [lsearch -exact $arcids($arc) $a]
7125 set j [lsearch -exact $arcids($arc) $b]
7126 if {$i < 0 || $i > $j} {
7127 return 1
7128 } else {
7129 return -1
7130 }
7131 }
7132
7133 if {![info exists arcout($a)]} {
7134 set arc [lindex $arcnos($a) 0]
7135 if {[info exists arcend($arc)]} {
7136 set aend $arcend($arc)
7137 } else {
7138 set aend {}
7139 }
7140 set a $arcstart($arc)
7141 } else {
7142 set aend $a
7143 }
7144 if {![info exists arcout($b)]} {
7145 set arc [lindex $arcnos($b) 0]
7146 if {[info exists arcend($arc)]} {
7147 set bend $arcend($arc)
7148 } else {
7149 set bend {}
7150 }
7151 set b $arcstart($arc)
7152 } else {
7153 set bend $b
7154 }
7155 if {$a eq $bend} {
7156 return 1
7157 }
7158 if {$b eq $aend} {
7159 return -1
7160 }
7161 if {[info exists cached_isanc($a,$bend)]} {
7162 if {$cached_isanc($a,$bend)} {
7163 return 1
7164 }
7165 }
7166 if {[info exists cached_isanc($b,$aend)]} {
7167 if {$cached_isanc($b,$aend)} {
7168 return -1
7169 }
7170 if {[info exists cached_isanc($a,$bend)]} {
7171 return 0
7172 }
7173 }
7174
7175 set todo [list $a $b]
7176 set anc($a) a
7177 set anc($b) b
7178 for {set i 0} {$i < [llength $todo]} {incr i} {
7179 set x [lindex $todo $i]
7180 if {$anc($x) eq {}} {
7181 continue
7182 }
7183 foreach arc $arcnos($x) {
7184 set xd $arcstart($arc)
7185 if {$xd eq $bend} {
7186 set cached_isanc($a,$bend) 1
7187 set cached_isanc($b,$aend) 0
7188 return 1
7189 } elseif {$xd eq $aend} {
7190 set cached_isanc($b,$aend) 1
7191 set cached_isanc($a,$bend) 0
7192 return -1
7193 }
7194 if {![info exists anc($xd)]} {
7195 set anc($xd) $anc($x)
7196 lappend todo $xd
7197 } elseif {$anc($xd) ne $anc($x)} {
7198 set anc($xd) {}
7199 }
7200 }
7201 }
7202 set cached_isanc($a,$bend) 0
7203 set cached_isanc($b,$aend) 0
7204 return 0
7205}
7206
7207# This identifies whether $desc has an ancestor that is
7208# a growing tip of the graph and which is not an ancestor of $anc
7209# and returns 0 if so and 1 if not.
7210# If we subsequently discover a tag on such a growing tip, and that
7211# turns out to be a descendent of $anc (which it could, since we
7212# don't necessarily see children before parents), then $desc
7213# isn't a good choice to display as a descendent tag of
7214# $anc (since it is the descendent of another tag which is
7215# a descendent of $anc). Similarly, $anc isn't a good choice to
7216# display as a ancestor tag of $desc.
7217#
7218proc is_certain {desc anc} {
7219 global arcnos arcout arcstart arcend growing problems
7220
7221 set certain {}
7222 if {[llength $arcnos($anc)] == 1} {
7223 # tags on the same arc are certain
7224 if {$arcnos($desc) eq $arcnos($anc)} {
7225 return 1
7226 }
7227 if {![info exists arcout($anc)]} {
7228 # if $anc is partway along an arc, use the start of the arc instead
7229 set a [lindex $arcnos($anc) 0]
7230 set anc $arcstart($a)
7231 }
7232 }
7233 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7234 set x $desc
7235 } else {
7236 set a [lindex $arcnos($desc) 0]
7237 set x $arcend($a)
7238 }
7239 if {$x == $anc} {
7240 return 1
7241 }
7242 set anclist [list $x]
7243 set dl($x) 1
7244 set nnh 1
7245 set ngrowanc 0
7246 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7247 set x [lindex $anclist $i]
7248 if {$dl($x)} {
7249 incr nnh -1
7250 }
7251 set done($x) 1
7252 foreach a $arcout($x) {
7253 if {[info exists growing($a)]} {
7254 if {![info exists growanc($x)] && $dl($x)} {
7255 set growanc($x) 1
7256 incr ngrowanc
7257 }
7258 } else {
7259 set y $arcend($a)
7260 if {[info exists dl($y)]} {
7261 if {$dl($y)} {
7262 if {!$dl($x)} {
7263 set dl($y) 0
7264 if {![info exists done($y)]} {
7265 incr nnh -1
7266 }
7267 if {[info exists growanc($x)]} {
7268 incr ngrowanc -1
7269 }
7270 set xl [list $y]
7271 for {set k 0} {$k < [llength $xl]} {incr k} {
7272 set z [lindex $xl $k]
7273 foreach c $arcout($z) {
7274 if {[info exists arcend($c)]} {
7275 set v $arcend($c)
7276 if {[info exists dl($v)] && $dl($v)} {
7277 set dl($v) 0
7278 if {![info exists done($v)]} {
7279 incr nnh -1
7280 }
7281 if {[info exists growanc($v)]} {
7282 incr ngrowanc -1
7283 }
7284 lappend xl $v
7285 }
7286 }
7287 }
7288 }
7289 }
7290 }
7291 } elseif {$y eq $anc || !$dl($x)} {
7292 set dl($y) 0
7293 lappend anclist $y
7294 } else {
7295 set dl($y) 1
7296 lappend anclist $y
7297 incr nnh
7298 }
7299 }
7300 }
7301 }
7302 foreach x [array names growanc] {
7303 if {$dl($x)} {
7304 return 0
7305 }
7306 return 0
7307 }
7308 return 1
7309}
7310
7311proc validate_arctags {a} {
7312 global arctags idtags
7313
7314 set i -1
7315 set na $arctags($a)
7316 foreach id $arctags($a) {
7317 incr i
7318 if {![info exists idtags($id)]} {
7319 set na [lreplace $na $i $i]
7320 incr i -1
7321 }
7322 }
7323 set arctags($a) $na
7324}
7325
7326proc validate_archeads {a} {
7327 global archeads idheads
7328
7329 set i -1
7330 set na $archeads($a)
7331 foreach id $archeads($a) {
7332 incr i
7333 if {![info exists idheads($id)]} {
7334 set na [lreplace $na $i $i]
7335 incr i -1
7336 }
7337 }
7338 set archeads($a) $na
7339}
7340
7341# Return the list of IDs that have tags that are descendents of id,
7342# ignoring IDs that are descendents of IDs already reported.
7343proc desctags {id} {
7344 global arcnos arcstart arcids arctags idtags allparents
7345 global growing cached_dtags
7346
7347 if {![info exists allparents($id)]} {
7348 return {}
7349 }
7350 set t1 [clock clicks -milliseconds]
7351 set argid $id
7352 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7353 # part-way along an arc; check that arc first
7354 set a [lindex $arcnos($id) 0]
7355 if {$arctags($a) ne {}} {
7356 validate_arctags $a
7357 set i [lsearch -exact $arcids($a) $id]
7358 set tid {}
7359 foreach t $arctags($a) {
7360 set j [lsearch -exact $arcids($a) $t]
7361 if {$j >= $i} break
7362 set tid $t
7363 }
7364 if {$tid ne {}} {
7365 return $tid
7366 }
7367 }
7368 set id $arcstart($a)
7369 if {[info exists idtags($id)]} {
7370 return $id
7371 }
7372 }
7373 if {[info exists cached_dtags($id)]} {
7374 return $cached_dtags($id)
7375 }
7376
7377 set origid $id
7378 set todo [list $id]
7379 set queued($id) 1
7380 set nc 1
7381 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7382 set id [lindex $todo $i]
7383 set done($id) 1
7384 set ta [info exists hastaggedancestor($id)]
7385 if {!$ta} {
7386 incr nc -1
7387 }
7388 # ignore tags on starting node
7389 if {!$ta && $i > 0} {
7390 if {[info exists idtags($id)]} {
7391 set tagloc($id) $id
7392 set ta 1
7393 } elseif {[info exists cached_dtags($id)]} {
7394 set tagloc($id) $cached_dtags($id)
7395 set ta 1
7396 }
7397 }
7398 foreach a $arcnos($id) {
7399 set d $arcstart($a)
7400 if {!$ta && $arctags($a) ne {}} {
7401 validate_arctags $a
7402 if {$arctags($a) ne {}} {
7403 lappend tagloc($id) [lindex $arctags($a) end]
7404 }
7405 }
7406 if {$ta || $arctags($a) ne {}} {
7407 set tomark [list $d]
7408 for {set j 0} {$j < [llength $tomark]} {incr j} {
7409 set dd [lindex $tomark $j]
7410 if {![info exists hastaggedancestor($dd)]} {
7411 if {[info exists done($dd)]} {
7412 foreach b $arcnos($dd) {
7413 lappend tomark $arcstart($b)
7414 }
7415 if {[info exists tagloc($dd)]} {
7416 unset tagloc($dd)
7417 }
7418 } elseif {[info exists queued($dd)]} {
7419 incr nc -1
7420 }
7421 set hastaggedancestor($dd) 1
7422 }
7423 }
7424 }
7425 if {![info exists queued($d)]} {
7426 lappend todo $d
7427 set queued($d) 1
7428 if {![info exists hastaggedancestor($d)]} {
7429 incr nc
7430 }
7431 }
7432 }
7433 }
7434 set tags {}
7435 foreach id [array names tagloc] {
7436 if {![info exists hastaggedancestor($id)]} {
7437 foreach t $tagloc($id) {
7438 if {[lsearch -exact $tags $t] < 0} {
7439 lappend tags $t
7440 }
7441 }
7442 }
7443 }
7444 set t2 [clock clicks -milliseconds]
7445 set loopix $i
7446
7447 # remove tags that are descendents of other tags
7448 for {set i 0} {$i < [llength $tags]} {incr i} {
7449 set a [lindex $tags $i]
7450 for {set j 0} {$j < $i} {incr j} {
7451 set b [lindex $tags $j]
7452 set r [anc_or_desc $a $b]
7453 if {$r == 1} {
7454 set tags [lreplace $tags $j $j]
7455 incr j -1
7456 incr i -1
7457 } elseif {$r == -1} {
7458 set tags [lreplace $tags $i $i]
7459 incr i -1
7460 break
7461 }
7462 }
7463 }
7464
7465 if {[array names growing] ne {}} {
7466 # graph isn't finished, need to check if any tag could get
7467 # eclipsed by another tag coming later. Simply ignore any
7468 # tags that could later get eclipsed.
7469 set ctags {}
7470 foreach t $tags {
7471 if {[is_certain $t $origid]} {
7472 lappend ctags $t
7473 }
7474 }
7475 if {$tags eq $ctags} {
7476 set cached_dtags($origid) $tags
7477 } else {
7478 set tags $ctags
7479 }
7480 } else {
7481 set cached_dtags($origid) $tags
7482 }
7483 set t3 [clock clicks -milliseconds]
7484 if {0 && $t3 - $t1 >= 100} {
7485 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7486 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7487 }
7488 return $tags
7489}
7490
7491proc anctags {id} {
7492 global arcnos arcids arcout arcend arctags idtags allparents
7493 global growing cached_atags
7494
7495 if {![info exists allparents($id)]} {
7496 return {}
7497 }
7498 set t1 [clock clicks -milliseconds]
7499 set argid $id
7500 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7501 # part-way along an arc; check that arc first
7502 set a [lindex $arcnos($id) 0]
7503 if {$arctags($a) ne {}} {
7504 validate_arctags $a
7505 set i [lsearch -exact $arcids($a) $id]
7506 foreach t $arctags($a) {
7507 set j [lsearch -exact $arcids($a) $t]
7508 if {$j > $i} {
7509 return $t
7510 }
7511 }
7512 }
7513 if {![info exists arcend($a)]} {
7514 return {}
7515 }
7516 set id $arcend($a)
7517 if {[info exists idtags($id)]} {
7518 return $id
7519 }
7520 }
7521 if {[info exists cached_atags($id)]} {
7522 return $cached_atags($id)
7523 }
7524
7525 set origid $id
7526 set todo [list $id]
7527 set queued($id) 1
7528 set taglist {}
7529 set nc 1
7530 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7531 set id [lindex $todo $i]
7532 set done($id) 1
7533 set td [info exists hastaggeddescendent($id)]
7534 if {!$td} {
7535 incr nc -1
7536 }
7537 # ignore tags on starting node
7538 if {!$td && $i > 0} {
7539 if {[info exists idtags($id)]} {
7540 set tagloc($id) $id
7541 set td 1
7542 } elseif {[info exists cached_atags($id)]} {
7543 set tagloc($id) $cached_atags($id)
7544 set td 1
7545 }
7546 }
7547 foreach a $arcout($id) {
7548 if {!$td && $arctags($a) ne {}} {
7549 validate_arctags $a
7550 if {$arctags($a) ne {}} {
7551 lappend tagloc($id) [lindex $arctags($a) 0]
7552 }
7553 }
7554 if {![info exists arcend($a)]} continue
7555 set d $arcend($a)
7556 if {$td || $arctags($a) ne {}} {
7557 set tomark [list $d]
7558 for {set j 0} {$j < [llength $tomark]} {incr j} {
7559 set dd [lindex $tomark $j]
7560 if {![info exists hastaggeddescendent($dd)]} {
7561 if {[info exists done($dd)]} {
7562 foreach b $arcout($dd) {
7563 if {[info exists arcend($b)]} {
7564 lappend tomark $arcend($b)
7565 }
7566 }
7567 if {[info exists tagloc($dd)]} {
7568 unset tagloc($dd)
7569 }
7570 } elseif {[info exists queued($dd)]} {
7571 incr nc -1
7572 }
7573 set hastaggeddescendent($dd) 1
7574 }
7575 }
7576 }
7577 if {![info exists queued($d)]} {
7578 lappend todo $d
7579 set queued($d) 1
7580 if {![info exists hastaggeddescendent($d)]} {
7581 incr nc
7582 }
7583 }
7584 }
7585 }
7586 set t2 [clock clicks -milliseconds]
7587 set loopix $i
7588 set tags {}
7589 foreach id [array names tagloc] {
7590 if {![info exists hastaggeddescendent($id)]} {
7591 foreach t $tagloc($id) {
7592 if {[lsearch -exact $tags $t] < 0} {
7593 lappend tags $t
7594 }
7595 }
7596 }
7597 }
7598
7599 # remove tags that are ancestors of other tags
7600 for {set i 0} {$i < [llength $tags]} {incr i} {
7601 set a [lindex $tags $i]
7602 for {set j 0} {$j < $i} {incr j} {
7603 set b [lindex $tags $j]
7604 set r [anc_or_desc $a $b]
7605 if {$r == -1} {
7606 set tags [lreplace $tags $j $j]
7607 incr j -1
7608 incr i -1
7609 } elseif {$r == 1} {
7610 set tags [lreplace $tags $i $i]
7611 incr i -1
7612 break
7613 }
7614 }
7615 }
7616
7617 if {[array names growing] ne {}} {
7618 # graph isn't finished, need to check if any tag could get
7619 # eclipsed by another tag coming later. Simply ignore any
7620 # tags that could later get eclipsed.
7621 set ctags {}
7622 foreach t $tags {
7623 if {[is_certain $origid $t]} {
7624 lappend ctags $t
7625 }
7626 }
7627 if {$tags eq $ctags} {
7628 set cached_atags($origid) $tags
7629 } else {
7630 set tags $ctags
7631 }
7632 } else {
7633 set cached_atags($origid) $tags
7634 }
7635 set t3 [clock clicks -milliseconds]
7636 if {0 && $t3 - $t1 >= 100} {
7637 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7638 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7639 }
7640 return $tags
7641}
7642
7643# Return the list of IDs that have heads that are descendents of id,
7644# including id itself if it has a head.
7645proc descheads {id} {
7646 global arcnos arcstart arcids archeads idheads cached_dheads
7647 global allparents
7648
7649 if {![info exists allparents($id)]} {
7650 return {}
7651 }
7652 set aret {}
7653 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7654 # part-way along an arc; check it first
7655 set a [lindex $arcnos($id) 0]
7656 if {$archeads($a) ne {}} {
7657 validate_archeads $a
7658 set i [lsearch -exact $arcids($a) $id]
7659 foreach t $archeads($a) {
7660 set j [lsearch -exact $arcids($a) $t]
7661 if {$j > $i} break
7662 lappend aret $t
7663 }
7664 }
7665 set id $arcstart($a)
7666 }
7667 set origid $id
7668 set todo [list $id]
7669 set seen($id) 1
7670 set ret {}
7671 for {set i 0} {$i < [llength $todo]} {incr i} {
7672 set id [lindex $todo $i]
7673 if {[info exists cached_dheads($id)]} {
7674 set ret [concat $ret $cached_dheads($id)]
7675 } else {
7676 if {[info exists idheads($id)]} {
7677 lappend ret $id
7678 }
7679 foreach a $arcnos($id) {
7680 if {$archeads($a) ne {}} {
7681 validate_archeads $a
7682 if {$archeads($a) ne {}} {
7683 set ret [concat $ret $archeads($a)]
7684 }
7685 }
7686 set d $arcstart($a)
7687 if {![info exists seen($d)]} {
7688 lappend todo $d
7689 set seen($d) 1
7690 }
7691 }
7692 }
7693 }
7694 set ret [lsort -unique $ret]
7695 set cached_dheads($origid) $ret
7696 return [concat $ret $aret]
7697}
7698
7699proc addedtag {id} {
7700 global arcnos arcout cached_dtags cached_atags
7701
7702 if {![info exists arcnos($id)]} return
7703 if {![info exists arcout($id)]} {
7704 recalcarc [lindex $arcnos($id) 0]
7705 }
7706 catch {unset cached_dtags}
7707 catch {unset cached_atags}
7708}
7709
7710proc addedhead {hid head} {
7711 global arcnos arcout cached_dheads
7712
7713 if {![info exists arcnos($hid)]} return
7714 if {![info exists arcout($hid)]} {
7715 recalcarc [lindex $arcnos($hid) 0]
7716 }
7717 catch {unset cached_dheads}
7718}
7719
7720proc removedhead {hid head} {
7721 global cached_dheads
7722
7723 catch {unset cached_dheads}
7724}
7725
7726proc movedhead {hid head} {
7727 global arcnos arcout cached_dheads
7728
7729 if {![info exists arcnos($hid)]} return
7730 if {![info exists arcout($hid)]} {
7731 recalcarc [lindex $arcnos($hid) 0]
7732 }
7733 catch {unset cached_dheads}
7734}
7735
7736proc changedrefs {} {
7737 global cached_dheads cached_dtags cached_atags
7738 global arctags archeads arcnos arcout idheads idtags
7739
7740 foreach id [concat [array names idheads] [array names idtags]] {
7741 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7742 set a [lindex $arcnos($id) 0]
7743 if {![info exists donearc($a)]} {
7744 recalcarc $a
7745 set donearc($a) 1
7746 }
7747 }
7748 }
7749 catch {unset cached_dtags}
7750 catch {unset cached_atags}
7751 catch {unset cached_dheads}
7752}
7753
7754proc rereadrefs {} {
7755 global idtags idheads idotherrefs mainhead
7756
7757 set refids [concat [array names idtags] \
7758 [array names idheads] [array names idotherrefs]]
7759 foreach id $refids {
7760 if {![info exists ref($id)]} {
7761 set ref($id) [listrefs $id]
7762 }
7763 }
7764 set oldmainhead $mainhead
7765 readrefs
7766 changedrefs
7767 set refids [lsort -unique [concat $refids [array names idtags] \
7768 [array names idheads] [array names idotherrefs]]]
7769 foreach id $refids {
7770 set v [listrefs $id]
7771 if {![info exists ref($id)] || $ref($id) != $v ||
7772 ($id eq $oldmainhead && $id ne $mainhead) ||
7773 ($id eq $mainhead && $id ne $oldmainhead)} {
7774 redrawtags $id
7775 }
7776 }
7777 run refill_reflist
7778}
7779
7780proc listrefs {id} {
7781 global idtags idheads idotherrefs
7782
7783 set x {}
7784 if {[info exists idtags($id)]} {
7785 set x $idtags($id)
7786 }
7787 set y {}
7788 if {[info exists idheads($id)]} {
7789 set y $idheads($id)
7790 }
7791 set z {}
7792 if {[info exists idotherrefs($id)]} {
7793 set z $idotherrefs($id)
7794 }
7795 return [list $x $y $z]
7796}
7797
7798proc showtag {tag isnew} {
7799 global ctext tagcontents tagids linknum tagobjid
7800
7801 if {$isnew} {
7802 addtohistory [list showtag $tag 0]
7803 }
7804 $ctext conf -state normal
7805 clear_ctext
7806 settabs 0
7807 set linknum 0
7808 if {![info exists tagcontents($tag)]} {
7809 catch {
7810 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7811 }
7812 }
7813 if {[info exists tagcontents($tag)]} {
7814 set text $tagcontents($tag)
7815 } else {
7816 set text "Tag: $tag\nId: $tagids($tag)"
7817 }
7818 appendwithlinks $text {}
7819 $ctext conf -state disabled
7820 init_flist {}
7821}
7822
7823proc doquit {} {
7824 global stopped
7825 set stopped 100
7826 savestuff .
7827 destroy .
7828}
7829
7830proc doprefs {} {
7831 global maxwidth maxgraphpct diffopts
7832 global oldprefs prefstop showneartags showlocalchanges
7833 global bgcolor fgcolor ctext diffcolors selectbgcolor
7834 global uifont tabstop
7835
7836 set top .gitkprefs
7837 set prefstop $top
7838 if {[winfo exists $top]} {
7839 raise $top
7840 return
7841 }
7842 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7843 set oldprefs($v) [set $v]
7844 }
7845 toplevel $top
7846 wm title $top "Gitk preferences"
7847 label $top.ldisp -text "Commit list display options"
7848 $top.ldisp configure -font $uifont
7849 grid $top.ldisp - -sticky w -pady 10
7850 label $top.spacer -text " "
7851 label $top.maxwidthl -text "Maximum graph width (lines)" \
7852 -font optionfont
7853 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7854 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7855 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7856 -font optionfont
7857 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7858 grid x $top.maxpctl $top.maxpct -sticky w
7859 frame $top.showlocal
7860 label $top.showlocal.l -text "Show local changes" -font optionfont
7861 checkbutton $top.showlocal.b -variable showlocalchanges
7862 pack $top.showlocal.b $top.showlocal.l -side left
7863 grid x $top.showlocal -sticky w
7864
7865 label $top.ddisp -text "Diff display options"
7866 $top.ddisp configure -font $uifont
7867 grid $top.ddisp - -sticky w -pady 10
7868 label $top.diffoptl -text "Options for diff program" \
7869 -font optionfont
7870 entry $top.diffopt -width 20 -textvariable diffopts
7871 grid x $top.diffoptl $top.diffopt -sticky w
7872 frame $top.ntag
7873 label $top.ntag.l -text "Display nearby tags" -font optionfont
7874 checkbutton $top.ntag.b -variable showneartags
7875 pack $top.ntag.b $top.ntag.l -side left
7876 grid x $top.ntag -sticky w
7877 label $top.tabstopl -text "tabstop" -font optionfont
7878 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7879 grid x $top.tabstopl $top.tabstop -sticky w
7880
7881 label $top.cdisp -text "Colors: press to choose"
7882 $top.cdisp configure -font $uifont
7883 grid $top.cdisp - -sticky w -pady 10
7884 label $top.bg -padx 40 -relief sunk -background $bgcolor
7885 button $top.bgbut -text "Background" -font optionfont \
7886 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7887 grid x $top.bgbut $top.bg -sticky w
7888 label $top.fg -padx 40 -relief sunk -background $fgcolor
7889 button $top.fgbut -text "Foreground" -font optionfont \
7890 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7891 grid x $top.fgbut $top.fg -sticky w
7892 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7893 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7894 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7895 [list $ctext tag conf d0 -foreground]]
7896 grid x $top.diffoldbut $top.diffold -sticky w
7897 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7898 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7899 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7900 [list $ctext tag conf d1 -foreground]]
7901 grid x $top.diffnewbut $top.diffnew -sticky w
7902 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7903 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7904 -command [list choosecolor diffcolors 2 $top.hunksep \
7905 "diff hunk header" \
7906 [list $ctext tag conf hunksep -foreground]]
7907 grid x $top.hunksepbut $top.hunksep -sticky w
7908 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7909 button $top.selbgbut -text "Select bg" -font optionfont \
7910 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7911 grid x $top.selbgbut $top.selbgsep -sticky w
7912
7913 frame $top.buts
7914 button $top.buts.ok -text "OK" -command prefsok -default active
7915 $top.buts.ok configure -font $uifont
7916 button $top.buts.can -text "Cancel" -command prefscan -default normal
7917 $top.buts.can configure -font $uifont
7918 grid $top.buts.ok $top.buts.can
7919 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7920 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7921 grid $top.buts - - -pady 10 -sticky ew
7922 bind $top <Visibility> "focus $top.buts.ok"
7923}
7924
7925proc choosecolor {v vi w x cmd} {
7926 global $v
7927
7928 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7929 -title "Gitk: choose color for $x"]
7930 if {$c eq {}} return
7931 $w conf -background $c
7932 lset $v $vi $c
7933 eval $cmd $c
7934}
7935
7936proc setselbg {c} {
7937 global bglist cflist
7938 foreach w $bglist {
7939 $w configure -selectbackground $c
7940 }
7941 $cflist tag configure highlight \
7942 -background [$cflist cget -selectbackground]
7943 allcanvs itemconf secsel -fill $c
7944}
7945
7946proc setbg {c} {
7947 global bglist
7948
7949 foreach w $bglist {
7950 $w conf -background $c
7951 }
7952}
7953
7954proc setfg {c} {
7955 global fglist canv
7956
7957 foreach w $fglist {
7958 $w conf -foreground $c
7959 }
7960 allcanvs itemconf text -fill $c
7961 $canv itemconf circle -outline $c
7962}
7963
7964proc prefscan {} {
7965 global maxwidth maxgraphpct diffopts
7966 global oldprefs prefstop showneartags showlocalchanges
7967
7968 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7969 set $v $oldprefs($v)
7970 }
7971 catch {destroy $prefstop}
7972 unset prefstop
7973}
7974
7975proc prefsok {} {
7976 global maxwidth maxgraphpct
7977 global oldprefs prefstop showneartags showlocalchanges
7978
7979 catch {destroy $prefstop}
7980 unset prefstop
7981 settabs
7982 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7983 if {$showlocalchanges} {
7984 doshowlocalchanges
7985 } else {
7986 dohidelocalchanges
7987 }
7988 }
7989 if {$maxwidth != $oldprefs(maxwidth)
7990 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7991 redisplay
7992 } elseif {$showneartags != $oldprefs(showneartags)} {
7993 reselectline
7994 }
7995}
7996
7997proc formatdate {d} {
7998 global datetimeformat
7999 if {$d ne {}} {
8000 set d [clock format $d -format $datetimeformat]
8001 }
8002 return $d
8003}
8004
8005# This list of encoding names and aliases is distilled from
8006# http://www.iana.org/assignments/character-sets.
8007# Not all of them are supported by Tcl.
8008set encoding_aliases {
8009 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8010 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8011 { ISO-10646-UTF-1 csISO10646UTF1 }
8012 { ISO_646.basic:1983 ref csISO646basic1983 }
8013 { INVARIANT csINVARIANT }
8014 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8015 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8016 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8017 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8018 { NATS-DANO iso-ir-9-1 csNATSDANO }
8019 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8020 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8021 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8022 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8023 { ISO-2022-KR csISO2022KR }
8024 { EUC-KR csEUCKR }
8025 { ISO-2022-JP csISO2022JP }
8026 { ISO-2022-JP-2 csISO2022JP2 }
8027 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8028 csISO13JISC6220jp }
8029 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8030 { IT iso-ir-15 ISO646-IT csISO15Italian }
8031 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8032 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8033 { greek7-old iso-ir-18 csISO18Greek7Old }
8034 { latin-greek iso-ir-19 csISO19LatinGreek }
8035 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8036 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8037 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8038 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8039 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8040 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8041 { INIS iso-ir-49 csISO49INIS }
8042 { INIS-8 iso-ir-50 csISO50INIS8 }
8043 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8044 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8045 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8046 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8047 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8048 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8049 csISO60Norwegian1 }
8050 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8051 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8052 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8053 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8054 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8055 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8056 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8057 { greek7 iso-ir-88 csISO88Greek7 }
8058 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8059 { iso-ir-90 csISO90 }
8060 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8061 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8062 csISO92JISC62991984b }
8063 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8064 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8065 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8066 csISO95JIS62291984handadd }
8067 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8068 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8069 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8070 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8071 CP819 csISOLatin1 }
8072 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8073 { T.61-7bit iso-ir-102 csISO102T617bit }
8074 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8075 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8076 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8077 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8078 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8079 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8080 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8081 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8082 arabic csISOLatinArabic }
8083 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8084 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8085 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8086 greek greek8 csISOLatinGreek }
8087 { T.101-G2 iso-ir-128 csISO128T101G2 }
8088 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8089 csISOLatinHebrew }
8090 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8091 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8092 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8093 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8094 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8095 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8096 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8097 csISOLatinCyrillic }
8098 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8099 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8100 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8101 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8102 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8103 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8104 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8105 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8106 { ISO_10367-box iso-ir-155 csISO10367Box }
8107 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8108 { latin-lap lap iso-ir-158 csISO158Lap }
8109 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8110 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8111 { us-dk csUSDK }
8112 { dk-us csDKUS }
8113 { JIS_X0201 X0201 csHalfWidthKatakana }
8114 { KSC5636 ISO646-KR csKSC5636 }
8115 { ISO-10646-UCS-2 csUnicode }
8116 { ISO-10646-UCS-4 csUCS4 }
8117 { DEC-MCS dec csDECMCS }
8118 { hp-roman8 roman8 r8 csHPRoman8 }
8119 { macintosh mac csMacintosh }
8120 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8121 csIBM037 }
8122 { IBM038 EBCDIC-INT cp038 csIBM038 }
8123 { IBM273 CP273 csIBM273 }
8124 { IBM274 EBCDIC-BE CP274 csIBM274 }
8125 { IBM275 EBCDIC-BR cp275 csIBM275 }
8126 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8127 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8128 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8129 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8130 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8131 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8132 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8133 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8134 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8135 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8136 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8137 { IBM437 cp437 437 csPC8CodePage437 }
8138 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8139 { IBM775 cp775 csPC775Baltic }
8140 { IBM850 cp850 850 csPC850Multilingual }
8141 { IBM851 cp851 851 csIBM851 }
8142 { IBM852 cp852 852 csPCp852 }
8143 { IBM855 cp855 855 csIBM855 }
8144 { IBM857 cp857 857 csIBM857 }
8145 { IBM860 cp860 860 csIBM860 }
8146 { IBM861 cp861 861 cp-is csIBM861 }
8147 { IBM862 cp862 862 csPC862LatinHebrew }
8148 { IBM863 cp863 863 csIBM863 }
8149 { IBM864 cp864 csIBM864 }
8150 { IBM865 cp865 865 csIBM865 }
8151 { IBM866 cp866 866 csIBM866 }
8152 { IBM868 CP868 cp-ar csIBM868 }
8153 { IBM869 cp869 869 cp-gr csIBM869 }
8154 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8155 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8156 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8157 { IBM891 cp891 csIBM891 }
8158 { IBM903 cp903 csIBM903 }
8159 { IBM904 cp904 904 csIBBM904 }
8160 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8161 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8162 { IBM1026 CP1026 csIBM1026 }
8163 { EBCDIC-AT-DE csIBMEBCDICATDE }
8164 { EBCDIC-AT-DE-A csEBCDICATDEA }
8165 { EBCDIC-CA-FR csEBCDICCAFR }
8166 { EBCDIC-DK-NO csEBCDICDKNO }
8167 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8168 { EBCDIC-FI-SE csEBCDICFISE }
8169 { EBCDIC-FI-SE-A csEBCDICFISEA }
8170 { EBCDIC-FR csEBCDICFR }
8171 { EBCDIC-IT csEBCDICIT }
8172 { EBCDIC-PT csEBCDICPT }
8173 { EBCDIC-ES csEBCDICES }
8174 { EBCDIC-ES-A csEBCDICESA }
8175 { EBCDIC-ES-S csEBCDICESS }
8176 { EBCDIC-UK csEBCDICUK }
8177 { EBCDIC-US csEBCDICUS }
8178 { UNKNOWN-8BIT csUnknown8BiT }
8179 { MNEMONIC csMnemonic }
8180 { MNEM csMnem }
8181 { VISCII csVISCII }
8182 { VIQR csVIQR }
8183 { KOI8-R csKOI8R }
8184 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8185 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8186 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8187 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8188 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8189 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8190 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8191 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8192 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8193 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8194 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8195 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8196 { IBM1047 IBM-1047 }
8197 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8198 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8199 { UNICODE-1-1 csUnicode11 }
8200 { CESU-8 csCESU-8 }
8201 { BOCU-1 csBOCU-1 }
8202 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8203 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8204 l8 }
8205 { ISO-8859-15 ISO_8859-15 Latin-9 }
8206 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8207 { GBK CP936 MS936 windows-936 }
8208 { JIS_Encoding csJISEncoding }
8209 { Shift_JIS MS_Kanji csShiftJIS }
8210 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8211 EUC-JP }
8212 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8213 { ISO-10646-UCS-Basic csUnicodeASCII }
8214 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8215 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8216 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8217 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8218 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8219 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8220 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8221 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8222 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8223 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8224 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8225 { Ventura-US csVenturaUS }
8226 { Ventura-International csVenturaInternational }
8227 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8228 { PC8-Turkish csPC8Turkish }
8229 { IBM-Symbols csIBMSymbols }
8230 { IBM-Thai csIBMThai }
8231 { HP-Legal csHPLegal }
8232 { HP-Pi-font csHPPiFont }
8233 { HP-Math8 csHPMath8 }
8234 { Adobe-Symbol-Encoding csHPPSMath }
8235 { HP-DeskTop csHPDesktop }
8236 { Ventura-Math csVenturaMath }
8237 { Microsoft-Publishing csMicrosoftPublishing }
8238 { Windows-31J csWindows31J }
8239 { GB2312 csGB2312 }
8240 { Big5 csBig5 }
8241}
8242
8243proc tcl_encoding {enc} {
8244 global encoding_aliases
8245 set names [encoding names]
8246 set lcnames [string tolower $names]
8247 set enc [string tolower $enc]
8248 set i [lsearch -exact $lcnames $enc]
8249 if {$i < 0} {
8250 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8251 if {[regsub {^iso[-_]} $enc iso encx]} {
8252 set i [lsearch -exact $lcnames $encx]
8253 }
8254 }
8255 if {$i < 0} {
8256 foreach l $encoding_aliases {
8257 set ll [string tolower $l]
8258 if {[lsearch -exact $ll $enc] < 0} continue
8259 # look through the aliases for one that tcl knows about
8260 foreach e $ll {
8261 set i [lsearch -exact $lcnames $e]
8262 if {$i < 0} {
8263 if {[regsub {^iso[-_]} $e iso ex]} {
8264 set i [lsearch -exact $lcnames $ex]
8265 }
8266 }
8267 if {$i >= 0} break
8268 }
8269 break
8270 }
8271 }
8272 if {$i >= 0} {
8273 return [lindex $names $i]
8274 }
8275 return {}
8276}
8277
8278# defaults...
8279set datemode 0
8280set diffopts "-U 5 -p"
8281set wrcomcmd "git diff-tree --stdin -p --pretty"
8282
8283set gitencoding {}
8284catch {
8285 set gitencoding [exec git config --get i18n.commitencoding]
8286}
8287if {$gitencoding == ""} {
8288 set gitencoding "utf-8"
8289}
8290set tclencoding [tcl_encoding $gitencoding]
8291if {$tclencoding == {}} {
8292 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8293}
8294
8295set mainfont {Helvetica 9}
8296set textfont {Courier 9}
8297set uifont {Helvetica 9 bold}
8298set tabstop 8
8299set findmergefiles 0
8300set maxgraphpct 50
8301set maxwidth 16
8302set revlistorder 0
8303set fastdate 0
8304set uparrowlen 5
8305set downarrowlen 5
8306set mingaplen 100
8307set cmitmode "patch"
8308set wrapcomment "none"
8309set showneartags 1
8310set maxrefs 20
8311set maxlinelen 200
8312set showlocalchanges 1
8313set datetimeformat "%Y-%m-%d %H:%M:%S"
8314
8315set colors {green red blue magenta darkgrey brown orange}
8316set bgcolor white
8317set fgcolor black
8318set diffcolors {red "#00a000" blue}
8319set diffcontext 3
8320set selectbgcolor gray85
8321
8322catch {source ~/.gitk}
8323
8324font create optionfont -family sans-serif -size -12
8325
8326# check that we can find a .git directory somewhere...
8327if {[catch {set gitdir [gitdir]}]} {
8328 show_error {} . "Cannot find a git repository here."
8329 exit 1
8330}
8331if {![file isdirectory $gitdir]} {
8332 show_error {} . "Cannot find the git directory \"$gitdir\"."
8333 exit 1
8334}
8335
8336set revtreeargs {}
8337set cmdline_files {}
8338set i 0
8339foreach arg $argv {
8340 switch -- $arg {
8341 "" { }
8342 "-d" { set datemode 1 }
8343 "--" {
8344 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8345 break
8346 }
8347 default {
8348 lappend revtreeargs $arg
8349 }
8350 }
8351 incr i
8352}
8353
8354if {$i >= [llength $argv] && $revtreeargs ne {}} {
8355 # no -- on command line, but some arguments (other than -d)
8356 if {[catch {
8357 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8358 set cmdline_files [split $f "\n"]
8359 set n [llength $cmdline_files]
8360 set revtreeargs [lrange $revtreeargs 0 end-$n]
8361 # Unfortunately git rev-parse doesn't produce an error when
8362 # something is both a revision and a filename. To be consistent
8363 # with git log and git rev-list, check revtreeargs for filenames.
8364 foreach arg $revtreeargs {
8365 if {[file exists $arg]} {
8366 show_error {} . "Ambiguous argument '$arg': both revision\
8367 and filename"
8368 exit 1
8369 }
8370 }
8371 } err]} {
8372 # unfortunately we get both stdout and stderr in $err,
8373 # so look for "fatal:".
8374 set i [string first "fatal:" $err]
8375 if {$i > 0} {
8376 set err [string range $err [expr {$i + 6}] end]
8377 }
8378 show_error {} . "Bad arguments to gitk:\n$err"
8379 exit 1
8380 }
8381}
8382
8383set nullid "0000000000000000000000000000000000000000"
8384set nullid2 "0000000000000000000000000000000000000001"
8385
8386set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8387
8388set runq {}
8389set history {}
8390set historyindex 0
8391set fh_serial 0
8392set nhl_names {}
8393set highlight_paths {}
8394set findpattern {}
8395set searchdirn -forwards
8396set boldrows {}
8397set boldnamerows {}
8398set diffelide {0 0}
8399set markingmatches 0
8400set linkentercount 0
8401set need_redisplay 0
8402set nrows_drawn 0
8403set firsttabstop 0
8404
8405set nextviewnum 1
8406set curview 0
8407set selectedview 0
8408set selectedhlview None
8409set highlight_related None
8410set highlight_files {}
8411set viewfiles(0) {}
8412set viewperm(0) 0
8413set viewargs(0) {}
8414
8415set cmdlineok 0
8416set stopped 0
8417set stuffsaved 0
8418set patchnum 0
8419set localirow -1
8420set localfrow -1
8421set lserial 0
8422setcoords
8423makewindow
8424# wait for the window to become visible
8425tkwait visibility .
8426wm title . "[file tail $argv0]: [file tail [pwd]]"
8427readrefs
8428
8429if {$cmdline_files ne {} || $revtreeargs ne {}} {
8430 # create a view for the files/dirs specified on the command line
8431 set curview 1
8432 set selectedview 1
8433 set nextviewnum 2
8434 set viewname(1) "Command line"
8435 set viewfiles(1) $cmdline_files
8436 set viewargs(1) $revtreeargs
8437 set viewperm(1) 0
8438 addviewmenu 1
8439 .bar.view entryconf Edit* -state normal
8440 .bar.view entryconf Delete* -state normal
8441}
8442
8443if {[info exists permviews]} {
8444 foreach v $permviews {
8445 set n $nextviewnum
8446 incr nextviewnum
8447 set viewname($n) [lindex $v 0]
8448 set viewfiles($n) [lindex $v 1]
8449 set viewargs($n) [lindex $v 2]
8450 set viewperm($n) 1
8451 addviewmenu $n
8452 }
8453}
8454getcommits