gitk: Fix typo in user message.
[git/git.git] / gitk
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec 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
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return [exec git rev-parse --git-dir]
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.
24 proc 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
36 proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
38 }
39
40 proc 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
50 proc 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
82 proc start_rev_list {view} {
83 global startmsecs
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx viewcomplete vnextroot
86 global showlocalchanges commitinterest mainheadid
87 global progressdirn progresscoords proglastnc curview
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 --no-color -z --pretty=raw $order --parents \
99 --boundary $viewargs($view) "--" $viewfiles($view)] r]
100 } err]} {
101 error_popup "[mc "Error executing git rev-list:"] $err"
102 exit 1
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 [mc "Reading"]
115 if {$view == $curview} {
116 set progressdirn 1
117 set progresscoords {0 0}
118 set proglastnc 0
119 }
120 }
121
122 proc 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
135 proc getcommits {} {
136 global phase canv curview
137
138 set phase getcommits
139 initlayout
140 start_rev_list $curview
141 show_status [mc "Reading commits..."]
142 }
143
144 # This makes a string representation of a positive integer which
145 # sorts as a string in numerical order
146 proc strrep {n} {
147 if {$n < 16} {
148 return [format "%x" $n]
149 } elseif {$n < 256} {
150 return [format "x%.2x" $n]
151 } elseif {$n < 65536} {
152 return [format "y%.4x" $n]
153 }
154 return [format "z%.8x" $n]
155 }
156
157 proc getcommitlines {fd view} {
158 global commitlisted commitinterest
159 global leftover commfd
160 global displayorder commitidx viewcomplete commitrow commitdata
161 global parentlist children curview hlview
162 global vparentlist vdisporder vcmitlisted
163 global ordertok vnextroot idpending
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 "[mc "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
357 proc 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 [mc "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
387 proc readcommit {id} {
388 if {[catch {set contents [exec git cat-file commit $id]}]} return
389 parsecommit $id $contents 0
390 }
391
392 proc 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
421 proc 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
478 proc 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) [list [mc "No commit information available"]]
487 }
488 }
489 return 1
490 }
491
492 proc 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
546 proc 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
559 proc 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
568 proc 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
582 proc show_error {w top msg} {
583 message $w.m -text $msg -justify center -aspect 400
584 pack $w.m -side top -fill x -padx 20 -pady 20
585 button $w.ok -text [mc OK] -command "destroy $top"
586 pack $w.ok -side bottom -fill x
587 bind $top <Visibility> "grab $top; focus $top"
588 bind $top <Key-Return> "destroy $top"
589 tkwait window $top
590 }
591
592 proc error_popup msg {
593 set w .error
594 toplevel $w
595 wm transient $w .
596 show_error $w $w $msg
597 }
598
599 proc confirm_popup msg {
600 global confirm_ok
601 set confirm_ok 0
602 set w .confirm
603 toplevel $w
604 wm transient $w .
605 message $w.m -text $msg -justify center -aspect 400
606 pack $w.m -side top -fill x -padx 20 -pady 20
607 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text [mc Cancel] -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
612 tkwait window $w
613 return $confirm_ok
614 }
615
616 proc setoptions {} {
617 option add *Panedwindow.showHandle 1 startupFile
618 option add *Panedwindow.sashRelief raised startupFile
619 option add *Button.font uifont startupFile
620 option add *Checkbutton.font uifont startupFile
621 option add *Radiobutton.font uifont startupFile
622 option add *Menu.font uifont startupFile
623 option add *Menubutton.font uifont startupFile
624 option add *Label.font uifont startupFile
625 option add *Message.font uifont startupFile
626 option add *Entry.font uifont startupFile
627 }
628
629 proc makewindow {} {
630 global canv canv2 canv3 linespc charspc ctext cflist
631 global tabstop
632 global findtype findtypemenu findloc findstring fstring geometry
633 global entries sha1entry sha1string sha1but
634 global diffcontextstring diffcontext
635 global maincursor textcursor curtextcursor
636 global rowctxmenu fakerowmenu mergemax wrapcomment
637 global highlight_files gdttype
638 global searchstring sstring
639 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
640 global headctxmenu progresscanv progressitem progresscoords statusw
641 global fprogitem fprogcoord lastprogupdate progupdatepending
642 global rprogitem rprogcoord
643 global have_tk85
644
645 menu .bar
646 .bar add cascade -label [mc "File"] -menu .bar.file
647 menu .bar.file
648 .bar.file add command -label [mc "Update"] -command updatecommits
649 .bar.file add command -label [mc "Reread references"] -command rereadrefs
650 .bar.file add command -label [mc "List references"] -command showrefs
651 .bar.file add command -label [mc "Quit"] -command doquit
652 menu .bar.edit
653 .bar add cascade -label [mc "Edit"] -menu .bar.edit
654 .bar.edit add command -label [mc "Preferences"] -command doprefs
655
656 menu .bar.view
657 .bar add cascade -label [mc "View"] -menu .bar.view
658 .bar.view add command -label [mc "New view..."] -command {newview 0}
659 .bar.view add command -label [mc "Edit view..."] -command editview \
660 -state disabled
661 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
662 .bar.view add separator
663 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
664 -variable selectedview -value 0
665
666 menu .bar.help
667 .bar add cascade -label [mc "Help"] -menu .bar.help
668 .bar.help add command -label [mc "About gitk"] -command about
669 .bar.help add command -label [mc "Key bindings"] -command keys
670 .bar.help configure
671 . configure -menu .bar
672
673 # the gui has upper and lower half, parts of a paned window.
674 panedwindow .ctop -orient vertical
675
676 # possibly use assumed geometry
677 if {![info exists geometry(pwsash0)]} {
678 set geometry(topheight) [expr {15 * $linespc}]
679 set geometry(topwidth) [expr {80 * $charspc}]
680 set geometry(botheight) [expr {15 * $linespc}]
681 set geometry(botwidth) [expr {50 * $charspc}]
682 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
683 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
684 }
685
686 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
687 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
688 frame .tf.histframe
689 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
690
691 # create three canvases
692 set cscroll .tf.histframe.csb
693 set canv .tf.histframe.pwclist.canv
694 canvas $canv \
695 -selectbackground $selectbgcolor \
696 -background $bgcolor -bd 0 \
697 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
698 .tf.histframe.pwclist add $canv
699 set canv2 .tf.histframe.pwclist.canv2
700 canvas $canv2 \
701 -selectbackground $selectbgcolor \
702 -background $bgcolor -bd 0 -yscrollincr $linespc
703 .tf.histframe.pwclist add $canv2
704 set canv3 .tf.histframe.pwclist.canv3
705 canvas $canv3 \
706 -selectbackground $selectbgcolor \
707 -background $bgcolor -bd 0 -yscrollincr $linespc
708 .tf.histframe.pwclist add $canv3
709 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
710 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
711
712 # a scroll bar to rule them
713 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
714 pack $cscroll -side right -fill y
715 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
716 lappend bglist $canv $canv2 $canv3
717 pack .tf.histframe.pwclist -fill both -expand 1 -side left
718
719 # we have two button bars at bottom of top frame. Bar 1
720 frame .tf.bar
721 frame .tf.lbar -height 15
722
723 set sha1entry .tf.bar.sha1
724 set entries $sha1entry
725 set sha1but .tf.bar.sha1label
726 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
727 -command gotocommit -width 8
728 $sha1but conf -disabledforeground [$sha1but cget -foreground]
729 pack .tf.bar.sha1label -side left
730 entry $sha1entry -width 40 -font textfont -textvariable sha1string
731 trace add variable sha1string write sha1change
732 pack $sha1entry -side left -pady 2
733
734 image create bitmap bm-left -data {
735 #define left_width 16
736 #define left_height 16
737 static unsigned char left_bits[] = {
738 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
739 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
740 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
741 }
742 image create bitmap bm-right -data {
743 #define right_width 16
744 #define right_height 16
745 static unsigned char right_bits[] = {
746 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
747 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
748 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
749 }
750 button .tf.bar.leftbut -image bm-left -command goback \
751 -state disabled -width 26
752 pack .tf.bar.leftbut -side left -fill y
753 button .tf.bar.rightbut -image bm-right -command goforw \
754 -state disabled -width 26
755 pack .tf.bar.rightbut -side left -fill y
756
757 # Status label and progress bar
758 set statusw .tf.bar.status
759 label $statusw -width 15 -relief sunken
760 pack $statusw -side left -padx 5
761 set h [expr {[font metrics uifont -linespace] + 2}]
762 set progresscanv .tf.bar.progress
763 canvas $progresscanv -relief sunken -height $h -borderwidth 2
764 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
765 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
766 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
767 pack $progresscanv -side right -expand 1 -fill x
768 set progresscoords {0 0}
769 set fprogcoord 0
770 set rprogcoord 0
771 bind $progresscanv <Configure> adjustprogress
772 set lastprogupdate [clock clicks -milliseconds]
773 set progupdatepending 0
774
775 # build up the bottom bar of upper window
776 label .tf.lbar.flabel -text "[mc "Find"] "
777 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
778 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
779 label .tf.lbar.flab2 -text " [mc "commit"] "
780 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
781 -side left -fill y
782 set gdttype [mc "containing:"]
783 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
784 [mc "containing:"] \
785 [mc "touching paths:"] \
786 [mc "adding/removing string:"]]
787 trace add variable gdttype write gdttype_change
788 pack .tf.lbar.gdttype -side left -fill y
789
790 set findstring {}
791 set fstring .tf.lbar.findstring
792 lappend entries $fstring
793 entry $fstring -width 30 -font textfont -textvariable findstring
794 trace add variable findstring write find_change
795 set findtype [mc "Exact"]
796 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
797 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
798 trace add variable findtype write findcom_change
799 set findloc [mc "All fields"]
800 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
801 [mc "Comments"] [mc "Author"] [mc "Committer"]
802 trace add variable findloc write find_change
803 pack .tf.lbar.findloc -side right
804 pack .tf.lbar.findtype -side right
805 pack $fstring -side left -expand 1 -fill x
806
807 # Finish putting the upper half of the viewer together
808 pack .tf.lbar -in .tf -side bottom -fill x
809 pack .tf.bar -in .tf -side bottom -fill x
810 pack .tf.histframe -fill both -side top -expand 1
811 .ctop add .tf
812 .ctop paneconfigure .tf -height $geometry(topheight)
813 .ctop paneconfigure .tf -width $geometry(topwidth)
814
815 # now build up the bottom
816 panedwindow .pwbottom -orient horizontal
817
818 # lower left, a text box over search bar, scroll bar to the right
819 # if we know window height, then that will set the lower text height, otherwise
820 # we set lower text height which will drive window height
821 if {[info exists geometry(main)]} {
822 frame .bleft -width $geometry(botwidth)
823 } else {
824 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
825 }
826 frame .bleft.top
827 frame .bleft.mid
828
829 button .bleft.top.search -text [mc "Search"] -command dosearch
830 pack .bleft.top.search -side left -padx 5
831 set sstring .bleft.top.sstring
832 entry $sstring -width 20 -font textfont -textvariable searchstring
833 lappend entries $sstring
834 trace add variable searchstring write incrsearch
835 pack $sstring -side left -expand 1 -fill x
836 radiobutton .bleft.mid.diff -text [mc "Diff"] \
837 -command changediffdisp -variable diffelide -value {0 0}
838 radiobutton .bleft.mid.old -text [mc "Old version"] \
839 -command changediffdisp -variable diffelide -value {0 1}
840 radiobutton .bleft.mid.new -text [mc "New version"] \
841 -command changediffdisp -variable diffelide -value {1 0}
842 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
843 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
844 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
845 -from 1 -increment 1 -to 10000000 \
846 -validate all -validatecommand "diffcontextvalidate %P" \
847 -textvariable diffcontextstring
848 .bleft.mid.diffcontext set $diffcontext
849 trace add variable diffcontextstring write diffcontextchange
850 lappend entries .bleft.mid.diffcontext
851 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
852 set ctext .bleft.ctext
853 text $ctext -background $bgcolor -foreground $fgcolor \
854 -state disabled -font textfont \
855 -yscrollcommand scrolltext -wrap none
856 if {$have_tk85} {
857 $ctext conf -tabstyle wordprocessor
858 }
859 scrollbar .bleft.sb -command "$ctext yview"
860 pack .bleft.top -side top -fill x
861 pack .bleft.mid -side top -fill x
862 pack .bleft.sb -side right -fill y
863 pack $ctext -side left -fill both -expand 1
864 lappend bglist $ctext
865 lappend fglist $ctext
866
867 $ctext tag conf comment -wrap $wrapcomment
868 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
869 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
870 $ctext tag conf d0 -fore [lindex $diffcolors 0]
871 $ctext tag conf d1 -fore [lindex $diffcolors 1]
872 $ctext tag conf m0 -fore red
873 $ctext tag conf m1 -fore blue
874 $ctext tag conf m2 -fore green
875 $ctext tag conf m3 -fore purple
876 $ctext tag conf m4 -fore brown
877 $ctext tag conf m5 -fore "#009090"
878 $ctext tag conf m6 -fore magenta
879 $ctext tag conf m7 -fore "#808000"
880 $ctext tag conf m8 -fore "#009000"
881 $ctext tag conf m9 -fore "#ff0080"
882 $ctext tag conf m10 -fore cyan
883 $ctext tag conf m11 -fore "#b07070"
884 $ctext tag conf m12 -fore "#70b0f0"
885 $ctext tag conf m13 -fore "#70f0b0"
886 $ctext tag conf m14 -fore "#f0b070"
887 $ctext tag conf m15 -fore "#ff70b0"
888 $ctext tag conf mmax -fore darkgrey
889 set mergemax 16
890 $ctext tag conf mresult -font textfontbold
891 $ctext tag conf msep -font textfontbold
892 $ctext tag conf found -back yellow
893
894 .pwbottom add .bleft
895 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
896
897 # lower right
898 frame .bright
899 frame .bright.mode
900 radiobutton .bright.mode.patch -text [mc "Patch"] \
901 -command reselectline -variable cmitmode -value "patch"
902 radiobutton .bright.mode.tree -text [mc "Tree"] \
903 -command reselectline -variable cmitmode -value "tree"
904 grid .bright.mode.patch .bright.mode.tree -sticky ew
905 pack .bright.mode -side top -fill x
906 set cflist .bright.cfiles
907 set indent [font measure mainfont "nn"]
908 text $cflist \
909 -selectbackground $selectbgcolor \
910 -background $bgcolor -foreground $fgcolor \
911 -font mainfont \
912 -tabs [list $indent [expr {2 * $indent}]] \
913 -yscrollcommand ".bright.sb set" \
914 -cursor [. cget -cursor] \
915 -spacing1 1 -spacing3 1
916 lappend bglist $cflist
917 lappend fglist $cflist
918 scrollbar .bright.sb -command "$cflist yview"
919 pack .bright.sb -side right -fill y
920 pack $cflist -side left -fill both -expand 1
921 $cflist tag configure highlight \
922 -background [$cflist cget -selectbackground]
923 $cflist tag configure bold -font mainfontbold
924
925 .pwbottom add .bright
926 .ctop add .pwbottom
927
928 # restore window position if known
929 if {[info exists geometry(main)]} {
930 wm geometry . "$geometry(main)"
931 }
932
933 if {[tk windowingsystem] eq {aqua}} {
934 set M1B M1
935 } else {
936 set M1B Control
937 }
938
939 bind .pwbottom <Configure> {resizecdetpanes %W %w}
940 pack .ctop -fill both -expand 1
941 bindall <1> {selcanvline %W %x %y}
942 #bindall <B1-Motion> {selcanvline %W %x %y}
943 if {[tk windowingsystem] == "win32"} {
944 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
945 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
946 } else {
947 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
948 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
949 if {[tk windowingsystem] eq "aqua"} {
950 bindall <MouseWheel> {
951 set delta [expr {- (%D)}]
952 allcanvs yview scroll $delta units
953 }
954 }
955 }
956 bindall <2> "canvscan mark %W %x %y"
957 bindall <B2-Motion> "canvscan dragto %W %x %y"
958 bindkey <Home> selfirstline
959 bindkey <End> sellastline
960 bind . <Key-Up> "selnextline -1"
961 bind . <Key-Down> "selnextline 1"
962 bind . <Shift-Key-Up> "dofind -1 0"
963 bind . <Shift-Key-Down> "dofind 1 0"
964 bindkey <Key-Right> "goforw"
965 bindkey <Key-Left> "goback"
966 bind . <Key-Prior> "selnextpage -1"
967 bind . <Key-Next> "selnextpage 1"
968 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
969 bind . <$M1B-End> "allcanvs yview moveto 1.0"
970 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
971 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
972 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
973 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
974 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
975 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
976 bindkey <Key-space> "$ctext yview scroll 1 pages"
977 bindkey p "selnextline -1"
978 bindkey n "selnextline 1"
979 bindkey z "goback"
980 bindkey x "goforw"
981 bindkey i "selnextline -1"
982 bindkey k "selnextline 1"
983 bindkey j "goback"
984 bindkey l "goforw"
985 bindkey b "$ctext yview scroll -1 pages"
986 bindkey d "$ctext yview scroll 18 units"
987 bindkey u "$ctext yview scroll -18 units"
988 bindkey / {dofind 1 1}
989 bindkey <Key-Return> {dofind 1 1}
990 bindkey ? {dofind -1 1}
991 bindkey f nextfile
992 bindkey <F5> updatecommits
993 bind . <$M1B-q> doquit
994 bind . <$M1B-f> {dofind 1 1}
995 bind . <$M1B-g> {dofind 1 0}
996 bind . <$M1B-r> dosearchback
997 bind . <$M1B-s> dosearch
998 bind . <$M1B-equal> {incrfont 1}
999 bind . <$M1B-KP_Add> {incrfont 1}
1000 bind . <$M1B-minus> {incrfont -1}
1001 bind . <$M1B-KP_Subtract> {incrfont -1}
1002 wm protocol . WM_DELETE_WINDOW doquit
1003 bind . <Button-1> "click %W"
1004 bind $fstring <Key-Return> {dofind 1 1}
1005 bind $sha1entry <Key-Return> gotocommit
1006 bind $sha1entry <<PasteSelection>> clearsha1
1007 bind $cflist <1> {sel_flist %W %x %y; break}
1008 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1009 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1010 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1011
1012 set maincursor [. cget -cursor]
1013 set textcursor [$ctext cget -cursor]
1014 set curtextcursor $textcursor
1015
1016 set rowctxmenu .rowctxmenu
1017 menu $rowctxmenu -tearoff 0
1018 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1019 -command {diffvssel 0}
1020 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1021 -command {diffvssel 1}
1022 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1023 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1024 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1025 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1026 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1027 -command cherrypick
1028 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1029 -command resethead
1030
1031 set fakerowmenu .fakerowmenu
1032 menu $fakerowmenu -tearoff 0
1033 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1034 -command {diffvssel 0}
1035 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1036 -command {diffvssel 1}
1037 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1038 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1039 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1040 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1041
1042 set headctxmenu .headctxmenu
1043 menu $headctxmenu -tearoff 0
1044 $headctxmenu add command -label [mc "Check out this branch"] \
1045 -command cobranch
1046 $headctxmenu add command -label [mc "Remove this branch"] \
1047 -command rmbranch
1048
1049 global flist_menu
1050 set flist_menu .flistctxmenu
1051 menu $flist_menu -tearoff 0
1052 $flist_menu add command -label [mc "Highlight this too"] \
1053 -command {flist_hl 0}
1054 $flist_menu add command -label [mc "Highlight this only"] \
1055 -command {flist_hl 1}
1056 }
1057
1058 # Windows sends all mouse wheel events to the current focused window, not
1059 # the one where the mouse hovers, so bind those events here and redirect
1060 # to the correct window
1061 proc windows_mousewheel_redirector {W X Y D} {
1062 global canv canv2 canv3
1063 set w [winfo containing -displayof $W $X $Y]
1064 if {$w ne ""} {
1065 set u [expr {$D < 0 ? 5 : -5}]
1066 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1067 allcanvs yview scroll $u units
1068 } else {
1069 catch {
1070 $w yview scroll $u units
1071 }
1072 }
1073 }
1074 }
1075
1076 # mouse-2 makes all windows scan vertically, but only the one
1077 # the cursor is in scans horizontally
1078 proc canvscan {op w x y} {
1079 global canv canv2 canv3
1080 foreach c [list $canv $canv2 $canv3] {
1081 if {$c == $w} {
1082 $c scan $op $x $y
1083 } else {
1084 $c scan $op 0 $y
1085 }
1086 }
1087 }
1088
1089 proc scrollcanv {cscroll f0 f1} {
1090 $cscroll set $f0 $f1
1091 drawfrac $f0 $f1
1092 flushhighlights
1093 }
1094
1095 # when we make a key binding for the toplevel, make sure
1096 # it doesn't get triggered when that key is pressed in the
1097 # find string entry widget.
1098 proc bindkey {ev script} {
1099 global entries
1100 bind . $ev $script
1101 set escript [bind Entry $ev]
1102 if {$escript == {}} {
1103 set escript [bind Entry <Key>]
1104 }
1105 foreach e $entries {
1106 bind $e $ev "$escript; break"
1107 }
1108 }
1109
1110 # set the focus back to the toplevel for any click outside
1111 # the entry widgets
1112 proc click {w} {
1113 global ctext entries
1114 foreach e [concat $entries $ctext] {
1115 if {$w == $e} return
1116 }
1117 focus .
1118 }
1119
1120 # Adjust the progress bar for a change in requested extent or canvas size
1121 proc adjustprogress {} {
1122 global progresscanv progressitem progresscoords
1123 global fprogitem fprogcoord lastprogupdate progupdatepending
1124 global rprogitem rprogcoord
1125
1126 set w [expr {[winfo width $progresscanv] - 4}]
1127 set x0 [expr {$w * [lindex $progresscoords 0]}]
1128 set x1 [expr {$w * [lindex $progresscoords 1]}]
1129 set h [winfo height $progresscanv]
1130 $progresscanv coords $progressitem $x0 0 $x1 $h
1131 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1132 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1133 set now [clock clicks -milliseconds]
1134 if {$now >= $lastprogupdate + 100} {
1135 set progupdatepending 0
1136 update
1137 } elseif {!$progupdatepending} {
1138 set progupdatepending 1
1139 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1140 }
1141 }
1142
1143 proc doprogupdate {} {
1144 global lastprogupdate progupdatepending
1145
1146 if {$progupdatepending} {
1147 set progupdatepending 0
1148 set lastprogupdate [clock clicks -milliseconds]
1149 update
1150 }
1151 }
1152
1153 proc savestuff {w} {
1154 global canv canv2 canv3 mainfont textfont uifont tabstop
1155 global stuffsaved findmergefiles maxgraphpct
1156 global maxwidth showneartags showlocalchanges
1157 global viewname viewfiles viewargs viewperm nextviewnum
1158 global cmitmode wrapcomment datetimeformat limitdiffs
1159 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1160
1161 if {$stuffsaved} return
1162 if {![winfo viewable .]} return
1163 catch {
1164 set f [open "~/.gitk-new" w]
1165 puts $f [list set mainfont $mainfont]
1166 puts $f [list set textfont $textfont]
1167 puts $f [list set uifont $uifont]
1168 puts $f [list set tabstop $tabstop]
1169 puts $f [list set findmergefiles $findmergefiles]
1170 puts $f [list set maxgraphpct $maxgraphpct]
1171 puts $f [list set maxwidth $maxwidth]
1172 puts $f [list set cmitmode $cmitmode]
1173 puts $f [list set wrapcomment $wrapcomment]
1174 puts $f [list set showneartags $showneartags]
1175 puts $f [list set showlocalchanges $showlocalchanges]
1176 puts $f [list set datetimeformat $datetimeformat]
1177 puts $f [list set limitdiffs $limitdiffs]
1178 puts $f [list set bgcolor $bgcolor]
1179 puts $f [list set fgcolor $fgcolor]
1180 puts $f [list set colors $colors]
1181 puts $f [list set diffcolors $diffcolors]
1182 puts $f [list set diffcontext $diffcontext]
1183 puts $f [list set selectbgcolor $selectbgcolor]
1184
1185 puts $f "set geometry(main) [wm geometry .]"
1186 puts $f "set geometry(topwidth) [winfo width .tf]"
1187 puts $f "set geometry(topheight) [winfo height .tf]"
1188 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1189 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1190 puts $f "set geometry(botwidth) [winfo width .bleft]"
1191 puts $f "set geometry(botheight) [winfo height .bleft]"
1192
1193 puts -nonewline $f "set permviews {"
1194 for {set v 0} {$v < $nextviewnum} {incr v} {
1195 if {$viewperm($v)} {
1196 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1197 }
1198 }
1199 puts $f "}"
1200 close $f
1201 file rename -force "~/.gitk-new" "~/.gitk"
1202 }
1203 set stuffsaved 1
1204 }
1205
1206 proc resizeclistpanes {win w} {
1207 global oldwidth
1208 if {[info exists oldwidth($win)]} {
1209 set s0 [$win sash coord 0]
1210 set s1 [$win sash coord 1]
1211 if {$w < 60} {
1212 set sash0 [expr {int($w/2 - 2)}]
1213 set sash1 [expr {int($w*5/6 - 2)}]
1214 } else {
1215 set factor [expr {1.0 * $w / $oldwidth($win)}]
1216 set sash0 [expr {int($factor * [lindex $s0 0])}]
1217 set sash1 [expr {int($factor * [lindex $s1 0])}]
1218 if {$sash0 < 30} {
1219 set sash0 30
1220 }
1221 if {$sash1 < $sash0 + 20} {
1222 set sash1 [expr {$sash0 + 20}]
1223 }
1224 if {$sash1 > $w - 10} {
1225 set sash1 [expr {$w - 10}]
1226 if {$sash0 > $sash1 - 20} {
1227 set sash0 [expr {$sash1 - 20}]
1228 }
1229 }
1230 }
1231 $win sash place 0 $sash0 [lindex $s0 1]
1232 $win sash place 1 $sash1 [lindex $s1 1]
1233 }
1234 set oldwidth($win) $w
1235 }
1236
1237 proc resizecdetpanes {win w} {
1238 global oldwidth
1239 if {[info exists oldwidth($win)]} {
1240 set s0 [$win sash coord 0]
1241 if {$w < 60} {
1242 set sash0 [expr {int($w*3/4 - 2)}]
1243 } else {
1244 set factor [expr {1.0 * $w / $oldwidth($win)}]
1245 set sash0 [expr {int($factor * [lindex $s0 0])}]
1246 if {$sash0 < 45} {
1247 set sash0 45
1248 }
1249 if {$sash0 > $w - 15} {
1250 set sash0 [expr {$w - 15}]
1251 }
1252 }
1253 $win sash place 0 $sash0 [lindex $s0 1]
1254 }
1255 set oldwidth($win) $w
1256 }
1257
1258 proc allcanvs args {
1259 global canv canv2 canv3
1260 eval $canv $args
1261 eval $canv2 $args
1262 eval $canv3 $args
1263 }
1264
1265 proc bindall {event action} {
1266 global canv canv2 canv3
1267 bind $canv $event $action
1268 bind $canv2 $event $action
1269 bind $canv3 $event $action
1270 }
1271
1272 proc about {} {
1273 global uifont
1274 set w .about
1275 if {[winfo exists $w]} {
1276 raise $w
1277 return
1278 }
1279 toplevel $w
1280 wm title $w [mc "About gitk"]
1281 message $w.m -text [mc "
1282 Gitk - a commit viewer for git
1283
1284 Copyright © 2005-2006 Paul Mackerras
1285
1286 Use and redistribute under the terms of the GNU General Public License"] \
1287 -justify center -aspect 400 -border 2 -bg white -relief groove
1288 pack $w.m -side top -fill x -padx 2 -pady 2
1289 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1290 pack $w.ok -side bottom
1291 bind $w <Visibility> "focus $w.ok"
1292 bind $w <Key-Escape> "destroy $w"
1293 bind $w <Key-Return> "destroy $w"
1294 }
1295
1296 proc keys {} {
1297 set w .keys
1298 if {[winfo exists $w]} {
1299 raise $w
1300 return
1301 }
1302 if {[tk windowingsystem] eq {aqua}} {
1303 set M1T Cmd
1304 } else {
1305 set M1T Ctrl
1306 }
1307 toplevel $w
1308 wm title $w [mc "Gitk key bindings"]
1309 message $w.m -text [mc "
1310 Gitk key bindings:
1311
1312 <$M1T-Q> Quit
1313 <Home> Move to first commit
1314 <End> Move to last commit
1315 <Up>, p, i Move up one commit
1316 <Down>, n, k Move down one commit
1317 <Left>, z, j Go back in history list
1318 <Right>, x, l Go forward in history list
1319 <PageUp> Move up one page in commit list
1320 <PageDown> Move down one page in commit list
1321 <$M1T-Home> Scroll to top of commit list
1322 <$M1T-End> Scroll to bottom of commit list
1323 <$M1T-Up> Scroll commit list up one line
1324 <$M1T-Down> Scroll commit list down one line
1325 <$M1T-PageUp> Scroll commit list up one page
1326 <$M1T-PageDown> Scroll commit list down one page
1327 <Shift-Up> Find backwards (upwards, later commits)
1328 <Shift-Down> Find forwards (downwards, earlier commits)
1329 <Delete>, b Scroll diff view up one page
1330 <Backspace> Scroll diff view up one page
1331 <Space> Scroll diff view down one page
1332 u Scroll diff view up 18 lines
1333 d Scroll diff view down 18 lines
1334 <$M1T-F> Find
1335 <$M1T-G> Move to next find hit
1336 <Return> Move to next find hit
1337 / Move to next find hit, or redo find
1338 ? Move to previous find hit
1339 f Scroll diff view to next file
1340 <$M1T-S> Search for next hit in diff view
1341 <$M1T-R> Search for previous hit in diff view
1342 <$M1T-KP+> Increase font size
1343 <$M1T-plus> Increase font size
1344 <$M1T-KP-> Decrease font size
1345 <$M1T-minus> Decrease font size
1346 <F5> Update
1347 "] \
1348 -justify left -bg white -border 2 -relief groove
1349 pack $w.m -side top -fill both -padx 2 -pady 2
1350 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1351 pack $w.ok -side bottom
1352 bind $w <Visibility> "focus $w.ok"
1353 bind $w <Key-Escape> "destroy $w"
1354 bind $w <Key-Return> "destroy $w"
1355 }
1356
1357 # Procedures for manipulating the file list window at the
1358 # bottom right of the overall window.
1359
1360 proc treeview {w l openlevs} {
1361 global treecontents treediropen treeheight treeparent treeindex
1362
1363 set ix 0
1364 set treeindex() 0
1365 set lev 0
1366 set prefix {}
1367 set prefixend -1
1368 set prefendstack {}
1369 set htstack {}
1370 set ht 0
1371 set treecontents() {}
1372 $w conf -state normal
1373 foreach f $l {
1374 while {[string range $f 0 $prefixend] ne $prefix} {
1375 if {$lev <= $openlevs} {
1376 $w mark set e:$treeindex($prefix) "end -1c"
1377 $w mark gravity e:$treeindex($prefix) left
1378 }
1379 set treeheight($prefix) $ht
1380 incr ht [lindex $htstack end]
1381 set htstack [lreplace $htstack end end]
1382 set prefixend [lindex $prefendstack end]
1383 set prefendstack [lreplace $prefendstack end end]
1384 set prefix [string range $prefix 0 $prefixend]
1385 incr lev -1
1386 }
1387 set tail [string range $f [expr {$prefixend+1}] end]
1388 while {[set slash [string first "/" $tail]] >= 0} {
1389 lappend htstack $ht
1390 set ht 0
1391 lappend prefendstack $prefixend
1392 incr prefixend [expr {$slash + 1}]
1393 set d [string range $tail 0 $slash]
1394 lappend treecontents($prefix) $d
1395 set oldprefix $prefix
1396 append prefix $d
1397 set treecontents($prefix) {}
1398 set treeindex($prefix) [incr ix]
1399 set treeparent($prefix) $oldprefix
1400 set tail [string range $tail [expr {$slash+1}] end]
1401 if {$lev <= $openlevs} {
1402 set ht 1
1403 set treediropen($prefix) [expr {$lev < $openlevs}]
1404 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1405 $w mark set d:$ix "end -1c"
1406 $w mark gravity d:$ix left
1407 set str "\n"
1408 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1409 $w insert end $str
1410 $w image create end -align center -image $bm -padx 1 \
1411 -name a:$ix
1412 $w insert end $d [highlight_tag $prefix]
1413 $w mark set s:$ix "end -1c"
1414 $w mark gravity s:$ix left
1415 }
1416 incr lev
1417 }
1418 if {$tail ne {}} {
1419 if {$lev <= $openlevs} {
1420 incr ht
1421 set str "\n"
1422 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1423 $w insert end $str
1424 $w insert end $tail [highlight_tag $f]
1425 }
1426 lappend treecontents($prefix) $tail
1427 }
1428 }
1429 while {$htstack ne {}} {
1430 set treeheight($prefix) $ht
1431 incr ht [lindex $htstack end]
1432 set htstack [lreplace $htstack end end]
1433 set prefixend [lindex $prefendstack end]
1434 set prefendstack [lreplace $prefendstack end end]
1435 set prefix [string range $prefix 0 $prefixend]
1436 }
1437 $w conf -state disabled
1438 }
1439
1440 proc linetoelt {l} {
1441 global treeheight treecontents
1442
1443 set y 2
1444 set prefix {}
1445 while {1} {
1446 foreach e $treecontents($prefix) {
1447 if {$y == $l} {
1448 return "$prefix$e"
1449 }
1450 set n 1
1451 if {[string index $e end] eq "/"} {
1452 set n $treeheight($prefix$e)
1453 if {$y + $n > $l} {
1454 append prefix $e
1455 incr y
1456 break
1457 }
1458 }
1459 incr y $n
1460 }
1461 }
1462 }
1463
1464 proc highlight_tree {y prefix} {
1465 global treeheight treecontents cflist
1466
1467 foreach e $treecontents($prefix) {
1468 set path $prefix$e
1469 if {[highlight_tag $path] ne {}} {
1470 $cflist tag add bold $y.0 "$y.0 lineend"
1471 }
1472 incr y
1473 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1474 set y [highlight_tree $y $path]
1475 }
1476 }
1477 return $y
1478 }
1479
1480 proc treeclosedir {w dir} {
1481 global treediropen treeheight treeparent treeindex
1482
1483 set ix $treeindex($dir)
1484 $w conf -state normal
1485 $w delete s:$ix e:$ix
1486 set treediropen($dir) 0
1487 $w image configure a:$ix -image tri-rt
1488 $w conf -state disabled
1489 set n [expr {1 - $treeheight($dir)}]
1490 while {$dir ne {}} {
1491 incr treeheight($dir) $n
1492 set dir $treeparent($dir)
1493 }
1494 }
1495
1496 proc treeopendir {w dir} {
1497 global treediropen treeheight treeparent treecontents treeindex
1498
1499 set ix $treeindex($dir)
1500 $w conf -state normal
1501 $w image configure a:$ix -image tri-dn
1502 $w mark set e:$ix s:$ix
1503 $w mark gravity e:$ix right
1504 set lev 0
1505 set str "\n"
1506 set n [llength $treecontents($dir)]
1507 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1508 incr lev
1509 append str "\t"
1510 incr treeheight($x) $n
1511 }
1512 foreach e $treecontents($dir) {
1513 set de $dir$e
1514 if {[string index $e end] eq "/"} {
1515 set iy $treeindex($de)
1516 $w mark set d:$iy e:$ix
1517 $w mark gravity d:$iy left
1518 $w insert e:$ix $str
1519 set treediropen($de) 0
1520 $w image create e:$ix -align center -image tri-rt -padx 1 \
1521 -name a:$iy
1522 $w insert e:$ix $e [highlight_tag $de]
1523 $w mark set s:$iy e:$ix
1524 $w mark gravity s:$iy left
1525 set treeheight($de) 1
1526 } else {
1527 $w insert e:$ix $str
1528 $w insert e:$ix $e [highlight_tag $de]
1529 }
1530 }
1531 $w mark gravity e:$ix left
1532 $w conf -state disabled
1533 set treediropen($dir) 1
1534 set top [lindex [split [$w index @0,0] .] 0]
1535 set ht [$w cget -height]
1536 set l [lindex [split [$w index s:$ix] .] 0]
1537 if {$l < $top} {
1538 $w yview $l.0
1539 } elseif {$l + $n + 1 > $top + $ht} {
1540 set top [expr {$l + $n + 2 - $ht}]
1541 if {$l < $top} {
1542 set top $l
1543 }
1544 $w yview $top.0
1545 }
1546 }
1547
1548 proc treeclick {w x y} {
1549 global treediropen cmitmode ctext cflist cflist_top
1550
1551 if {$cmitmode ne "tree"} return
1552 if {![info exists cflist_top]} return
1553 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1554 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1555 $cflist tag add highlight $l.0 "$l.0 lineend"
1556 set cflist_top $l
1557 if {$l == 1} {
1558 $ctext yview 1.0
1559 return
1560 }
1561 set e [linetoelt $l]
1562 if {[string index $e end] ne "/"} {
1563 showfile $e
1564 } elseif {$treediropen($e)} {
1565 treeclosedir $w $e
1566 } else {
1567 treeopendir $w $e
1568 }
1569 }
1570
1571 proc setfilelist {id} {
1572 global treefilelist cflist
1573
1574 treeview $cflist $treefilelist($id) 0
1575 }
1576
1577 image create bitmap tri-rt -background black -foreground blue -data {
1578 #define tri-rt_width 13
1579 #define tri-rt_height 13
1580 static unsigned char tri-rt_bits[] = {
1581 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1582 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1583 0x00, 0x00};
1584 } -maskdata {
1585 #define tri-rt-mask_width 13
1586 #define tri-rt-mask_height 13
1587 static unsigned char tri-rt-mask_bits[] = {
1588 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1589 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1590 0x08, 0x00};
1591 }
1592 image create bitmap tri-dn -background black -foreground blue -data {
1593 #define tri-dn_width 13
1594 #define tri-dn_height 13
1595 static unsigned char tri-dn_bits[] = {
1596 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1597 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1598 0x00, 0x00};
1599 } -maskdata {
1600 #define tri-dn-mask_width 13
1601 #define tri-dn-mask_height 13
1602 static unsigned char tri-dn-mask_bits[] = {
1603 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1604 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1605 0x00, 0x00};
1606 }
1607
1608 image create bitmap reficon-T -background black -foreground yellow -data {
1609 #define tagicon_width 13
1610 #define tagicon_height 9
1611 static unsigned char tagicon_bits[] = {
1612 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1613 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1614 } -maskdata {
1615 #define tagicon-mask_width 13
1616 #define tagicon-mask_height 9
1617 static unsigned char tagicon-mask_bits[] = {
1618 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1619 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1620 }
1621 set rectdata {
1622 #define headicon_width 13
1623 #define headicon_height 9
1624 static unsigned char headicon_bits[] = {
1625 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1626 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1627 }
1628 set rectmask {
1629 #define headicon-mask_width 13
1630 #define headicon-mask_height 9
1631 static unsigned char headicon-mask_bits[] = {
1632 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1633 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1634 }
1635 image create bitmap reficon-H -background black -foreground green \
1636 -data $rectdata -maskdata $rectmask
1637 image create bitmap reficon-o -background black -foreground "#ddddff" \
1638 -data $rectdata -maskdata $rectmask
1639
1640 proc init_flist {first} {
1641 global cflist cflist_top selectedline difffilestart
1642
1643 $cflist conf -state normal
1644 $cflist delete 0.0 end
1645 if {$first ne {}} {
1646 $cflist insert end $first
1647 set cflist_top 1
1648 $cflist tag add highlight 1.0 "1.0 lineend"
1649 } else {
1650 catch {unset cflist_top}
1651 }
1652 $cflist conf -state disabled
1653 set difffilestart {}
1654 }
1655
1656 proc highlight_tag {f} {
1657 global highlight_paths
1658
1659 foreach p $highlight_paths {
1660 if {[string match $p $f]} {
1661 return "bold"
1662 }
1663 }
1664 return {}
1665 }
1666
1667 proc highlight_filelist {} {
1668 global cmitmode cflist
1669
1670 $cflist conf -state normal
1671 if {$cmitmode ne "tree"} {
1672 set end [lindex [split [$cflist index end] .] 0]
1673 for {set l 2} {$l < $end} {incr l} {
1674 set line [$cflist get $l.0 "$l.0 lineend"]
1675 if {[highlight_tag $line] ne {}} {
1676 $cflist tag add bold $l.0 "$l.0 lineend"
1677 }
1678 }
1679 } else {
1680 highlight_tree 2 {}
1681 }
1682 $cflist conf -state disabled
1683 }
1684
1685 proc unhighlight_filelist {} {
1686 global cflist
1687
1688 $cflist conf -state normal
1689 $cflist tag remove bold 1.0 end
1690 $cflist conf -state disabled
1691 }
1692
1693 proc add_flist {fl} {
1694 global cflist
1695
1696 $cflist conf -state normal
1697 foreach f $fl {
1698 $cflist insert end "\n"
1699 $cflist insert end $f [highlight_tag $f]
1700 }
1701 $cflist conf -state disabled
1702 }
1703
1704 proc sel_flist {w x y} {
1705 global ctext difffilestart cflist cflist_top cmitmode
1706
1707 if {$cmitmode eq "tree"} return
1708 if {![info exists cflist_top]} return
1709 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1710 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1711 $cflist tag add highlight $l.0 "$l.0 lineend"
1712 set cflist_top $l
1713 if {$l == 1} {
1714 $ctext yview 1.0
1715 } else {
1716 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1717 }
1718 }
1719
1720 proc pop_flist_menu {w X Y x y} {
1721 global ctext cflist cmitmode flist_menu flist_menu_file
1722 global treediffs diffids
1723
1724 stopfinding
1725 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1726 if {$l <= 1} return
1727 if {$cmitmode eq "tree"} {
1728 set e [linetoelt $l]
1729 if {[string index $e end] eq "/"} return
1730 } else {
1731 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1732 }
1733 set flist_menu_file $e
1734 tk_popup $flist_menu $X $Y
1735 }
1736
1737 proc flist_hl {only} {
1738 global flist_menu_file findstring gdttype
1739
1740 set x [shellquote $flist_menu_file]
1741 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1742 set findstring $x
1743 } else {
1744 append findstring " " $x
1745 }
1746 set gdttype [mc "touching paths:"]
1747 }
1748
1749 # Functions for adding and removing shell-type quoting
1750
1751 proc shellquote {str} {
1752 if {![string match "*\['\"\\ \t]*" $str]} {
1753 return $str
1754 }
1755 if {![string match "*\['\"\\]*" $str]} {
1756 return "\"$str\""
1757 }
1758 if {![string match "*'*" $str]} {
1759 return "'$str'"
1760 }
1761 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1762 }
1763
1764 proc shellarglist {l} {
1765 set str {}
1766 foreach a $l {
1767 if {$str ne {}} {
1768 append str " "
1769 }
1770 append str [shellquote $a]
1771 }
1772 return $str
1773 }
1774
1775 proc shelldequote {str} {
1776 set ret {}
1777 set used -1
1778 while {1} {
1779 incr used
1780 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1781 append ret [string range $str $used end]
1782 set used [string length $str]
1783 break
1784 }
1785 set first [lindex $first 0]
1786 set ch [string index $str $first]
1787 if {$first > $used} {
1788 append ret [string range $str $used [expr {$first - 1}]]
1789 set used $first
1790 }
1791 if {$ch eq " " || $ch eq "\t"} break
1792 incr used
1793 if {$ch eq "'"} {
1794 set first [string first "'" $str $used]
1795 if {$first < 0} {
1796 error "unmatched single-quote"
1797 }
1798 append ret [string range $str $used [expr {$first - 1}]]
1799 set used $first
1800 continue
1801 }
1802 if {$ch eq "\\"} {
1803 if {$used >= [string length $str]} {
1804 error "trailing backslash"
1805 }
1806 append ret [string index $str $used]
1807 continue
1808 }
1809 # here ch == "\""
1810 while {1} {
1811 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1812 error "unmatched double-quote"
1813 }
1814 set first [lindex $first 0]
1815 set ch [string index $str $first]
1816 if {$first > $used} {
1817 append ret [string range $str $used [expr {$first - 1}]]
1818 set used $first
1819 }
1820 if {$ch eq "\""} break
1821 incr used
1822 append ret [string index $str $used]
1823 incr used
1824 }
1825 }
1826 return [list $used $ret]
1827 }
1828
1829 proc shellsplit {str} {
1830 set l {}
1831 while {1} {
1832 set str [string trimleft $str]
1833 if {$str eq {}} break
1834 set dq [shelldequote $str]
1835 set n [lindex $dq 0]
1836 set word [lindex $dq 1]
1837 set str [string range $str $n end]
1838 lappend l $word
1839 }
1840 return $l
1841 }
1842
1843 # Code to implement multiple views
1844
1845 proc newview {ishighlight} {
1846 global nextviewnum newviewname newviewperm newishighlight
1847 global newviewargs revtreeargs
1848
1849 set newishighlight $ishighlight
1850 set top .gitkview
1851 if {[winfo exists $top]} {
1852 raise $top
1853 return
1854 }
1855 set newviewname($nextviewnum) "View $nextviewnum"
1856 set newviewperm($nextviewnum) 0
1857 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1858 vieweditor $top $nextviewnum [mc "Gitk view definition"]
1859 }
1860
1861 proc editview {} {
1862 global curview
1863 global viewname viewperm newviewname newviewperm
1864 global viewargs newviewargs
1865
1866 set top .gitkvedit-$curview
1867 if {[winfo exists $top]} {
1868 raise $top
1869 return
1870 }
1871 set newviewname($curview) $viewname($curview)
1872 set newviewperm($curview) $viewperm($curview)
1873 set newviewargs($curview) [shellarglist $viewargs($curview)]
1874 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1875 }
1876
1877 proc vieweditor {top n title} {
1878 global newviewname newviewperm viewfiles bgcolor
1879
1880 toplevel $top
1881 wm title $top $title
1882 label $top.nl -text [mc "Name"]
1883 entry $top.name -width 20 -textvariable newviewname($n)
1884 grid $top.nl $top.name -sticky w -pady 5
1885 checkbutton $top.perm -text [mc "Remember this view"] \
1886 -variable newviewperm($n)
1887 grid $top.perm - -pady 5 -sticky w
1888 message $top.al -aspect 1000 \
1889 -text [mc "Commits to include (arguments to git rev-list):"]
1890 grid $top.al - -sticky w -pady 5
1891 entry $top.args -width 50 -textvariable newviewargs($n) \
1892 -background $bgcolor
1893 grid $top.args - -sticky ew -padx 5
1894 message $top.l -aspect 1000 \
1895 -text [mc "Enter files and directories to include, one per line:"]
1896 grid $top.l - -sticky w
1897 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1898 if {[info exists viewfiles($n)]} {
1899 foreach f $viewfiles($n) {
1900 $top.t insert end $f
1901 $top.t insert end "\n"
1902 }
1903 $top.t delete {end - 1c} end
1904 $top.t mark set insert 0.0
1905 }
1906 grid $top.t - -sticky ew -padx 5
1907 frame $top.buts
1908 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1909 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1910 grid $top.buts.ok $top.buts.can
1911 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1912 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1913 grid $top.buts - -pady 10 -sticky ew
1914 focus $top.t
1915 }
1916
1917 proc doviewmenu {m first cmd op argv} {
1918 set nmenu [$m index end]
1919 for {set i $first} {$i <= $nmenu} {incr i} {
1920 if {[$m entrycget $i -command] eq $cmd} {
1921 eval $m $op $i $argv
1922 break
1923 }
1924 }
1925 }
1926
1927 proc allviewmenus {n op args} {
1928 # global viewhlmenu
1929
1930 doviewmenu .bar.view 5 [list showview $n] $op $args
1931 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1932 }
1933
1934 proc newviewok {top n} {
1935 global nextviewnum newviewperm newviewname newishighlight
1936 global viewname viewfiles viewperm selectedview curview
1937 global viewargs newviewargs viewhlmenu
1938
1939 if {[catch {
1940 set newargs [shellsplit $newviewargs($n)]
1941 } err]} {
1942 error_popup "[mc "Error in commit selection arguments:"] $err"
1943 wm raise $top
1944 focus $top
1945 return
1946 }
1947 set files {}
1948 foreach f [split [$top.t get 0.0 end] "\n"] {
1949 set ft [string trim $f]
1950 if {$ft ne {}} {
1951 lappend files $ft
1952 }
1953 }
1954 if {![info exists viewfiles($n)]} {
1955 # creating a new view
1956 incr nextviewnum
1957 set viewname($n) $newviewname($n)
1958 set viewperm($n) $newviewperm($n)
1959 set viewfiles($n) $files
1960 set viewargs($n) $newargs
1961 addviewmenu $n
1962 if {!$newishighlight} {
1963 run showview $n
1964 } else {
1965 run addvhighlight $n
1966 }
1967 } else {
1968 # editing an existing view
1969 set viewperm($n) $newviewperm($n)
1970 if {$newviewname($n) ne $viewname($n)} {
1971 set viewname($n) $newviewname($n)
1972 doviewmenu .bar.view 5 [list showview $n] \
1973 entryconf [list -label $viewname($n)]
1974 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1975 # entryconf [list -label $viewname($n) -value $viewname($n)]
1976 }
1977 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1978 set viewfiles($n) $files
1979 set viewargs($n) $newargs
1980 if {$curview == $n} {
1981 run updatecommits
1982 }
1983 }
1984 }
1985 catch {destroy $top}
1986 }
1987
1988 proc delview {} {
1989 global curview viewdata viewperm hlview selectedhlview
1990
1991 if {$curview == 0} return
1992 if {[info exists hlview] && $hlview == $curview} {
1993 set selectedhlview [mc "None"]
1994 unset hlview
1995 }
1996 allviewmenus $curview delete
1997 set viewdata($curview) {}
1998 set viewperm($curview) 0
1999 showview 0
2000 }
2001
2002 proc addviewmenu {n} {
2003 global viewname viewhlmenu
2004
2005 .bar.view add radiobutton -label $viewname($n) \
2006 -command [list showview $n] -variable selectedview -value $n
2007 #$viewhlmenu add radiobutton -label $viewname($n) \
2008 # -command [list addvhighlight $n] -variable selectedhlview
2009 }
2010
2011 proc flatten {var} {
2012 global $var
2013
2014 set ret {}
2015 foreach i [array names $var] {
2016 lappend ret $i [set $var\($i\)]
2017 }
2018 return $ret
2019 }
2020
2021 proc unflatten {var l} {
2022 global $var
2023
2024 catch {unset $var}
2025 foreach {i v} $l {
2026 set $var\($i\) $v
2027 }
2028 }
2029
2030 proc showview {n} {
2031 global curview viewdata viewfiles
2032 global displayorder parentlist rowidlist rowisopt rowfinal
2033 global colormap rowtextx commitrow nextcolor canvxmax
2034 global numcommits commitlisted
2035 global selectedline currentid canv canvy0
2036 global treediffs
2037 global pending_select phase
2038 global commitidx
2039 global commfd
2040 global selectedview selectfirst
2041 global vparentlist vdisporder vcmitlisted
2042 global hlview selectedhlview commitinterest
2043
2044 if {$n == $curview} return
2045 set selid {}
2046 if {[info exists selectedline]} {
2047 set selid $currentid
2048 set y [yc $selectedline]
2049 set ymax [lindex [$canv cget -scrollregion] 3]
2050 set span [$canv yview]
2051 set ytop [expr {[lindex $span 0] * $ymax}]
2052 set ybot [expr {[lindex $span 1] * $ymax}]
2053 if {$ytop < $y && $y < $ybot} {
2054 set yscreen [expr {$y - $ytop}]
2055 } else {
2056 set yscreen [expr {($ybot - $ytop) / 2}]
2057 }
2058 } elseif {[info exists pending_select]} {
2059 set selid $pending_select
2060 unset pending_select
2061 }
2062 unselectline
2063 normalline
2064 if {$curview >= 0} {
2065 set vparentlist($curview) $parentlist
2066 set vdisporder($curview) $displayorder
2067 set vcmitlisted($curview) $commitlisted
2068 if {$phase ne {} ||
2069 ![info exists viewdata($curview)] ||
2070 [lindex $viewdata($curview) 0] ne {}} {
2071 set viewdata($curview) \
2072 [list $phase $rowidlist $rowisopt $rowfinal]
2073 }
2074 }
2075 catch {unset treediffs}
2076 clear_display
2077 if {[info exists hlview] && $hlview == $n} {
2078 unset hlview
2079 set selectedhlview [mc "None"]
2080 }
2081 catch {unset commitinterest}
2082
2083 set curview $n
2084 set selectedview $n
2085 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2086 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2087
2088 run refill_reflist
2089 if {![info exists viewdata($n)]} {
2090 if {$selid ne {}} {
2091 set pending_select $selid
2092 }
2093 getcommits
2094 return
2095 }
2096
2097 set v $viewdata($n)
2098 set phase [lindex $v 0]
2099 set displayorder $vdisporder($n)
2100 set parentlist $vparentlist($n)
2101 set commitlisted $vcmitlisted($n)
2102 set rowidlist [lindex $v 1]
2103 set rowisopt [lindex $v 2]
2104 set rowfinal [lindex $v 3]
2105 set numcommits $commitidx($n)
2106
2107 catch {unset colormap}
2108 catch {unset rowtextx}
2109 set nextcolor 0
2110 set canvxmax [$canv cget -width]
2111 set curview $n
2112 set row 0
2113 setcanvscroll
2114 set yf 0
2115 set row {}
2116 set selectfirst 0
2117 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2118 set row $commitrow($n,$selid)
2119 # try to get the selected row in the same position on the screen
2120 set ymax [lindex [$canv cget -scrollregion] 3]
2121 set ytop [expr {[yc $row] - $yscreen}]
2122 if {$ytop < 0} {
2123 set ytop 0
2124 }
2125 set yf [expr {$ytop * 1.0 / $ymax}]
2126 }
2127 allcanvs yview moveto $yf
2128 drawvisible
2129 if {$row ne {}} {
2130 selectline $row 0
2131 } elseif {$selid ne {}} {
2132 set pending_select $selid
2133 } else {
2134 set row [first_real_row]
2135 if {$row < $numcommits} {
2136 selectline $row 0
2137 } else {
2138 set selectfirst 1
2139 }
2140 }
2141 if {$phase ne {}} {
2142 if {$phase eq "getcommits"} {
2143 show_status [mc "Reading commits..."]
2144 }
2145 run chewcommits $n
2146 } elseif {$numcommits == 0} {
2147 show_status [mc "No commits selected"]
2148 }
2149 }
2150
2151 # Stuff relating to the highlighting facility
2152
2153 proc ishighlighted {row} {
2154 global vhighlights fhighlights nhighlights rhighlights
2155
2156 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2157 return $nhighlights($row)
2158 }
2159 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2160 return $vhighlights($row)
2161 }
2162 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2163 return $fhighlights($row)
2164 }
2165 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2166 return $rhighlights($row)
2167 }
2168 return 0
2169 }
2170
2171 proc bolden {row font} {
2172 global canv linehtag selectedline boldrows
2173
2174 lappend boldrows $row
2175 $canv itemconf $linehtag($row) -font $font
2176 if {[info exists selectedline] && $row == $selectedline} {
2177 $canv delete secsel
2178 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2179 -outline {{}} -tags secsel \
2180 -fill [$canv cget -selectbackground]]
2181 $canv lower $t
2182 }
2183 }
2184
2185 proc bolden_name {row font} {
2186 global canv2 linentag selectedline boldnamerows
2187
2188 lappend boldnamerows $row
2189 $canv2 itemconf $linentag($row) -font $font
2190 if {[info exists selectedline] && $row == $selectedline} {
2191 $canv2 delete secsel
2192 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2193 -outline {{}} -tags secsel \
2194 -fill [$canv2 cget -selectbackground]]
2195 $canv2 lower $t
2196 }
2197 }
2198
2199 proc unbolden {} {
2200 global boldrows
2201
2202 set stillbold {}
2203 foreach row $boldrows {
2204 if {![ishighlighted $row]} {
2205 bolden $row mainfont
2206 } else {
2207 lappend stillbold $row
2208 }
2209 }
2210 set boldrows $stillbold
2211 }
2212
2213 proc addvhighlight {n} {
2214 global hlview curview viewdata vhl_done vhighlights commitidx
2215
2216 if {[info exists hlview]} {
2217 delvhighlight
2218 }
2219 set hlview $n
2220 if {$n != $curview && ![info exists viewdata($n)]} {
2221 set viewdata($n) [list getcommits {{}} 0 0 0]
2222 set vparentlist($n) {}
2223 set vdisporder($n) {}
2224 set vcmitlisted($n) {}
2225 start_rev_list $n
2226 }
2227 set vhl_done $commitidx($hlview)
2228 if {$vhl_done > 0} {
2229 drawvisible
2230 }
2231 }
2232
2233 proc delvhighlight {} {
2234 global hlview vhighlights
2235
2236 if {![info exists hlview]} return
2237 unset hlview
2238 catch {unset vhighlights}
2239 unbolden
2240 }
2241
2242 proc vhighlightmore {} {
2243 global hlview vhl_done commitidx vhighlights
2244 global displayorder vdisporder curview
2245
2246 set max $commitidx($hlview)
2247 if {$hlview == $curview} {
2248 set disp $displayorder
2249 } else {
2250 set disp $vdisporder($hlview)
2251 }
2252 set vr [visiblerows]
2253 set r0 [lindex $vr 0]
2254 set r1 [lindex $vr 1]
2255 for {set i $vhl_done} {$i < $max} {incr i} {
2256 set id [lindex $disp $i]
2257 if {[info exists commitrow($curview,$id)]} {
2258 set row $commitrow($curview,$id)
2259 if {$r0 <= $row && $row <= $r1} {
2260 if {![highlighted $row]} {
2261 bolden $row mainfontbold
2262 }
2263 set vhighlights($row) 1
2264 }
2265 }
2266 }
2267 set vhl_done $max
2268 }
2269
2270 proc askvhighlight {row id} {
2271 global hlview vhighlights commitrow iddrawn
2272
2273 if {[info exists commitrow($hlview,$id)]} {
2274 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2275 bolden $row mainfontbold
2276 }
2277 set vhighlights($row) 1
2278 } else {
2279 set vhighlights($row) 0
2280 }
2281 }
2282
2283 proc hfiles_change {} {
2284 global highlight_files filehighlight fhighlights fh_serial
2285 global highlight_paths gdttype
2286
2287 if {[info exists filehighlight]} {
2288 # delete previous highlights
2289 catch {close $filehighlight}
2290 unset filehighlight
2291 catch {unset fhighlights}
2292 unbolden
2293 unhighlight_filelist
2294 }
2295 set highlight_paths {}
2296 after cancel do_file_hl $fh_serial
2297 incr fh_serial
2298 if {$highlight_files ne {}} {
2299 after 300 do_file_hl $fh_serial
2300 }
2301 }
2302
2303 proc gdttype_change {name ix op} {
2304 global gdttype highlight_files findstring findpattern
2305
2306 stopfinding
2307 if {$findstring ne {}} {
2308 if {$gdttype eq [mc "containing:"]} {
2309 if {$highlight_files ne {}} {
2310 set highlight_files {}
2311 hfiles_change
2312 }
2313 findcom_change
2314 } else {
2315 if {$findpattern ne {}} {
2316 set findpattern {}
2317 findcom_change
2318 }
2319 set highlight_files $findstring
2320 hfiles_change
2321 }
2322 drawvisible
2323 }
2324 # enable/disable findtype/findloc menus too
2325 }
2326
2327 proc find_change {name ix op} {
2328 global gdttype findstring highlight_files
2329
2330 stopfinding
2331 if {$gdttype eq [mc "containing:"]} {
2332 findcom_change
2333 } else {
2334 if {$highlight_files ne $findstring} {
2335 set highlight_files $findstring
2336 hfiles_change
2337 }
2338 }
2339 drawvisible
2340 }
2341
2342 proc findcom_change args {
2343 global nhighlights boldnamerows
2344 global findpattern findtype findstring gdttype
2345
2346 stopfinding
2347 # delete previous highlights, if any
2348 foreach row $boldnamerows {
2349 bolden_name $row mainfont
2350 }
2351 set boldnamerows {}
2352 catch {unset nhighlights}
2353 unbolden
2354 unmarkmatches
2355 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2356 set findpattern {}
2357 } elseif {$findtype eq [mc "Regexp"]} {
2358 set findpattern $findstring
2359 } else {
2360 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2361 $findstring]
2362 set findpattern "*$e*"
2363 }
2364 }
2365
2366 proc makepatterns {l} {
2367 set ret {}
2368 foreach e $l {
2369 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2370 if {[string index $ee end] eq "/"} {
2371 lappend ret "$ee*"
2372 } else {
2373 lappend ret $ee
2374 lappend ret "$ee/*"
2375 }
2376 }
2377 return $ret
2378 }
2379
2380 proc do_file_hl {serial} {
2381 global highlight_files filehighlight highlight_paths gdttype fhl_list
2382
2383 if {$gdttype eq [mc "touching paths:"]} {
2384 if {[catch {set paths [shellsplit $highlight_files]}]} return
2385 set highlight_paths [makepatterns $paths]
2386 highlight_filelist
2387 set gdtargs [concat -- $paths]
2388 } elseif {$gdttype eq [mc "adding/removing string:"]} {
2389 set gdtargs [list "-S$highlight_files"]
2390 } else {
2391 # must be "containing:", i.e. we're searching commit info
2392 return
2393 }
2394 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2395 set filehighlight [open $cmd r+]
2396 fconfigure $filehighlight -blocking 0
2397 filerun $filehighlight readfhighlight
2398 set fhl_list {}
2399 drawvisible
2400 flushhighlights
2401 }
2402
2403 proc flushhighlights {} {
2404 global filehighlight fhl_list
2405
2406 if {[info exists filehighlight]} {
2407 lappend fhl_list {}
2408 puts $filehighlight ""
2409 flush $filehighlight
2410 }
2411 }
2412
2413 proc askfilehighlight {row id} {
2414 global filehighlight fhighlights fhl_list
2415
2416 lappend fhl_list $id
2417 set fhighlights($row) -1
2418 puts $filehighlight $id
2419 }
2420
2421 proc readfhighlight {} {
2422 global filehighlight fhighlights commitrow curview iddrawn
2423 global fhl_list find_dirn
2424
2425 if {![info exists filehighlight]} {
2426 return 0
2427 }
2428 set nr 0
2429 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2430 set line [string trim $line]
2431 set i [lsearch -exact $fhl_list $line]
2432 if {$i < 0} continue
2433 for {set j 0} {$j < $i} {incr j} {
2434 set id [lindex $fhl_list $j]
2435 if {[info exists commitrow($curview,$id)]} {
2436 set fhighlights($commitrow($curview,$id)) 0
2437 }
2438 }
2439 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2440 if {$line eq {}} continue
2441 if {![info exists commitrow($curview,$line)]} continue
2442 set row $commitrow($curview,$line)
2443 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2444 bolden $row mainfontbold
2445 }
2446 set fhighlights($row) 1
2447 }
2448 if {[eof $filehighlight]} {
2449 # strange...
2450 puts "oops, git diff-tree died"
2451 catch {close $filehighlight}
2452 unset filehighlight
2453 return 0
2454 }
2455 if {[info exists find_dirn]} {
2456 run findmore
2457 }
2458 return 1
2459 }
2460
2461 proc doesmatch {f} {
2462 global findtype findpattern
2463
2464 if {$findtype eq [mc "Regexp"]} {
2465 return [regexp $findpattern $f]
2466 } elseif {$findtype eq [mc "IgnCase"]} {
2467 return [string match -nocase $findpattern $f]
2468 } else {
2469 return [string match $findpattern $f]
2470 }
2471 }
2472
2473 proc askfindhighlight {row id} {
2474 global nhighlights commitinfo iddrawn
2475 global findloc
2476 global markingmatches
2477
2478 if {![info exists commitinfo($id)]} {
2479 getcommit $id
2480 }
2481 set info $commitinfo($id)
2482 set isbold 0
2483 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2484 foreach f $info ty $fldtypes {
2485 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2486 [doesmatch $f]} {
2487 if {$ty eq [mc "Author"]} {
2488 set isbold 2
2489 break
2490 }
2491 set isbold 1
2492 }
2493 }
2494 if {$isbold && [info exists iddrawn($id)]} {
2495 if {![ishighlighted $row]} {
2496 bolden $row mainfontbold
2497 if {$isbold > 1} {
2498 bolden_name $row mainfontbold
2499 }
2500 }
2501 if {$markingmatches} {
2502 markrowmatches $row $id
2503 }
2504 }
2505 set nhighlights($row) $isbold
2506 }
2507
2508 proc 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 [mc "All fields"] || $findloc eq [mc "Headline"]} {
2516 set m [findmatches $headline]
2517 if {$m ne {}} {
2518 markmatches $canv $row $headline $linehtag($row) $m \
2519 [$canv itemcget $linehtag($row) -font] $row
2520 }
2521 }
2522 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2523 set m [findmatches $author]
2524 if {$m ne {}} {
2525 markmatches $canv2 $row $author $linentag($row) $m \
2526 [$canv2 itemcget $linentag($row) -font] $row
2527 }
2528 }
2529 }
2530
2531 proc vrel_change {name ix op} {
2532 global highlight_related
2533
2534 rhighlight_none
2535 if {$highlight_related ne [mc "None"]} {
2536 run drawvisible
2537 }
2538 }
2539
2540 # prepare for testing whether commits are descendents or ancestors of a
2541 proc rhighlight_sel {a} {
2542 global descendent desc_todo ancestor anc_todo
2543 global highlight_related rhighlights
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 [mc "None"]} {
2550 rhighlight_none
2551 run drawvisible
2552 }
2553 }
2554
2555 proc rhighlight_none {} {
2556 global rhighlights
2557
2558 catch {unset rhighlights}
2559 unbolden
2560 }
2561
2562 proc 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
2594 proc 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
2626 proc askrelhighlight {row id} {
2627 global descendent highlight_related iddrawn rhighlights
2628 global selectedline ancestor
2629
2630 if {![info exists selectedline]} return
2631 set isbold 0
2632 if {$highlight_related eq [mc "Descendant"] ||
2633 $highlight_related eq [mc "Not descendant"]} {
2634 if {![info exists descendent($id)]} {
2635 is_descendent $id
2636 }
2637 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2638 set isbold 1
2639 }
2640 } elseif {$highlight_related eq [mc "Ancestor"] ||
2641 $highlight_related eq [mc "Not ancestor"]} {
2642 if {![info exists ancestor($id)]} {
2643 is_ancestor $id
2644 }
2645 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2646 set isbold 1
2647 }
2648 }
2649 if {[info exists iddrawn($id)]} {
2650 if {$isbold && ![ishighlighted $row]} {
2651 bolden $row mainfontbold
2652 }
2653 }
2654 set rhighlights($row) $isbold
2655 }
2656
2657 # Graph layout functions
2658
2659 proc shortids {ids} {
2660 set res {}
2661 foreach id $ids {
2662 if {[llength $id] > 1} {
2663 lappend res [shortids $id]
2664 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2665 lappend res [string range $id 0 7]
2666 } else {
2667 lappend res $id
2668 }
2669 }
2670 return $res
2671 }
2672
2673 proc ntimes {n o} {
2674 set ret {}
2675 set o [list $o]
2676 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2677 if {($n & $mask) != 0} {
2678 set ret [concat $ret $o]
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
2687 proc 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
2708 proc initlayout {} {
2709 global rowidlist rowisopt rowfinal displayorder commitlisted
2710 global numcommits canvxmax canv
2711 global nextcolor
2712 global parentlist
2713 global colormap rowtextx
2714 global selectfirst
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
2730 proc 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
2739 proc 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
2758 proc layoutmore {} {
2759 global commitidx viewcomplete numcommits
2760 global uparrowlen downarrowlen mingaplen curview
2761
2762 set show $commitidx($curview)
2763 if {$show > $numcommits || $viewcomplete($curview)} {
2764 showstuff $show $viewcomplete($curview)
2765 }
2766 }
2767
2768 proc 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
2810 proc 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
2821 proc 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
2839 proc 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
2851 proc 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 [mc "Local changes checked in to index but not committed"]
2876 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2877 set commitdata($nullid2) "\n $hl\n"
2878 insertrow $localirow $nullid2
2879 }
2880 return 0
2881 }
2882
2883 proc 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 [mc "Local uncommitted changes, not checked in to index"]
2906 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2907 set commitdata($nullid) "\n $hl\n"
2908 insertrow $localfrow $nullid
2909 }
2910 return 0
2911 }
2912
2913 proc 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
2932 proc 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
2947 proc 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
3010 proc 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
3020 proc 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
3041 proc layoutrows {row endrow} {
3042 global rowidlist rowisopt rowfinal displayorder
3043 global uparrowlen downarrowlen maxwidth mingaplen
3044 global children parentlist
3045 global commitidx viewcomplete curview commitrow
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
3147 proc 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
3166 proc 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
3181 proc 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
3305 proc xc {row col} {
3306 global canvx0 linespc
3307 return [expr {$canvx0 + $col * $linespc}]
3308 }
3309
3310 proc yc {row} {
3311 global canvy0 linespc
3312 return [expr {$canvy0 + $row * $linespc}]
3313 }
3314
3315 proc 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
3325 proc 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
3381 proc 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
3547 proc 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
3616 proc drawlines {id} {
3617 global canv
3618
3619 $canv itemconf lines.$id -width [linewidth $id]
3620 }
3621
3622 proc drawcmittext {id row col} {
3623 global linespc canv canv2 canv3 canvy0 fgcolor curview
3624 global commitlisted commitinfo rowidlist parentlist
3625 global rowtextx idpos idtags idheads idotherrefs
3626 global linehtag linentag linedtag selectedline
3627 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
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 set font mainfontbold
3690 if {$isbold > 1} {
3691 lappend boldnamerows $row
3692 set nfont mainfontbold
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 $font $headline]}]
3706 if {$xr > $canvxmax} {
3707 set canvxmax $xr
3708 setcanvscroll
3709 }
3710 }
3711
3712 proc drawcmitrow {row} {
3713 global displayorder rowidlist nrows_drawn
3714 global iddrawn markingmatches
3715 global commitinfo parentlist numcommits
3716 global filehighlight fhighlights findpattern nhighlights
3717 global hlview vhighlights
3718 global highlight_related rhighlights
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 [mc "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
3754 proc 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)]} continue
3814 drawparentlinks $id $r
3815
3816 set rowids [lindex $rowidlist $r]
3817 foreach lid $rowids {
3818 if {$lid eq {}} continue
3819 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3820 if {$lid eq $id} {
3821 # see if this is the first child of any of its parents
3822 foreach p [lindex $parentlist $r] {
3823 if {[lsearch -exact $rowids $p] < 0} {
3824 # make this line extend up to the child
3825 set lineend($p) [drawlineseg $p $r $er 0]
3826 }
3827 }
3828 } else {
3829 set lineend($lid) [drawlineseg $lid $r $er 1]
3830 }
3831 }
3832 }
3833 }
3834
3835 proc drawfrac {f0 f1} {
3836 global canv linespc
3837
3838 set ymax [lindex [$canv cget -scrollregion] 3]
3839 if {$ymax eq {} || $ymax == 0} return
3840 set y0 [expr {int($f0 * $ymax)}]
3841 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3842 set y1 [expr {int($f1 * $ymax)}]
3843 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3844 drawcommits $row $endrow
3845 }
3846
3847 proc drawvisible {} {
3848 global canv
3849 eval drawfrac [$canv yview]
3850 }
3851
3852 proc clear_display {} {
3853 global iddrawn linesegs need_redisplay nrows_drawn
3854 global vhighlights fhighlights nhighlights rhighlights
3855
3856 allcanvs delete all
3857 catch {unset iddrawn}
3858 catch {unset linesegs}
3859 catch {unset vhighlights}
3860 catch {unset fhighlights}
3861 catch {unset nhighlights}
3862 catch {unset rhighlights}
3863 set need_redisplay 0
3864 set nrows_drawn 0
3865 }
3866
3867 proc findcrossings {id} {
3868 global rowidlist parentlist numcommits displayorder
3869
3870 set cross {}
3871 set ccross {}
3872 foreach {s e} [rowranges $id] {
3873 if {$e >= $numcommits} {
3874 set e [expr {$numcommits - 1}]
3875 }
3876 if {$e <= $s} continue
3877 for {set row $e} {[incr row -1] >= $s} {} {
3878 set x [lsearch -exact [lindex $rowidlist $row] $id]
3879 if {$x < 0} break
3880 set olds [lindex $parentlist $row]
3881 set kid [lindex $displayorder $row]
3882 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3883 if {$kidx < 0} continue
3884 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3885 foreach p $olds {
3886 set px [lsearch -exact $nextrow $p]
3887 if {$px < 0} continue
3888 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3889 if {[lsearch -exact $ccross $p] >= 0} continue
3890 if {$x == $px + ($kidx < $px? -1: 1)} {
3891 lappend ccross $p
3892 } elseif {[lsearch -exact $cross $p] < 0} {
3893 lappend cross $p
3894 }
3895 }
3896 }
3897 }
3898 }
3899 return [concat $ccross {{}} $cross]
3900 }
3901
3902 proc assigncolor {id} {
3903 global colormap colors nextcolor
3904 global commitrow parentlist children children curview
3905
3906 if {[info exists colormap($id)]} return
3907 set ncolors [llength $colors]
3908 if {[info exists children($curview,$id)]} {
3909 set kids $children($curview,$id)
3910 } else {
3911 set kids {}
3912 }
3913 if {[llength $kids] == 1} {
3914 set child [lindex $kids 0]
3915 if {[info exists colormap($child)]
3916 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3917 set colormap($id) $colormap($child)
3918 return
3919 }
3920 }
3921 set badcolors {}
3922 set origbad {}
3923 foreach x [findcrossings $id] {
3924 if {$x eq {}} {
3925 # delimiter between corner crossings and other crossings
3926 if {[llength $badcolors] >= $ncolors - 1} break
3927 set origbad $badcolors
3928 }
3929 if {[info exists colormap($x)]
3930 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3931 lappend badcolors $colormap($x)
3932 }
3933 }
3934 if {[llength $badcolors] >= $ncolors} {
3935 set badcolors $origbad
3936 }
3937 set origbad $badcolors
3938 if {[llength $badcolors] < $ncolors - 1} {
3939 foreach child $kids {
3940 if {[info exists colormap($child)]
3941 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3942 lappend badcolors $colormap($child)
3943 }
3944 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3945 if {[info exists colormap($p)]
3946 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3947 lappend badcolors $colormap($p)
3948 }
3949 }
3950 }
3951 if {[llength $badcolors] >= $ncolors} {
3952 set badcolors $origbad
3953 }
3954 }
3955 for {set i 0} {$i <= $ncolors} {incr i} {
3956 set c [lindex $colors $nextcolor]
3957 if {[incr nextcolor] >= $ncolors} {
3958 set nextcolor 0
3959 }
3960 if {[lsearch -exact $badcolors $c]} break
3961 }
3962 set colormap($id) $c
3963 }
3964
3965 proc bindline {t id} {
3966 global canv
3967
3968 $canv bind $t <Enter> "lineenter %x %y $id"
3969 $canv bind $t <