git.el: Make status refresh faster.
[git/git.git] / gitk-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 "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 "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 "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 "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 "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) {"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 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 OK -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text Cancel -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
612 tkwait window $w
613 return $confirm_ok
614 }
615
616 proc makewindow {} {
617 global canv canv2 canv3 linespc charspc ctext cflist
618 global tabstop
619 global findtype findtypemenu findloc findstring fstring geometry
620 global entries sha1entry sha1string sha1but
621 global diffcontextstring diffcontext
622 global maincursor textcursor curtextcursor
623 global rowctxmenu fakerowmenu mergemax wrapcomment
624 global highlight_files gdttype
625 global searchstring sstring
626 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
627 global headctxmenu progresscanv progressitem progresscoords statusw
628 global fprogitem fprogcoord lastprogupdate progupdatepending
629 global rprogitem rprogcoord
630 global have_tk85
631
632 menu .bar
633 .bar add cascade -label "File" -menu .bar.file
634 .bar configure -font uifont
635 menu .bar.file
636 .bar.file add command -label "Update" -command updatecommits
637 .bar.file add command -label "Reread references" -command rereadrefs
638 .bar.file add command -label "List references" -command showrefs
639 .bar.file add command -label "Quit" -command doquit
640 .bar.file configure -font uifont
641 menu .bar.edit
642 .bar add cascade -label "Edit" -menu .bar.edit
643 .bar.edit add command -label "Preferences" -command doprefs
644 .bar.edit configure -font uifont
645
646 menu .bar.view -font uifont
647 .bar add cascade -label "View" -menu .bar.view
648 .bar.view add command -label "New view..." -command {newview 0}
649 .bar.view add command -label "Edit view..." -command editview \
650 -state disabled
651 .bar.view add command -label "Delete view" -command delview -state disabled
652 .bar.view add separator
653 .bar.view add radiobutton -label "All files" -command {showview 0} \
654 -variable selectedview -value 0
655
656 menu .bar.help
657 .bar add cascade -label "Help" -menu .bar.help
658 .bar.help add command -label "About gitk" -command about
659 .bar.help add command -label "Key bindings" -command keys
660 .bar.help configure -font uifont
661 . configure -menu .bar
662
663 # the gui has upper and lower half, parts of a paned window.
664 panedwindow .ctop -orient vertical
665
666 # possibly use assumed geometry
667 if {![info exists geometry(pwsash0)]} {
668 set geometry(topheight) [expr {15 * $linespc}]
669 set geometry(topwidth) [expr {80 * $charspc}]
670 set geometry(botheight) [expr {15 * $linespc}]
671 set geometry(botwidth) [expr {50 * $charspc}]
672 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
673 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
674 }
675
676 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
677 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
678 frame .tf.histframe
679 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
680
681 # create three canvases
682 set cscroll .tf.histframe.csb
683 set canv .tf.histframe.pwclist.canv
684 canvas $canv \
685 -selectbackground $selectbgcolor \
686 -background $bgcolor -bd 0 \
687 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
688 .tf.histframe.pwclist add $canv
689 set canv2 .tf.histframe.pwclist.canv2
690 canvas $canv2 \
691 -selectbackground $selectbgcolor \
692 -background $bgcolor -bd 0 -yscrollincr $linespc
693 .tf.histframe.pwclist add $canv2
694 set canv3 .tf.histframe.pwclist.canv3
695 canvas $canv3 \
696 -selectbackground $selectbgcolor \
697 -background $bgcolor -bd 0 -yscrollincr $linespc
698 .tf.histframe.pwclist add $canv3
699 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
700 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
701
702 # a scroll bar to rule them
703 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
704 pack $cscroll -side right -fill y
705 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
706 lappend bglist $canv $canv2 $canv3
707 pack .tf.histframe.pwclist -fill both -expand 1 -side left
708
709 # we have two button bars at bottom of top frame. Bar 1
710 frame .tf.bar
711 frame .tf.lbar -height 15
712
713 set sha1entry .tf.bar.sha1
714 set entries $sha1entry
715 set sha1but .tf.bar.sha1label
716 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
717 -command gotocommit -width 8 -font uifont
718 $sha1but conf -disabledforeground [$sha1but cget -foreground]
719 pack .tf.bar.sha1label -side left
720 entry $sha1entry -width 40 -font textfont -textvariable sha1string
721 trace add variable sha1string write sha1change
722 pack $sha1entry -side left -pady 2
723
724 image create bitmap bm-left -data {
725 #define left_width 16
726 #define left_height 16
727 static unsigned char left_bits[] = {
728 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
729 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
730 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
731 }
732 image create bitmap bm-right -data {
733 #define right_width 16
734 #define right_height 16
735 static unsigned char right_bits[] = {
736 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
737 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
738 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
739 }
740 button .tf.bar.leftbut -image bm-left -command goback \
741 -state disabled -width 26
742 pack .tf.bar.leftbut -side left -fill y
743 button .tf.bar.rightbut -image bm-right -command goforw \
744 -state disabled -width 26
745 pack .tf.bar.rightbut -side left -fill y
746
747 # Status label and progress bar
748 set statusw .tf.bar.status
749 label $statusw -width 15 -relief sunken -font uifont
750 pack $statusw -side left -padx 5
751 set h [expr {[font metrics uifont -linespace] + 2}]
752 set progresscanv .tf.bar.progress
753 canvas $progresscanv -relief sunken -height $h -borderwidth 2
754 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
755 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
756 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
757 pack $progresscanv -side right -expand 1 -fill x
758 set progresscoords {0 0}
759 set fprogcoord 0
760 set rprogcoord 0
761 bind $progresscanv <Configure> adjustprogress
762 set lastprogupdate [clock clicks -milliseconds]
763 set progupdatepending 0
764
765 # build up the bottom bar of upper window
766 label .tf.lbar.flabel -text "Find " -font uifont
767 button .tf.lbar.fnext -text "next" -command {dofind 1 1} -font uifont
768 button .tf.lbar.fprev -text "prev" -command {dofind -1 1} -font uifont
769 label .tf.lbar.flab2 -text " commit " -font uifont
770 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
771 -side left -fill y
772 set gdttype "containing:"
773 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
774 "containing:" \
775 "touching paths:" \
776 "adding/removing string:"]
777 trace add variable gdttype write gdttype_change
778 $gm conf -font uifont
779 .tf.lbar.gdttype conf -font uifont
780 pack .tf.lbar.gdttype -side left -fill y
781
782 set findstring {}
783 set fstring .tf.lbar.findstring
784 lappend entries $fstring
785 entry $fstring -width 30 -font textfont -textvariable findstring
786 trace add variable findstring write find_change
787 set findtype Exact
788 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
789 findtype Exact IgnCase Regexp]
790 trace add variable findtype write findcom_change
791 .tf.lbar.findtype configure -font uifont
792 .tf.lbar.findtype.menu configure -font uifont
793 set findloc "All fields"
794 tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
795 Comments Author Committer
796 trace add variable findloc write find_change
797 .tf.lbar.findloc configure -font uifont
798 .tf.lbar.findloc.menu configure -font uifont
799 pack .tf.lbar.findloc -side right
800 pack .tf.lbar.findtype -side right
801 pack $fstring -side left -expand 1 -fill x
802
803 # Finish putting the upper half of the viewer together
804 pack .tf.lbar -in .tf -side bottom -fill x
805 pack .tf.bar -in .tf -side bottom -fill x
806 pack .tf.histframe -fill both -side top -expand 1
807 .ctop add .tf
808 .ctop paneconfigure .tf -height $geometry(topheight)
809 .ctop paneconfigure .tf -width $geometry(topwidth)
810
811 # now build up the bottom
812 panedwindow .pwbottom -orient horizontal
813
814 # lower left, a text box over search bar, scroll bar to the right
815 # if we know window height, then that will set the lower text height, otherwise
816 # we set lower text height which will drive window height
817 if {[info exists geometry(main)]} {
818 frame .bleft -width $geometry(botwidth)
819 } else {
820 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
821 }
822 frame .bleft.top
823 frame .bleft.mid
824
825 button .bleft.top.search -text "Search" -command dosearch \
826 -font uifont
827 pack .bleft.top.search -side left -padx 5
828 set sstring .bleft.top.sstring
829 entry $sstring -width 20 -font textfont -textvariable searchstring
830 lappend entries $sstring
831 trace add variable searchstring write incrsearch
832 pack $sstring -side left -expand 1 -fill x
833 radiobutton .bleft.mid.diff -text "Diff" -font uifont \
834 -command changediffdisp -variable diffelide -value {0 0}
835 radiobutton .bleft.mid.old -text "Old version" -font uifont \
836 -command changediffdisp -variable diffelide -value {0 1}
837 radiobutton .bleft.mid.new -text "New version" -font uifont \
838 -command changediffdisp -variable diffelide -value {1 0}
839 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
840 -font uifont
841 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
842 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
843 -from 1 -increment 1 -to 10000000 \
844 -validate all -validatecommand "diffcontextvalidate %P" \
845 -textvariable diffcontextstring
846 .bleft.mid.diffcontext set $diffcontext
847 trace add variable diffcontextstring write diffcontextchange
848 lappend entries .bleft.mid.diffcontext
849 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
850 set ctext .bleft.ctext
851 text $ctext -background $bgcolor -foreground $fgcolor \
852 -state disabled -font textfont \
853 -yscrollcommand scrolltext -wrap none
854 if {$have_tk85} {
855 $ctext conf -tabstyle wordprocessor
856 }
857 scrollbar .bleft.sb -command "$ctext yview"
858 pack .bleft.top -side top -fill x
859 pack .bleft.mid -side top -fill x
860 pack .bleft.sb -side right -fill y
861 pack $ctext -side left -fill both -expand 1
862 lappend bglist $ctext
863 lappend fglist $ctext
864
865 $ctext tag conf comment -wrap $wrapcomment
866 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
867 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
868 $ctext tag conf d0 -fore [lindex $diffcolors 0]
869 $ctext tag conf d1 -fore [lindex $diffcolors 1]
870 $ctext tag conf m0 -fore red
871 $ctext tag conf m1 -fore blue
872 $ctext tag conf m2 -fore green
873 $ctext tag conf m3 -fore purple
874 $ctext tag conf m4 -fore brown
875 $ctext tag conf m5 -fore "#009090"
876 $ctext tag conf m6 -fore magenta
877 $ctext tag conf m7 -fore "#808000"
878 $ctext tag conf m8 -fore "#009000"
879 $ctext tag conf m9 -fore "#ff0080"
880 $ctext tag conf m10 -fore cyan
881 $ctext tag conf m11 -fore "#b07070"
882 $ctext tag conf m12 -fore "#70b0f0"
883 $ctext tag conf m13 -fore "#70f0b0"
884 $ctext tag conf m14 -fore "#f0b070"
885 $ctext tag conf m15 -fore "#ff70b0"
886 $ctext tag conf mmax -fore darkgrey
887 set mergemax 16
888 $ctext tag conf mresult -font textfontbold
889 $ctext tag conf msep -font textfontbold
890 $ctext tag conf found -back yellow
891
892 .pwbottom add .bleft
893 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
894
895 # lower right
896 frame .bright
897 frame .bright.mode
898 radiobutton .bright.mode.patch -text "Patch" \
899 -command reselectline -variable cmitmode -value "patch"
900 .bright.mode.patch configure -font uifont
901 radiobutton .bright.mode.tree -text "Tree" \
902 -command reselectline -variable cmitmode -value "tree"
903 .bright.mode.tree configure -font uifont
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 "Diff this -> selected" \
1019 -command {diffvssel 0}
1020 $rowctxmenu add command -label "Diff selected -> this" \
1021 -command {diffvssel 1}
1022 $rowctxmenu add command -label "Make patch" -command mkpatch
1023 $rowctxmenu add command -label "Create tag" -command mktag
1024 $rowctxmenu add command -label "Write commit to file" -command writecommit
1025 $rowctxmenu add command -label "Create new branch" -command mkbranch
1026 $rowctxmenu add command -label "Cherry-pick this commit" \
1027 -command cherrypick
1028 $rowctxmenu add command -label "Reset HEAD branch to here" \
1029 -command resethead
1030
1031 set fakerowmenu .fakerowmenu
1032 menu $fakerowmenu -tearoff 0
1033 $fakerowmenu add command -label "Diff this -> selected" \
1034 -command {diffvssel 0}
1035 $fakerowmenu add command -label "Diff selected -> this" \
1036 -command {diffvssel 1}
1037 $fakerowmenu add command -label "Make patch" -command mkpatch
1038 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
1039 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
1040 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
1041
1042 set headctxmenu .headctxmenu
1043 menu $headctxmenu -tearoff 0
1044 $headctxmenu add command -label "Check out this branch" \
1045 -command cobranch
1046 $headctxmenu add command -label "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 "Highlight this too" \
1053 -command {flist_hl 0}
1054 $flist_menu add command -label "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 "About gitk"
1281 message $w.m -text {
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 $w.m configure -font uifont
1290 button $w.ok -text Close -command "destroy $w" -default active
1291 pack $w.ok -side bottom
1292 $w.ok configure -font uifont
1293 bind $w <Visibility> "focus $w.ok"
1294 bind $w <Key-Escape> "destroy $w"
1295 bind $w <Key-Return> "destroy $w"
1296 }
1297
1298 proc keys {} {
1299 global uifont
1300 set w .keys
1301 if {[winfo exists $w]} {
1302 raise $w
1303 return
1304 }
1305 if {[tk windowingsystem] eq {aqua}} {
1306 set M1T Cmd
1307 } else {
1308 set M1T Ctrl
1309 }
1310 toplevel $w
1311 wm title $w "Gitk key bindings"
1312 message $w.m -text "
1313 Gitk key bindings:
1314
1315 <$M1T-Q> Quit
1316 <Home> Move to first commit
1317 <End> Move to last commit
1318 <Up>, p, i Move up one commit
1319 <Down>, n, k Move down one commit
1320 <Left>, z, j Go back in history list
1321 <Right>, x, l Go forward in history list
1322 <PageUp> Move up one page in commit list
1323 <PageDown> Move down one page in commit list
1324 <$M1T-Home> Scroll to top of commit list
1325 <$M1T-End> Scroll to bottom of commit list
1326 <$M1T-Up> Scroll commit list up one line
1327 <$M1T-Down> Scroll commit list down one line
1328 <$M1T-PageUp> Scroll commit list up one page
1329 <$M1T-PageDown> Scroll commit list down one page
1330 <Shift-Up> Find backwards (upwards, later commits)
1331 <Shift-Down> Find forwards (downwards, earlier commits)
1332 <Delete>, b Scroll diff view up one page
1333 <Backspace> Scroll diff view up one page
1334 <Space> Scroll diff view down one page
1335 u Scroll diff view up 18 lines
1336 d Scroll diff view down 18 lines
1337 <$M1T-F> Find
1338 <$M1T-G> Move to next find hit
1339 <Return> Move to next find hit
1340 / Move to next find hit, or redo find
1341 ? Move to previous find hit
1342 f Scroll diff view to next file
1343 <$M1T-S> Search for next hit in diff view
1344 <$M1T-R> Search for previous hit in diff view
1345 <$M1T-KP+> Increase font size
1346 <$M1T-plus> Increase font size
1347 <$M1T-KP-> Decrease font size
1348 <$M1T-minus> Decrease font size
1349 <F5> Update
1350 " \
1351 -justify left -bg white -border 2 -relief groove
1352 pack $w.m -side top -fill both -padx 2 -pady 2
1353 $w.m configure -font uifont
1354 button $w.ok -text Close -command "destroy $w" -default active
1355 pack $w.ok -side bottom
1356 $w.ok configure -font uifont
1357 bind $w <Visibility> "focus $w.ok"
1358 bind $w <Key-Escape> "destroy $w"
1359 bind $w <Key-Return> "destroy $w"
1360 }
1361
1362 # Procedures for manipulating the file list window at the
1363 # bottom right of the overall window.
1364
1365 proc treeview {w l openlevs} {
1366 global treecontents treediropen treeheight treeparent treeindex
1367
1368 set ix 0
1369 set treeindex() 0
1370 set lev 0
1371 set prefix {}
1372 set prefixend -1
1373 set prefendstack {}
1374 set htstack {}
1375 set ht 0
1376 set treecontents() {}
1377 $w conf -state normal
1378 foreach f $l {
1379 while {[string range $f 0 $prefixend] ne $prefix} {
1380 if {$lev <= $openlevs} {
1381 $w mark set e:$treeindex($prefix) "end -1c"
1382 $w mark gravity e:$treeindex($prefix) left
1383 }
1384 set treeheight($prefix) $ht
1385 incr ht [lindex $htstack end]
1386 set htstack [lreplace $htstack end end]
1387 set prefixend [lindex $prefendstack end]
1388 set prefendstack [lreplace $prefendstack end end]
1389 set prefix [string range $prefix 0 $prefixend]
1390 incr lev -1
1391 }
1392 set tail [string range $f [expr {$prefixend+1}] end]
1393 while {[set slash [string first "/" $tail]] >= 0} {
1394 lappend htstack $ht
1395 set ht 0
1396 lappend prefendstack $prefixend
1397 incr prefixend [expr {$slash + 1}]
1398 set d [string range $tail 0 $slash]
1399 lappend treecontents($prefix) $d
1400 set oldprefix $prefix
1401 append prefix $d
1402 set treecontents($prefix) {}
1403 set treeindex($prefix) [incr ix]
1404 set treeparent($prefix) $oldprefix
1405 set tail [string range $tail [expr {$slash+1}] end]
1406 if {$lev <= $openlevs} {
1407 set ht 1
1408 set treediropen($prefix) [expr {$lev < $openlevs}]
1409 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1410 $w mark set d:$ix "end -1c"
1411 $w mark gravity d:$ix left
1412 set str "\n"
1413 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1414 $w insert end $str
1415 $w image create end -align center -image $bm -padx 1 \
1416 -name a:$ix
1417 $w insert end $d [highlight_tag $prefix]
1418 $w mark set s:$ix "end -1c"
1419 $w mark gravity s:$ix left
1420 }
1421 incr lev
1422 }
1423 if {$tail ne {}} {
1424 if {$lev <= $openlevs} {
1425 incr ht
1426 set str "\n"
1427 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1428 $w insert end $str
1429 $w insert end $tail [highlight_tag $f]
1430 }
1431 lappend treecontents($prefix) $tail
1432 }
1433 }
1434 while {$htstack ne {}} {
1435 set treeheight($prefix) $ht
1436 incr ht [lindex $htstack end]
1437 set htstack [lreplace $htstack end end]
1438 set prefixend [lindex $prefendstack end]
1439 set prefendstack [lreplace $prefendstack end end]
1440 set prefix [string range $prefix 0 $prefixend]
1441 }
1442 $w conf -state disabled
1443 }
1444
1445 proc linetoelt {l} {
1446 global treeheight treecontents
1447
1448 set y 2
1449 set prefix {}
1450 while {1} {
1451 foreach e $treecontents($prefix) {
1452 if {$y == $l} {
1453 return "$prefix$e"
1454 }
1455 set n 1
1456 if {[string index $e end] eq "/"} {
1457 set n $treeheight($prefix$e)
1458 if {$y + $n > $l} {
1459 append prefix $e
1460 incr y
1461 break
1462 }
1463 }
1464 incr y $n
1465 }
1466 }
1467 }
1468
1469 proc highlight_tree {y prefix} {
1470 global treeheight treecontents cflist
1471
1472 foreach e $treecontents($prefix) {
1473 set path $prefix$e
1474 if {[highlight_tag $path] ne {}} {
1475 $cflist tag add bold $y.0 "$y.0 lineend"
1476 }
1477 incr y
1478 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1479 set y [highlight_tree $y $path]
1480 }
1481 }
1482 return $y
1483 }
1484
1485 proc treeclosedir {w dir} {
1486 global treediropen treeheight treeparent treeindex
1487
1488 set ix $treeindex($dir)
1489 $w conf -state normal
1490 $w delete s:$ix e:$ix
1491 set treediropen($dir) 0
1492 $w image configure a:$ix -image tri-rt
1493 $w conf -state disabled
1494 set n [expr {1 - $treeheight($dir)}]
1495 while {$dir ne {}} {
1496 incr treeheight($dir) $n
1497 set dir $treeparent($dir)
1498 }
1499 }
1500
1501 proc treeopendir {w dir} {
1502 global treediropen treeheight treeparent treecontents treeindex
1503
1504 set ix $treeindex($dir)
1505 $w conf -state normal
1506 $w image configure a:$ix -image tri-dn
1507 $w mark set e:$ix s:$ix
1508 $w mark gravity e:$ix right
1509 set lev 0
1510 set str "\n"
1511 set n [llength $treecontents($dir)]
1512 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1513 incr lev
1514 append str "\t"
1515 incr treeheight($x) $n
1516 }
1517 foreach e $treecontents($dir) {
1518 set de $dir$e
1519 if {[string index $e end] eq "/"} {
1520 set iy $treeindex($de)
1521 $w mark set d:$iy e:$ix
1522 $w mark gravity d:$iy left
1523 $w insert e:$ix $str
1524 set treediropen($de) 0
1525 $w image create e:$ix -align center -image tri-rt -padx 1 \
1526 -name a:$iy
1527 $w insert e:$ix $e [highlight_tag $de]
1528 $w mark set s:$iy e:$ix
1529 $w mark gravity s:$iy left
1530 set treeheight($de) 1
1531 } else {
1532 $w insert e:$ix $str
1533 $w insert e:$ix $e [highlight_tag $de]
1534 }
1535 }
1536 $w mark gravity e:$ix left
1537 $w conf -state disabled
1538 set treediropen($dir) 1
1539 set top [lindex [split [$w index @0,0] .] 0]
1540 set ht [$w cget -height]
1541 set l [lindex [split [$w index s:$ix] .] 0]
1542 if {$l < $top} {
1543 $w yview $l.0
1544 } elseif {$l + $n + 1 > $top + $ht} {
1545 set top [expr {$l + $n + 2 - $ht}]
1546 if {$l < $top} {
1547 set top $l
1548 }
1549 $w yview $top.0
1550 }
1551 }
1552
1553 proc treeclick {w x y} {
1554 global treediropen cmitmode ctext cflist cflist_top
1555
1556 if {$cmitmode ne "tree"} return
1557 if {![info exists cflist_top]} return
1558 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1559 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1560 $cflist tag add highlight $l.0 "$l.0 lineend"
1561 set cflist_top $l
1562 if {$l == 1} {
1563 $ctext yview 1.0
1564 return
1565 }
1566 set e [linetoelt $l]
1567 if {[string index $e end] ne "/"} {
1568 showfile $e
1569 } elseif {$treediropen($e)} {
1570 treeclosedir $w $e
1571 } else {
1572 treeopendir $w $e
1573 }
1574 }
1575
1576 proc setfilelist {id} {
1577 global treefilelist cflist
1578
1579 treeview $cflist $treefilelist($id) 0
1580 }
1581
1582 image create bitmap tri-rt -background black -foreground blue -data {
1583 #define tri-rt_width 13
1584 #define tri-rt_height 13
1585 static unsigned char tri-rt_bits[] = {
1586 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1587 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1588 0x00, 0x00};
1589 } -maskdata {
1590 #define tri-rt-mask_width 13
1591 #define tri-rt-mask_height 13
1592 static unsigned char tri-rt-mask_bits[] = {
1593 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1594 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1595 0x08, 0x00};
1596 }
1597 image create bitmap tri-dn -background black -foreground blue -data {
1598 #define tri-dn_width 13
1599 #define tri-dn_height 13
1600 static unsigned char tri-dn_bits[] = {
1601 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1602 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1603 0x00, 0x00};
1604 } -maskdata {
1605 #define tri-dn-mask_width 13
1606 #define tri-dn-mask_height 13
1607 static unsigned char tri-dn-mask_bits[] = {
1608 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1609 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1610 0x00, 0x00};
1611 }
1612
1613 image create bitmap reficon-T -background black -foreground yellow -data {
1614 #define tagicon_width 13
1615 #define tagicon_height 9
1616 static unsigned char tagicon_bits[] = {
1617 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1618 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1619 } -maskdata {
1620 #define tagicon-mask_width 13
1621 #define tagicon-mask_height 9
1622 static unsigned char tagicon-mask_bits[] = {
1623 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1624 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1625 }
1626 set rectdata {
1627 #define headicon_width 13
1628 #define headicon_height 9
1629 static unsigned char headicon_bits[] = {
1630 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1631 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1632 }
1633 set rectmask {
1634 #define headicon-mask_width 13
1635 #define headicon-mask_height 9
1636 static unsigned char headicon-mask_bits[] = {
1637 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1638 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1639 }
1640 image create bitmap reficon-H -background black -foreground green \
1641 -data $rectdata -maskdata $rectmask
1642 image create bitmap reficon-o -background black -foreground "#ddddff" \
1643 -data $rectdata -maskdata $rectmask
1644
1645 proc init_flist {first} {
1646 global cflist cflist_top selectedline difffilestart
1647
1648 $cflist conf -state normal
1649 $cflist delete 0.0 end
1650 if {$first ne {}} {
1651 $cflist insert end $first
1652 set cflist_top 1
1653 $cflist tag add highlight 1.0 "1.0 lineend"
1654 } else {
1655 catch {unset cflist_top}
1656 }
1657 $cflist conf -state disabled
1658 set difffilestart {}
1659 }
1660
1661 proc highlight_tag {f} {
1662 global highlight_paths
1663
1664 foreach p $highlight_paths {
1665 if {[string match $p $f]} {
1666 return "bold"
1667 }
1668 }
1669 return {}
1670 }
1671
1672 proc highlight_filelist {} {
1673 global cmitmode cflist
1674
1675 $cflist conf -state normal
1676 if {$cmitmode ne "tree"} {
1677 set end [lindex [split [$cflist index end] .] 0]
1678 for {set l 2} {$l < $end} {incr l} {
1679 set line [$cflist get $l.0 "$l.0 lineend"]
1680 if {[highlight_tag $line] ne {}} {
1681 $cflist tag add bold $l.0 "$l.0 lineend"
1682 }
1683 }
1684 } else {
1685 highlight_tree 2 {}
1686 }
1687 $cflist conf -state disabled
1688 }
1689
1690 proc unhighlight_filelist {} {
1691 global cflist
1692
1693 $cflist conf -state normal
1694 $cflist tag remove bold 1.0 end
1695 $cflist conf -state disabled
1696 }
1697
1698 proc add_flist {fl} {
1699 global cflist
1700
1701 $cflist conf -state normal
1702 foreach f $fl {
1703 $cflist insert end "\n"
1704 $cflist insert end $f [highlight_tag $f]
1705 }
1706 $cflist conf -state disabled
1707 }
1708
1709 proc sel_flist {w x y} {
1710 global ctext difffilestart cflist cflist_top cmitmode
1711
1712 if {$cmitmode eq "tree"} return
1713 if {![info exists cflist_top]} return
1714 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1715 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1716 $cflist tag add highlight $l.0 "$l.0 lineend"
1717 set cflist_top $l
1718 if {$l == 1} {
1719 $ctext yview 1.0
1720 } else {
1721 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1722 }
1723 }
1724
1725 proc pop_flist_menu {w X Y x y} {
1726 global ctext cflist cmitmode flist_menu flist_menu_file
1727 global treediffs diffids
1728
1729 stopfinding
1730 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1731 if {$l <= 1} return
1732 if {$cmitmode eq "tree"} {
1733 set e [linetoelt $l]
1734 if {[string index $e end] eq "/"} return
1735 } else {
1736 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1737 }
1738 set flist_menu_file $e
1739 tk_popup $flist_menu $X $Y
1740 }
1741
1742 proc flist_hl {only} {
1743 global flist_menu_file findstring gdttype
1744
1745 set x [shellquote $flist_menu_file]
1746 if {$only || $findstring eq {} || $gdttype ne "touching paths:"} {
1747 set findstring $x
1748 } else {
1749 append findstring " " $x
1750 }
1751 set gdttype "touching paths:"
1752 }
1753
1754 # Functions for adding and removing shell-type quoting
1755
1756 proc shellquote {str} {
1757 if {![string match "*\['\"\\ \t]*" $str]} {
1758 return $str
1759 }
1760 if {![string match "*\['\"\\]*" $str]} {
1761 return "\"$str\""
1762 }
1763 if {![string match "*'*" $str]} {
1764 return "'$str'"
1765 }
1766 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1767 }
1768
1769 proc shellarglist {l} {
1770 set str {}
1771 foreach a $l {
1772 if {$str ne {}} {
1773 append str " "
1774 }
1775 append str [shellquote $a]
1776 }
1777 return $str
1778 }
1779
1780 proc shelldequote {str} {
1781 set ret {}
1782 set used -1
1783 while {1} {
1784 incr used
1785 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1786 append ret [string range $str $used end]
1787 set used [string length $str]
1788 break
1789 }
1790 set first [lindex $first 0]
1791 set ch [string index $str $first]
1792 if {$first > $used} {
1793 append ret [string range $str $used [expr {$first - 1}]]
1794 set used $first
1795 }
1796 if {$ch eq " " || $ch eq "\t"} break
1797 incr used
1798 if {$ch eq "'"} {
1799 set first [string first "'" $str $used]
1800 if {$first < 0} {
1801 error "unmatched single-quote"
1802 }
1803 append ret [string range $str $used [expr {$first - 1}]]
1804 set used $first
1805 continue
1806 }
1807 if {$ch eq "\\"} {
1808 if {$used >= [string length $str]} {
1809 error "trailing backslash"
1810 }
1811 append ret [string index $str $used]
1812 continue
1813 }
1814 # here ch == "\""
1815 while {1} {
1816 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1817 error "unmatched double-quote"
1818 }
1819 set first [lindex $first 0]
1820 set ch [string index $str $first]
1821 if {$first > $used} {
1822 append ret [string range $str $used [expr {$first - 1}]]
1823 set used $first
1824 }
1825 if {$ch eq "\""} break
1826 incr used
1827 append ret [string index $str $used]
1828 incr used
1829 }
1830 }
1831 return [list $used $ret]
1832 }
1833
1834 proc shellsplit {str} {
1835 set l {}
1836 while {1} {
1837 set str [string trimleft $str]
1838 if {$str eq {}} break
1839 set dq [shelldequote $str]
1840 set n [lindex $dq 0]
1841 set word [lindex $dq 1]
1842 set str [string range $str $n end]
1843 lappend l $word
1844 }
1845 return $l
1846 }
1847
1848 # Code to implement multiple views
1849
1850 proc newview {ishighlight} {
1851 global nextviewnum newviewname newviewperm uifont newishighlight
1852 global newviewargs revtreeargs
1853
1854 set newishighlight $ishighlight
1855 set top .gitkview
1856 if {[winfo exists $top]} {
1857 raise $top
1858 return
1859 }
1860 set newviewname($nextviewnum) "View $nextviewnum"
1861 set newviewperm($nextviewnum) 0
1862 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1863 vieweditor $top $nextviewnum "Gitk view definition"
1864 }
1865
1866 proc editview {} {
1867 global curview
1868 global viewname viewperm newviewname newviewperm
1869 global viewargs newviewargs
1870
1871 set top .gitkvedit-$curview
1872 if {[winfo exists $top]} {
1873 raise $top
1874 return
1875 }
1876 set newviewname($curview) $viewname($curview)
1877 set newviewperm($curview) $viewperm($curview)
1878 set newviewargs($curview) [shellarglist $viewargs($curview)]
1879 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1880 }
1881
1882 proc vieweditor {top n title} {
1883 global newviewname newviewperm viewfiles
1884 global uifont
1885
1886 toplevel $top
1887 wm title $top $title
1888 label $top.nl -text "Name" -font uifont
1889 entry $top.name -width 20 -textvariable newviewname($n) -font uifont
1890 grid $top.nl $top.name -sticky w -pady 5
1891 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1892 -font uifont
1893 grid $top.perm - -pady 5 -sticky w
1894 message $top.al -aspect 1000 -font uifont \
1895 -text "Commits to include (arguments to git rev-list):"
1896 grid $top.al - -sticky w -pady 5
1897 entry $top.args -width 50 -textvariable newviewargs($n) \
1898 -background white -font uifont
1899 grid $top.args - -sticky ew -padx 5
1900 message $top.l -aspect 1000 -font uifont \
1901 -text "Enter files and directories to include, one per line:"
1902 grid $top.l - -sticky w
1903 text $top.t -width 40 -height 10 -background white -font uifont
1904 if {[info exists viewfiles($n)]} {
1905 foreach f $viewfiles($n) {
1906 $top.t insert end $f
1907 $top.t insert end "\n"
1908 }
1909 $top.t delete {end - 1c} end
1910 $top.t mark set insert 0.0
1911 }
1912 grid $top.t - -sticky ew -padx 5
1913 frame $top.buts
1914 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1915 -font uifont
1916 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1917 -font uifont
1918 grid $top.buts.ok $top.buts.can
1919 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1920 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1921 grid $top.buts - -pady 10 -sticky ew
1922 focus $top.t
1923 }
1924
1925 proc doviewmenu {m first cmd op argv} {
1926 set nmenu [$m index end]
1927 for {set i $first} {$i <= $nmenu} {incr i} {
1928 if {[$m entrycget $i -command] eq $cmd} {
1929 eval $m $op $i $argv
1930 break
1931 }
1932 }
1933 }
1934
1935 proc allviewmenus {n op args} {
1936 # global viewhlmenu
1937
1938 doviewmenu .bar.view 5 [list showview $n] $op $args
1939 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1940 }
1941
1942 proc newviewok {top n} {
1943 global nextviewnum newviewperm newviewname newishighlight
1944 global viewname viewfiles viewperm selectedview curview
1945 global viewargs newviewargs viewhlmenu
1946
1947 if {[catch {
1948 set newargs [shellsplit $newviewargs($n)]
1949 } err]} {
1950 error_popup "Error in commit selection arguments: $err"
1951 wm raise $top
1952 focus $top
1953 return
1954 }
1955 set files {}
1956 foreach f [split [$top.t get 0.0 end] "\n"] {
1957 set ft [string trim $f]
1958 if {$ft ne {}} {
1959 lappend files $ft
1960 }
1961 }
1962 if {![info exists viewfiles($n)]} {
1963 # creating a new view
1964 incr nextviewnum
1965 set viewname($n) $newviewname($n)
1966 set viewperm($n) $newviewperm($n)
1967 set viewfiles($n) $files
1968 set viewargs($n) $newargs
1969 addviewmenu $n
1970 if {!$newishighlight} {
1971 run showview $n
1972 } else {
1973 run addvhighlight $n
1974 }
1975 } else {
1976 # editing an existing view
1977 set viewperm($n) $newviewperm($n)
1978 if {$newviewname($n) ne $viewname($n)} {
1979 set viewname($n) $newviewname($n)
1980 doviewmenu .bar.view 5 [list showview $n] \
1981 entryconf [list -label $viewname($n)]
1982 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1983 # entryconf [list -label $viewname($n) -value $viewname($n)]
1984 }
1985 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1986 set viewfiles($n) $files
1987 set viewargs($n) $newargs
1988 if {$curview == $n} {
1989 run updatecommits
1990 }
1991 }
1992 }
1993 catch {destroy $top}
1994 }
1995
1996 proc delview {} {
1997 global curview viewdata viewperm hlview selectedhlview
1998
1999 if {$curview == 0} return
2000 if {[info exists hlview] && $hlview == $curview} {
2001 set selectedhlview None
2002 unset hlview
2003 }
2004 allviewmenus $curview delete
2005 set viewdata($curview) {}
2006 set viewperm($curview) 0
2007 showview 0
2008 }
2009
2010 proc addviewmenu {n} {
2011 global viewname viewhlmenu
2012
2013 .bar.view add radiobutton -label $viewname($n) \
2014 -command [list showview $n] -variable selectedview -value $n
2015 #$viewhlmenu add radiobutton -label $viewname($n) \
2016 # -command [list addvhighlight $n] -variable selectedhlview
2017 }
2018
2019 proc flatten {var} {
2020 global $var
2021
2022 set ret {}
2023 foreach i [array names $var] {
2024 lappend ret $i [set $var\($i\)]
2025 }
2026 return $ret
2027 }
2028
2029 proc unflatten {var l} {
2030 global $var
2031
2032 catch {unset $var}
2033 foreach {i v} $l {
2034 set $var\($i\) $v
2035 }
2036 }
2037
2038 proc showview {n} {
2039 global curview viewdata viewfiles
2040 global displayorder parentlist rowidlist rowisopt rowfinal
2041 global colormap rowtextx commitrow nextcolor canvxmax
2042 global numcommits commitlisted
2043 global selectedline currentid canv canvy0
2044 global treediffs
2045 global pending_select phase
2046 global commitidx
2047 global commfd
2048 global selectedview selectfirst
2049 global vparentlist vdisporder vcmitlisted
2050 global hlview selectedhlview commitinterest
2051
2052 if {$n == $curview} return
2053 set selid {}
2054 if {[info exists selectedline]} {
2055 set selid $currentid
2056 set y [yc $selectedline]
2057 set ymax [lindex [$canv cget -scrollregion] 3]
2058 set span [$canv yview]
2059 set ytop [expr {[lindex $span 0] * $ymax}]
2060 set ybot [expr {[lindex $span 1] * $ymax}]
2061 if {$ytop < $y && $y < $ybot} {
2062 set yscreen [expr {$y - $ytop}]
2063 } else {
2064 set yscreen [expr {($ybot - $ytop) / 2}]
2065 }
2066 } elseif {[info exists pending_select]} {
2067 set selid $pending_select
2068 unset pending_select
2069 }
2070 unselectline
2071 normalline
2072 if {$curview >= 0} {
2073 set vparentlist($curview) $parentlist
2074 set vdisporder($curview) $displayorder
2075 set vcmitlisted($curview) $commitlisted
2076 if {$phase ne {} ||
2077 ![info exists viewdata($curview)] ||
2078 [lindex $viewdata($curview) 0] ne {}} {
2079 set viewdata($curview) \
2080 [list $phase $rowidlist $rowisopt $rowfinal]
2081 }
2082 }
2083 catch {unset treediffs}
2084 clear_display
2085 if {[info exists hlview] && $hlview == $n} {
2086 unset hlview
2087 set selectedhlview None
2088 }
2089 catch {unset commitinterest}
2090
2091 set curview $n
2092 set selectedview $n
2093 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2094 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2095
2096 run refill_reflist
2097 if {![info exists viewdata($n)]} {
2098 if {$selid ne {}} {
2099 set pending_select $selid
2100 }
2101 getcommits
2102 return
2103 }
2104
2105 set v $viewdata($n)
2106 set phase [lindex $v 0]
2107 set displayorder $vdisporder($n)
2108 set parentlist $vparentlist($n)
2109 set commitlisted $vcmitlisted($n)
2110 set rowidlist [lindex $v 1]
2111 set rowisopt [lindex $v 2]
2112 set rowfinal [lindex $v 3]
2113 set numcommits $commitidx($n)
2114
2115 catch {unset colormap}
2116 catch {unset rowtextx}
2117 set nextcolor 0
2118 set canvxmax [$canv cget -width]
2119 set curview $n
2120 set row 0
2121 setcanvscroll
2122 set yf 0
2123 set row {}
2124 set selectfirst 0
2125 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2126 set row $commitrow($n,$selid)
2127 # try to get the selected row in the same position on the screen
2128 set ymax [lindex [$canv cget -scrollregion] 3]
2129 set ytop [expr {[yc $row] - $yscreen}]
2130 if {$ytop < 0} {
2131 set ytop 0
2132 }
2133 set yf [expr {$ytop * 1.0 / $ymax}]
2134 }
2135 allcanvs yview moveto $yf
2136 drawvisible
2137 if {$row ne {}} {
2138 selectline $row 0
2139 } elseif {$selid ne {}} {
2140 set pending_select $selid
2141 } else {
2142 set row [first_real_row]
2143 if {$row < $numcommits} {
2144 selectline $row 0
2145 } else {
2146 set selectfirst 1
2147 }
2148 }
2149 if {$phase ne {}} {
2150 if {$phase eq "getcommits"} {
2151 show_status "Reading commits..."
2152 }
2153 run chewcommits $n
2154 } elseif {$numcommits == 0} {
2155 show_status "No commits selected"
2156 }
2157 }
2158
2159 # Stuff relating to the highlighting facility
2160
2161 proc ishighlighted {row} {
2162 global vhighlights fhighlights nhighlights rhighlights
2163
2164 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2165 return $nhighlights($row)
2166 }
2167 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2168 return $vhighlights($row)
2169 }
2170 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2171 return $fhighlights($row)
2172 }
2173 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2174 return $rhighlights($row)
2175 }
2176 return 0
2177 }
2178
2179 proc bolden {row font} {
2180 global canv linehtag selectedline boldrows
2181
2182 lappend boldrows $row
2183 $canv itemconf $linehtag($row) -font $font
2184 if {[info exists selectedline] && $row == $selectedline} {
2185 $canv delete secsel
2186 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2187 -outline {{}} -tags secsel \
2188 -fill [$canv cget -selectbackground]]
2189 $canv lower $t
2190 }
2191 }
2192
2193 proc bolden_name {row font} {
2194 global canv2 linentag selectedline boldnamerows
2195
2196 lappend boldnamerows $row
2197 $canv2 itemconf $linentag($row) -font $font
2198 if {[info exists selectedline] && $row == $selectedline} {
2199 $canv2 delete secsel
2200 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2201 -outline {{}} -tags secsel \
2202 -fill [$canv2 cget -selectbackground]]
2203 $canv2 lower $t
2204 }
2205 }
2206
2207 proc unbolden {} {
2208 global boldrows
2209
2210 set stillbold {}
2211 foreach row $boldrows {
2212 if {![ishighlighted $row]} {
2213 bolden $row mainfont
2214 } else {
2215 lappend stillbold $row
2216 }
2217 }
2218 set boldrows $stillbold
2219 }
2220
2221 proc addvhighlight {n} {
2222 global hlview curview viewdata vhl_done vhighlights commitidx
2223
2224 if {[info exists hlview]} {
2225 delvhighlight
2226 }
2227 set hlview $n
2228 if {$n != $curview && ![info exists viewdata($n)]} {
2229 set viewdata($n) [list getcommits {{}} 0 0 0]
2230 set vparentlist($n) {}
2231 set vdisporder($n) {}
2232 set vcmitlisted($n) {}
2233 start_rev_list $n
2234 }
2235 set vhl_done $commitidx($hlview)
2236 if {$vhl_done > 0} {
2237 drawvisible
2238 }
2239 }
2240
2241 proc delvhighlight {} {
2242 global hlview vhighlights
2243
2244 if {![info exists hlview]} return
2245 unset hlview
2246 catch {unset vhighlights}
2247 unbolden
2248 }
2249
2250 proc vhighlightmore {} {
2251 global hlview vhl_done commitidx vhighlights
2252 global displayorder vdisporder curview
2253
2254 set max $commitidx($hlview)
2255 if {$hlview == $curview} {
2256 set disp $displayorder
2257 } else {
2258 set disp $vdisporder($hlview)
2259 }
2260 set vr [visiblerows]
2261 set r0 [lindex $vr 0]
2262 set r1 [lindex $vr 1]
2263 for {set i $vhl_done} {$i < $max} {incr i} {
2264 set id [lindex $disp $i]
2265 if {[info exists commitrow($curview,$id)]} {
2266 set row $commitrow($curview,$id)
2267 if {$r0 <= $row && $row <= $r1} {
2268 if {![highlighted $row]} {
2269 bolden $row mainfontbold
2270 }
2271 set vhighlights($row) 1
2272 }
2273 }
2274 }
2275 set vhl_done $max
2276 }
2277
2278 proc askvhighlight {row id} {
2279 global hlview vhighlights commitrow iddrawn
2280
2281 if {[info exists commitrow($hlview,$id)]} {
2282 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2283 bolden $row mainfontbold
2284 }
2285 set vhighlights($row) 1
2286 } else {
2287 set vhighlights($row) 0
2288 }
2289 }
2290
2291 proc hfiles_change {} {
2292 global highlight_files filehighlight fhighlights fh_serial
2293 global highlight_paths gdttype
2294
2295 if {[info exists filehighlight]} {
2296 # delete previous highlights
2297 catch {close $filehighlight}
2298 unset filehighlight
2299 catch {unset fhighlights}
2300 unbolden
2301 unhighlight_filelist
2302 }
2303 set highlight_paths {}
2304 after cancel do_file_hl $fh_serial
2305 incr fh_serial
2306 if {$highlight_files ne {}} {
2307 after 300 do_file_hl $fh_serial
2308 }
2309 }
2310
2311 proc gdttype_change {name ix op} {
2312 global gdttype highlight_files findstring findpattern
2313
2314 stopfinding
2315 if {$findstring ne {}} {
2316 if {$gdttype eq "containing:"} {
2317 if {$highlight_files ne {}} {
2318 set highlight_files {}
2319 hfiles_change
2320 }
2321 findcom_change
2322 } else {
2323 if {$findpattern ne {}} {
2324 set findpattern {}
2325 findcom_change
2326 }
2327 set highlight_files $findstring
2328 hfiles_change
2329 }
2330 drawvisible
2331 }
2332 # enable/disable findtype/findloc menus too
2333 }
2334
2335 proc find_change {name ix op} {
2336 global gdttype findstring highlight_files
2337
2338 stopfinding
2339 if {$gdttype eq "containing:"} {
2340 findcom_change
2341 } else {
2342 if {$highlight_files ne $findstring} {
2343 set highlight_files $findstring
2344 hfiles_change
2345 }
2346 }
2347 drawvisible
2348 }
2349
2350 proc findcom_change args {
2351 global nhighlights boldnamerows
2352 global findpattern findtype findstring gdttype
2353
2354 stopfinding
2355 # delete previous highlights, if any
2356 foreach row $boldnamerows {
2357 bolden_name $row mainfont
2358 }
2359 set boldnamerows {}
2360 catch {unset nhighlights}
2361 unbolden
2362 unmarkmatches
2363 if {$gdttype ne "containing:" || $findstring eq {}} {
2364 set findpattern {}
2365 } elseif {$findtype eq "Regexp"} {
2366 set findpattern $findstring
2367 } else {
2368 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2369 $findstring]
2370 set findpattern "*$e*"
2371 }
2372 }
2373
2374 proc makepatterns {l} {
2375 set ret {}
2376 foreach e $l {
2377 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2378 if {[string index $ee end] eq "/"} {
2379 lappend ret "$ee*"
2380 } else {
2381 lappend ret $ee
2382 lappend ret "$ee/*"
2383 }
2384 }
2385 return $ret
2386 }
2387
2388 proc do_file_hl {serial} {
2389 global highlight_files filehighlight highlight_paths gdttype fhl_list
2390
2391 if {$gdttype eq "touching paths:"} {
2392 if {[catch {set paths [shellsplit $highlight_files]}]} return
2393 set highlight_paths [makepatterns $paths]
2394 highlight_filelist
2395 set gdtargs [concat -- $paths]
2396 } elseif {$gdttype eq "adding/removing string:"} {
2397 set gdtargs [list "-S$highlight_files"]
2398 } else {
2399 # must be "containing:", i.e. we're searching commit info
2400 return
2401 }
2402 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2403 set filehighlight [open $cmd r+]
2404 fconfigure $filehighlight -blocking 0
2405 filerun $filehighlight readfhighlight
2406 set fhl_list {}
2407 drawvisible
2408 flushhighlights
2409 }
2410
2411 proc flushhighlights {} {
2412 global filehighlight fhl_list
2413
2414 if {[info exists filehighlight]} {
2415 lappend fhl_list {}
2416 puts $filehighlight ""
2417 flush $filehighlight
2418 }
2419 }
2420
2421 proc askfilehighlight {row id} {
2422 global filehighlight fhighlights fhl_list
2423
2424 lappend fhl_list $id
2425 set fhighlights($row) -1
2426 puts $filehighlight $id
2427 }
2428
2429 proc readfhighlight {} {
2430 global filehighlight fhighlights commitrow curview iddrawn
2431 global fhl_list find_dirn
2432
2433 if {![info exists filehighlight]} {
2434 return 0
2435 }
2436 set nr 0
2437 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2438 set line [string trim $line]
2439 set i [lsearch -exact $fhl_list $line]
2440 if {$i < 0} continue
2441 for {set j 0} {$j < $i} {incr j} {
2442 set id [lindex $fhl_list $j]
2443 if {[info exists commitrow($curview,$id)]} {
2444 set fhighlights($commitrow($curview,$id)) 0
2445 }
2446 }
2447 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2448 if {$line eq {}} continue
2449 if {![info exists commitrow($curview,$line)]} continue
2450 set row $commitrow($curview,$line)
2451 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2452 bolden $row mainfontbold
2453 }
2454 set fhighlights($row) 1
2455 }
2456 if {[eof $filehighlight]} {
2457 # strange...
2458 puts "oops, git diff-tree died"
2459 catch {close $filehighlight}
2460 unset filehighlight
2461 return 0
2462 }
2463 if {[info exists find_dirn]} {
2464 run findmore
2465 }
2466 return 1
2467 }
2468
2469 proc doesmatch {f} {
2470 global findtype findpattern
2471
2472 if {$findtype eq "Regexp"} {
2473 return [regexp $findpattern $f]
2474 } elseif {$findtype eq "IgnCase"} {
2475 return [string match -nocase $findpattern $f]
2476 } else {
2477 return [string match $findpattern $f]
2478 }
2479 }
2480
2481 proc askfindhighlight {row id} {
2482 global nhighlights commitinfo iddrawn
2483 global findloc
2484 global markingmatches
2485
2486 if {![info exists commitinfo($id)]} {
2487 getcommit $id
2488 }
2489 set info $commitinfo($id)
2490 set isbold 0
2491 set fldtypes {Headline Author Date Committer CDate Comments}
2492 foreach f $info ty $fldtypes {
2493 if {($findloc eq "All fields" || $findloc eq $ty) &&
2494 [doesmatch $f]} {
2495 if {$ty eq "Author"} {
2496 set isbold 2
2497 break
2498 }
2499 set isbold 1
2500 }
2501 }
2502 if {$isbold && [info exists iddrawn($id)]} {
2503 if {![ishighlighted $row]} {
2504 bolden $row mainfontbold
2505 if {$isbold > 1} {
2506 bolden_name $row mainfontbold
2507 }
2508 }
2509 if {$markingmatches} {
2510 markrowmatches $row $id
2511 }
2512 }
2513 set nhighlights($row) $isbold
2514 }
2515
2516 proc markrowmatches {row id} {
2517 global canv canv2 linehtag linentag commitinfo findloc
2518
2519 set headline [lindex $commitinfo($id) 0]
2520 set author [lindex $commitinfo($id) 1]
2521 $canv delete match$row
2522 $canv2 delete match$row
2523 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2524 set m [findmatches $headline]
2525 if {$m ne {}} {
2526 markmatches $canv $row $headline $linehtag($row) $m \
2527 [$canv itemcget $linehtag($row) -font] $row
2528 }
2529 }
2530 if {$findloc eq "All fields" || $findloc eq "Author"} {
2531 set m [findmatches $author]
2532 if {$m ne {}} {
2533 markmatches $canv2 $row $author $linentag($row) $m \
2534 [$canv2 itemcget $linentag($row) -font] $row
2535 }
2536 }
2537 }
2538
2539 proc vrel_change {name ix op} {
2540 global highlight_related
2541
2542 rhighlight_none
2543 if {$highlight_related ne "None"} {
2544 run drawvisible
2545 }
2546 }
2547
2548 # prepare for testing whether commits are descendents or ancestors of a
2549 proc rhighlight_sel {a} {
2550 global descendent desc_todo ancestor anc_todo
2551 global highlight_related rhighlights
2552
2553 catch {unset descendent}
2554 set desc_todo [list $a]
2555 catch {unset ancestor}
2556 set anc_todo [list $a]
2557 if {$highlight_related ne "None"} {
2558 rhighlight_none
2559 run drawvisible
2560 }
2561 }
2562
2563 proc rhighlight_none {} {
2564 global rhighlights
2565
2566 catch {unset rhighlights}
2567 unbolden
2568 }
2569
2570 proc is_descendent {a} {
2571 global curview children commitrow descendent desc_todo
2572
2573 set v $curview
2574 set la $commitrow($v,$a)
2575 set todo $desc_todo
2576 set leftover {}
2577 set done 0
2578 for {set i 0} {$i < [llength $todo]} {incr i} {
2579 set do [lindex $todo $i]
2580 if {$commitrow($v,$do) < $la} {
2581 lappend leftover $do
2582 continue
2583 }
2584 foreach nk $children($v,$do) {
2585 if {![info exists descendent($nk)]} {
2586 set descendent($nk) 1
2587 lappend todo $nk
2588 if {$nk eq $a} {
2589 set done 1
2590 }
2591 }
2592 }
2593 if {$done} {
2594 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2595 return
2596 }
2597 }
2598 set descendent($a) 0
2599 set desc_todo $leftover
2600 }
2601
2602 proc is_ancestor {a} {
2603 global curview parentlist commitrow ancestor anc_todo
2604
2605 set v $curview
2606 set la $commitrow($v,$a)
2607 set todo $anc_todo
2608 set leftover {}
2609 set done 0
2610 for {set i 0} {$i < [llength $todo]} {incr i} {
2611 set do [lindex $todo $i]
2612 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2613 lappend leftover $do
2614 continue
2615 }
2616 foreach np [lindex $parentlist $commitrow($v,$do)] {
2617 if {![info exists ancestor($np)]} {
2618 set ancestor($np) 1
2619 lappend todo $np
2620 if {$np eq $a} {
2621 set done 1
2622 }
2623 }
2624 }
2625 if {$done} {
2626 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2627 return
2628 }
2629 }
2630 set ancestor($a) 0
2631 set anc_todo $leftover
2632 }
2633
2634 proc askrelhighlight {row id} {
2635 global descendent highlight_related iddrawn rhighlights
2636 global selectedline ancestor
2637
2638 if {![info exists selectedline]} return
2639 set isbold 0
2640 if {$highlight_related eq "Descendent" ||
2641 $highlight_related eq "Not descendent"} {
2642 if {![info exists descendent($id)]} {
2643 is_descendent $id
2644 }
2645 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2646 set isbold 1
2647 }
2648 } elseif {$highlight_related eq "Ancestor" ||
2649 $highlight_related eq "Not ancestor"} {
2650 if {![info exists ancestor($id)]} {
2651 is_ancestor $id
2652 }
2653 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2654 set isbold 1
2655 }
2656 }
2657 if {[info exists iddrawn($id)]} {
2658 if {$isbold && ![ishighlighted $row]} {
2659 bolden $row mainfontbold
2660 }
2661 }
2662 set rhighlights($row) $isbold
2663 }
2664
2665 # Graph layout functions
2666
2667 proc shortids {ids} {
2668 set res {}
2669 foreach id $ids {
2670 if {[llength $id] > 1} {
2671 lappend res [shortids $id]
2672 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2673 lappend res [string range $id 0 7]
2674 } else {
2675 lappend res $id
2676 }
2677 }
2678 return $res
2679 }
2680
2681 proc ntimes {n o} {
2682 set ret {}
2683 set o [list $o]
2684 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2685 if {($n & $mask) != 0} {
2686 set ret [concat $ret $o]
2687 }
2688 set o [concat $o $o]
2689 }
2690 return $ret
2691 }
2692
2693 # Work out where id should go in idlist so that order-token
2694 # values increase from left to right
2695 proc idcol {idlist id {i 0}} {
2696 global ordertok curview
2697
2698 set t $ordertok($curview,$id)
2699 if {$i >= [llength $idlist] ||
2700 $t < $ordertok($curview,[lindex $idlist $i])} {
2701 if {$i > [llength $idlist]} {
2702 set i [llength $idlist]
2703 }
2704 while {[incr i -1] >= 0 &&
2705 $t < $ordertok($curview,[lindex $idlist $i])} {}
2706 incr i
2707 } else {
2708 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2709 while {[incr i] < [llength $idlist] &&
2710 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2711 }
2712 }
2713 return $i
2714 }
2715
2716 proc initlayout {} {
2717 global rowidlist rowisopt rowfinal displayorder commitlisted
2718 global numcommits canvxmax canv
2719 global nextcolor
2720 global parentlist
2721 global colormap rowtextx
2722 global selectfirst
2723
2724 set numcommits 0
2725 set displayorder {}
2726 set commitlisted {}
2727 set parentlist {}
2728 set nextcolor 0
2729 set rowidlist {}
2730 set rowisopt {}
2731 set rowfinal {}
2732 set canvxmax [$canv cget -width]
2733 catch {unset colormap}
2734 catch {unset rowtextx}
2735 set selectfirst 1
2736 }
2737
2738 proc setcanvscroll {} {
2739 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2740
2741 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2742 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2743 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2744 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2745 }
2746
2747 proc visiblerows {} {
2748 global canv numcommits linespc
2749
2750 set ymax [lindex [$canv cget -scrollregion] 3]
2751 if {$ymax eq {} || $ymax == 0} return
2752 set f [$canv yview]
2753 set y0 [expr {int([lindex $f 0] * $ymax)}]
2754 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2755 if {$r0 < 0} {
2756 set r0 0
2757 }
2758 set y1 [expr {int([lindex $f 1] * $ymax)}]
2759 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2760 if {$r1 >= $numcommits} {
2761 set r1 [expr {$numcommits - 1}]
2762 }
2763 return [list $r0 $r1]
2764 }
2765
2766 proc layoutmore {} {
2767 global commitidx viewcomplete numcommits
2768 global uparrowlen downarrowlen mingaplen curview
2769
2770 set show $commitidx($curview)
2771 if {$show > $numcommits || $viewcomplete($curview)} {
2772 showstuff $show $viewcomplete($curview)
2773 }
2774 }
2775
2776 proc showstuff {canshow last} {
2777 global numcommits commitrow pending_select selectedline curview
2778 global mainheadid displayorder selectfirst
2779 global lastscrollset commitinterest
2780
2781 if {$numcommits == 0} {
2782 global phase
2783 set phase "incrdraw"
2784 allcanvs delete all
2785 }
2786 set r0 $numcommits
2787 set prev $numcommits
2788 set numcommits $canshow
2789 set t [clock clicks -milliseconds]
2790 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2791 set lastscrollset $t
2792 setcanvscroll
2793 }
2794 set rows [visiblerows]
2795 set r1 [lindex $rows 1]
2796 if {$r1 >= $canshow} {
2797 set r1 [expr {$canshow - 1}]
2798 }
2799 if {$r0 <= $r1} {
2800 drawcommits $r0 $r1
2801 }
2802 if {[info exists pending_select] &&
2803 [info exists commitrow($curview,$pending_select)] &&
2804 $commitrow($curview,$pending_select) < $numcommits} {
2805 selectline $commitrow($curview,$pending_select) 1
2806 }
2807 if {$selectfirst} {
2808 if {[info exists selectedline] || [info exists pending_select]} {
2809 set selectfirst 0
2810 } else {
2811 set l [first_real_row]
2812 selectline $l 1
2813 set selectfirst 0
2814 }
2815 }
2816 }
2817
2818 proc doshowlocalchanges {} {
2819 global curview mainheadid phase commitrow
2820
2821 if {[info exists commitrow($curview,$mainheadid)] &&
2822 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2823 dodiffindex
2824 } elseif {$phase ne {}} {
2825 lappend commitinterest($mainheadid) {}
2826 }
2827 }
2828
2829 proc dohidelocalchanges {} {
2830 global localfrow localirow lserial
2831
2832 if {$localfrow >= 0} {
2833 removerow $localfrow
2834 set localfrow -1
2835 if {$localirow > 0} {
2836 incr localirow -1
2837 }
2838 }
2839 if {$localirow >= 0} {
2840 removerow $localirow
2841 set localirow -1
2842 }
2843 incr lserial
2844 }
2845
2846 # spawn off a process to do git diff-index --cached HEAD
2847 proc dodiffindex {} {
2848 global localirow localfrow lserial showlocalchanges
2849
2850 if {!$showlocalchanges} return
2851 incr lserial
2852 set localfrow -1
2853 set localirow -1
2854 set fd [open "|git diff-index --cached HEAD" r]
2855 fconfigure $fd -blocking 0
2856 filerun $fd [list readdiffindex $fd $lserial]
2857 }
2858
2859 proc readdiffindex {fd serial} {
2860 global localirow commitrow mainheadid nullid2 curview
2861 global commitinfo commitdata lserial
2862
2863 set isdiff 1
2864 if {[gets $fd line] < 0} {
2865 if {![eof $fd]} {
2866 return 1
2867 }
2868 set isdiff 0
2869 }
2870 # we only need to see one line and we don't really care what it says...
2871 close $fd
2872
2873 # now see if there are any local changes not checked in to the index
2874 if {$serial == $lserial} {
2875 set fd [open "|git diff-files" r]
2876 fconfigure $fd -blocking 0
2877 filerun $fd [list readdifffiles $fd $serial]
2878 }
2879
2880 if {$isdiff && $serial == $lserial && $localirow == -1} {
2881 # add the line for the changes in the index to the graph
2882 set localirow $commitrow($curview,$mainheadid)
2883 set hl "Local changes checked in to index but not committed"
2884 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2885 set commitdata($nullid2) "\n $hl\n"
2886 insertrow $localirow $nullid2
2887 }
2888 return 0
2889 }
2890
2891 proc readdifffiles {fd serial} {
2892 global localirow localfrow commitrow mainheadid nullid curview
2893 global commitinfo commitdata lserial
2894
2895 set isdiff 1
2896 if {[gets $fd line] < 0} {
2897 if {![eof $fd]} {
2898 return 1
2899 }
2900 set isdiff 0
2901 }
2902 # we only need to see one line and we don't really care what it says...
2903 close $fd
2904
2905 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2906 # add the line for the local diff to the graph
2907 if {$localirow >= 0} {
2908 set localfrow $localirow
2909 incr localirow
2910 } else {
2911 set localfrow $commitrow($curview,$mainheadid)
2912 }
2913 set hl "Local uncommitted changes, not checked in to index"
2914 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2915 set commitdata($nullid) "\n $hl\n"
2916 insertrow $localfrow $nullid
2917 }
2918 return 0
2919 }
2920
2921 proc nextuse {id row} {
2922 global commitrow curview children
2923
2924 if {[info exists children($curview,$id)]} {
2925 foreach kid $children($curview,$id) {
2926 if {![info exists commitrow($curview,$kid)]} {
2927 return -1
2928 }
2929 if {$commitrow($curview,$kid) > $row} {
2930 return $commitrow($curview,$kid)
2931 }
2932 }
2933 }
2934 if {[info exists commitrow($curview,$id)]} {
2935 return $commitrow($curview,$id)
2936 }
2937 return -1
2938 }
2939
2940 proc prevuse {id row} {
2941 global commitrow curview children
2942
2943 set ret -1
2944 if {[info exists children($curview,$id)]} {
2945 foreach kid $children($curview,$id) {
2946 if {![info exists commitrow($curview,$kid)]} break
2947 if {$commitrow($curview,$kid) < $row} {
2948 set ret $commitrow($curview,$kid)
2949 }
2950 }
2951 }
2952 return $ret
2953 }
2954
2955 proc make_idlist {row} {
2956 global displayorder parentlist uparrowlen downarrowlen mingaplen
2957 global commitidx curview ordertok children commitrow
2958
2959 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2960 if {$r < 0} {
2961 set r 0
2962 }
2963 set ra [expr {$row - $downarrowlen}]
2964 if {$ra < 0} {
2965 set ra 0
2966 }
2967 set rb [expr {$row + $uparrowlen}]
2968 if {$rb > $commitidx($curview)} {
2969 set rb $commitidx($curview)
2970 }
2971 set ids {}
2972 for {} {$r < $ra} {incr r} {
2973 set nextid [lindex $displayorder [expr {$r + 1}]]
2974 foreach p [lindex $parentlist $r] {
2975 if {$p eq $nextid} continue
2976 set rn [nextuse $p $r]
2977 if {$rn >= $row &&
2978 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2979 lappend ids [list $ordertok($curview,$p) $p]
2980 }
2981 }
2982 }
2983 for {} {$r < $row} {incr r} {
2984 set nextid [lindex $displayorder [expr {$r + 1}]]
2985 foreach p [lindex $parentlist $r] {
2986 if {$p eq $nextid} continue
2987 set rn [nextuse $p $r]
2988 if {$rn < 0 || $rn >= $row} {
2989 lappend ids [list $ordertok($curview,$p) $p]
2990 }
2991 }
2992 }
2993 set id [lindex $displayorder $row]
2994 lappend ids [list $ordertok($curview,$id) $id]
2995 while {$r < $rb} {
2996 foreach p [lindex $parentlist $r] {
2997 set firstkid [lindex $children($curview,$p) 0]
2998 if {$commitrow($curview,$firstkid) < $row} {
2999 lappend ids [list $ordertok($curview,$p) $p]
3000 }
3001 }
3002 incr r
3003 set id [lindex $displayorder $r]
3004 if {$id ne {}} {
3005 set firstkid [lindex $children($curview,$id) 0]
3006 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3007 lappend ids [list $ordertok($curview,$id) $id]
3008 }
3009 }
3010 }
3011 set idlist {}
3012 foreach idx [lsort -unique $ids] {
3013 lappend idlist [lindex $idx 1]
3014 }
3015 return $idlist
3016 }
3017
3018 proc rowsequal {a b} {
3019 while {[set i [lsearch -exact $a {}]] >= 0} {
3020 set a [lreplace $a $i $i]
3021 }
3022 while {[set i [lsearch -exact $b {}]] >= 0} {
3023 set b [lreplace $b $i $i]
3024 }
3025 return [expr {$a eq $b}]
3026 }
3027
3028 proc makeupline {id row rend col} {
3029 global rowidlist uparrowlen downarrowlen mingaplen
3030
3031 for {set r $rend} {1} {set r $rstart} {
3032 set rstart [prevuse $id $r]
3033 if {$rstart < 0} return
3034 if {$rstart < $row} break
3035 }
3036 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3037 set rstart [expr {$rend - $uparrowlen - 1}]
3038 }
3039 for {set r $rstart} {[incr r] <= $row} {} {
3040 set idlist [lindex $rowidlist $r]
3041 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3042 set col [idcol $idlist $id $col]
3043 lset rowidlist $r [linsert $idlist $col $id]
3044 changedrow $r
3045 }
3046 }
3047 }
3048
3049 proc layoutrows {row endrow} {
3050 global rowidlist rowisopt rowfinal displayorder
3051 global uparrowlen downarrowlen maxwidth mingaplen
3052 global children parentlist
3053 global commitidx viewcomplete curview commitrow
3054
3055 set idlist {}
3056 if {$row > 0} {
3057 set rm1 [expr {$row - 1}]
3058 foreach id [lindex $rowidlist $rm1] {
3059 if {$id ne {}} {
3060 lappend idlist $id
3061 }
3062 }
3063 set final [lindex $rowfinal $rm1]
3064 }
3065 for {} {$row < $endrow} {incr row} {
3066 set rm1 [expr {$row - 1}]
3067 if {$rm1 < 0 || $idlist eq {}} {
3068 set idlist [make_idlist $row]
3069 set final 1
3070 } else {
3071 set id [lindex $displayorder $rm1]
3072 set col [lsearch -exact $idlist $id]
3073 set idlist [lreplace $idlist $col $col]
3074 foreach p [lindex $parentlist $rm1] {
3075 if {[lsearch -exact $idlist $p] < 0} {
3076 set col [idcol $idlist $p $col]
3077 set idlist [linsert $idlist $col $p]
3078 # if not the first child, we have to insert a line going up
3079 if {$id ne [lindex $children($curview,$p) 0]} {
3080 makeupline $p $rm1 $row $col
3081 }
3082 }
3083 }
3084 set id [lindex $displayorder $row]
3085 if {$row > $downarrowlen} {
3086 set termrow [expr {$row - $downarrowlen - 1}]
3087 foreach p [lindex $parentlist $termrow] {
3088 set i [lsearch -exact $idlist $p]
3089 if {$i < 0} continue
3090 set nr [nextuse $p $termrow]
3091 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3092 set idlist [lreplace $idlist $i $i]
3093 }
3094 }
3095 }
3096 set col [lsearch -exact $idlist $id]
3097 if {$col < 0} {
3098 set col [idcol $idlist $id]
3099 set idlist [linsert $idlist $col $id]
3100 if {$children($curview,$id) ne {}} {
3101 makeupline $id $rm1 $row $col
3102 }
3103 }
3104 set r [expr {$row + $uparrowlen - 1}]
3105 if {$r < $commitidx($curview)} {
3106 set x $col
3107 foreach p [lindex $parentlist $r] {
3108 if {[lsearch -exact $idlist $p] >= 0} continue
3109 set fk [lindex $children($curview,$p) 0]
3110 if {$commitrow($curview,$fk) < $row} {
3111 set x [idcol $idlist $p $x]
3112 set idlist [linsert $idlist $x $p]
3113 }
3114 }
3115 if {[incr r] < $commitidx($curview)} {
3116 set p [lindex $displayorder $r]
3117 if {[lsearch -exact $idlist $p] < 0} {
3118 set fk [lindex $children($curview,$p) 0]
3119 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3120 set x [idcol $idlist $p $x]
3121 set idlist [linsert $idlist $x $p]
3122 }
3123 }
3124 }
3125 }
3126 }
3127 if {$final && !$viewcomplete($curview) &&
3128 $row + $uparrowlen + $mingaplen + $downarrowlen
3129 >= $commitidx($curview)} {
3130 set final 0
3131 }
3132 set l [llength $rowidlist]
3133 if {$row == $l} {
3134 lappend rowidlist $idlist
3135 lappend rowisopt 0
3136 lappend rowfinal $final
3137 } elseif {$row < $l} {
3138 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3139 lset rowidlist $row $idlist
3140 changedrow $row
3141 }
3142 lset rowfinal $row $final
3143 } else {
3144 set pad [ntimes [expr {$row - $l}] {}]
3145 set rowidlist [concat $rowidlist $pad]
3146 lappend rowidlist $idlist
3147 set rowfinal [concat $rowfinal $pad]
3148 lappend rowfinal $final
3149 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3150 }
3151 }
3152 return $row
3153 }
3154
3155 proc changedrow {row} {
3156 global displayorder iddrawn rowisopt need_redisplay
3157
3158 set l [llength $rowisopt]
3159 if {$row < $l} {
3160 lset rowisopt $row 0
3161 if {$row + 1 < $l} {
3162 lset rowisopt [expr {$row + 1}] 0
3163 if {$row + 2 < $l} {
3164 lset rowisopt [expr {$row + 2}] 0
3165 }
3166 }
3167 }
3168 set id [lindex $displayorder $row]
3169 if {[info exists iddrawn($id)]} {
3170 set need_redisplay 1
3171 }
3172 }
3173
3174 proc insert_pad {row col npad} {
3175 global rowidlist
3176
3177 set pad [ntimes $npad {}]
3178 set idlist [lindex $rowidlist $row]
3179 set bef [lrange $idlist 0 [expr {$col - 1}]]
3180 set aft [lrange $idlist $col end]
3181 set i [lsearch -exact $aft {}]
3182 if {$i > 0} {
3183 set aft [lreplace $aft $i $i]
3184 }
3185 lset rowidlist $row [concat $bef $pad $aft]
3186 changedrow $row
3187 }
3188
3189 proc optimize_rows {row col endrow} {
3190 global rowidlist rowisopt displayorder curview children
3191
3192 if {$row < 1} {
3193 set row 1
3194 }
3195 for {} {$row < $endrow} {incr row; set col 0} {
3196 if {[lindex $rowisopt $row]} continue
3197 set haspad 0
3198 set y0 [expr {$row - 1}]
3199 set ym [expr {$row - 2}]
3200 set idlist [lindex $rowidlist $row]
3201 set previdlist [lindex $rowidlist $y0]
3202 if {$idlist eq {} || $previdlist eq {}} continue
3203 if {$ym >= 0} {
3204 set pprevidlist [lindex $rowidlist $ym]
3205 if {$pprevidlist eq {}} continue
3206 } else {
3207 set pprevidlist {}
3208 }
3209 set x0 -1
3210 set xm -1
3211 for {} {$col < [llength $idlist]} {incr col} {
3212 set id [lindex $idlist $col]
3213 if {[lindex $previdlist $col] eq $id} continue
3214 if {$id eq {}} {
3215 set haspad 1
3216 continue
3217 }
3218 set x0 [lsearch -exact $previdlist $id]
3219 if {$x0 < 0} continue
3220 set z [expr {$x0 - $col}]
3221 set isarrow 0
3222 set z0 {}
3223 if {$ym >= 0} {
3224 set xm [lsearch -exact $pprevidlist $id]
3225 if {$xm >= 0} {
3226 set z0 [expr {$xm - $x0}]
3227 }
3228 }
3229 if {$z0 eq {}} {
3230 # if row y0 is the first child of $id then it's not an arrow
3231 if {[lindex $children($curview,$id) 0] ne
3232 [lindex $displayorder $y0]} {
3233 set isarrow 1
3234 }
3235 }
3236 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3237 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3238 set isarrow 1
3239 }
3240 # Looking at lines from this row to the previous row,
3241 # make them go straight up if they end in an arrow on
3242 # the previous row; otherwise make them go straight up
3243 # or at 45 degrees.
3244 if {$z < -1 || ($z < 0 && $isarrow)} {
3245 # Line currently goes left too much;
3246 # insert pads in the previous row, then optimize it
3247 set npad [expr {-1 - $z + $isarrow}]
3248 insert_pad $y0 $x0 $npad
3249 if {$y0 > 0} {
3250 optimize_rows $y0 $x0 $row
3251 }
3252 set previdlist [lindex $rowidlist $y0]
3253 set x0 [lsearch -exact $previdlist $id]
3254 set z [expr {$x0 - $col}]
3255 if {$z0 ne {}} {
3256 set pprevidlist [lindex $rowidlist $ym]
3257 set xm [lsearch -exact $pprevidlist $id]
3258 set z0 [expr {$xm - $x0}]
3259 }
3260 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3261 # Line currently goes right too much;
3262 # insert pads in this line
3263 set npad [expr {$z - 1 + $isarrow}]
3264 insert_pad $row $col $npad
3265 set idlist [lindex $rowidlist $row]
3266 incr col $npad
3267 set z [expr {$x0 - $col}]
3268 set haspad 1
3269 }
3270 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3271 # this line links to its first child on row $row-2
3272 set id [lindex $displayorder $ym]
3273 set xc [lsearch -exact $pprevidlist $id]
3274 if {$xc >= 0} {
3275 set z0 [expr {$xc - $x0}]
3276 }
3277 }
3278 # avoid lines jigging left then immediately right
3279 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3280 insert_pad $y0 $x0 1
3281 incr x0
3282 optimize_rows $y0 $x0 $row
3283 set previdlist [lindex $rowidlist $y0]
3284 }
3285 }
3286 if {!$haspad} {
3287 # Find the first column that doesn't have a line going right
3288 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3289 set id [lindex $idlist $col]
3290 if {$id eq {}} break
3291 set x0 [lsearch -exact $previdlist $id]
3292 if {$x0 < 0} {
3293 # check if this is the link to the first child
3294 set kid [lindex $displayorder $y0]
3295 if {[lindex $children($curview,$id) 0] eq $kid} {
3296 # it is, work out offset to child
3297 set x0 [lsearch -exact $previdlist $kid]
3298 }
3299 }
3300 if {$x0 <= $col} break
3301 }
3302 # Insert a pad at that column as long as it has a line and
3303 # isn't the last column
3304 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3305 set idlist [linsert $idlist $col {}]
3306 lset rowidlist $row $idlist
3307 changedrow $row
3308 }
3309 }
3310 }
3311 }
3312
3313 proc xc {row col} {
3314 global canvx0 linespc
3315 return [expr {$canvx0 + $col * $linespc}]
3316 }
3317
3318 proc yc {row} {
3319 global canvy0 linespc
3320 return [expr {$canvy0 + $row * $linespc}]
3321 }
3322
3323 proc linewidth {id} {
3324 global thickerline lthickness
3325
3326 set wid $lthickness
3327 if {[info exists thickerline] && $id eq $thickerline} {
3328 set wid [expr {2 * $lthickness}]
3329 }
3330 return $wid
3331 }
3332
3333 proc rowranges {id} {
3334 global commitrow curview children uparrowlen downarrowlen
3335 global rowidlist
3336
3337 set kids $children($curview,$id)
3338 if {$kids eq {}} {
3339 return {}
3340 }
3341 set ret {}
3342 lappend kids $id
3343 foreach child $kids {
3344 if {![info exists commitrow($curview,$child)]} break
3345 set row $commitrow($curview,$child)
3346 if {![info exists prev]} {
3347 lappend ret [expr {$row + 1}]
3348 } else {
3349 if {$row <= $prevrow} {
3350 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3351 }
3352 # see if the line extends the whole way from prevrow to row
3353 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3354 [lsearch -exact [lindex $rowidlist \
3355 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3356 # it doesn't, see where it ends
3357 set r [expr {$prevrow + $downarrowlen}]
3358 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3359 while {[incr r -1] > $prevrow &&
3360 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3361 } else {
3362 while {[incr r] <= $row &&
3363 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3364 incr r -1
3365 }
3366 lappend ret $r
3367 # see where it starts up again
3368 set r [expr {$row - $uparrowlen}]
3369 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3370 while {[incr r] < $row &&
3371 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3372 } else {
3373 while {[incr r -1] >= $prevrow &&
3374 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3375 incr r
3376 }
3377 lappend ret $r
3378 }
3379 }
3380 if {$child eq $id} {
3381 lappend ret $row
3382 }
3383 set prev $id
3384 set prevrow $row
3385 }
3386 return $ret
3387 }
3388
3389 proc drawlineseg {id row endrow arrowlow} {
3390 global rowidlist displayorder iddrawn linesegs
3391 global canv colormap linespc curview maxlinelen parentlist
3392
3393 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3394 set le [expr {$row + 1}]
3395 set arrowhigh 1
3396 while {1} {
3397 set c [lsearch -exact [lindex $rowidlist $le] $id]
3398 if {$c < 0} {
3399 incr le -1
3400 break
3401 }
3402 lappend cols $c
3403 set x [lindex $displayorder $le]
3404 if {$x eq $id} {
3405 set arrowhigh 0
3406 break
3407 }
3408 if {[info exists iddrawn($x)] || $le == $endrow} {
3409 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3410 if {$c >= 0} {
3411 lappend cols $c
3412 set arrowhigh 0
3413 }
3414 break
3415 }
3416 incr le
3417 }
3418 if {$le <= $row} {
3419 return $row
3420 }
3421
3422 set lines {}
3423 set i 0
3424 set joinhigh 0
3425 if {[info exists linesegs($id)]} {
3426 set lines $linesegs($id)
3427 foreach li $lines {
3428 set r0 [lindex $li 0]
3429 if {$r0 > $row} {
3430 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3431 set joinhigh 1
3432 }
3433 break
3434 }
3435 incr i
3436 }
3437 }
3438 set joinlow 0
3439 if {$i > 0} {
3440 set li [lindex $lines [expr {$i-1}]]
3441 set r1 [lindex $li 1]
3442 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3443 set joinlow 1
3444 }
3445 }
3446
3447 set x [lindex $cols [expr {$le - $row}]]
3448 set xp [lindex $cols [expr {$le - 1 - $row}]]
3449 set dir [expr {$xp - $x}]
3450 if {$joinhigh} {
3451 set ith [lindex $lines $i 2]
3452 set coords [$canv coords $ith]
3453 set ah [$canv itemcget $ith -arrow]
3454 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3455 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3456 if {$x2 ne {} && $x - $x2 == $dir} {
3457 set coords [lrange $coords 0 end-2]
3458 }
3459 } else {
3460 set coords [list [xc $le $x] [yc $le]]
3461 }
3462 if {$joinlow} {
3463 set itl [lindex $lines [expr {$i-1}] 2]
3464 set al [$canv itemcget $itl -arrow]
3465 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3466 } elseif {$arrowlow} {
3467 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3468 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3469 set arrowlow 0
3470 }
3471 }
3472 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3473 for {set y $le} {[incr y -1] > $row} {} {
3474 set x $xp
3475 set xp [lindex $cols [expr {$y - 1 - $row}]]
3476 set ndir [expr {$xp - $x}]
3477 if {$dir != $ndir || $xp < 0} {
3478 lappend coords [xc $y $x] [yc $y]
3479 }
3480 set dir $ndir
3481 }
3482 if {!$joinlow} {
3483 if {$xp < 0} {
3484 # join parent line to first child
3485 set ch [lindex $displayorder $row]
3486 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3487 if {$xc < 0} {
3488 puts "oops: drawlineseg: child $ch not on row $row"
3489 } elseif {$xc != $x} {
3490 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3491 set d [expr {int(0.5 * $linespc)}]
3492 set x1 [xc $row $x]
3493 if {$xc < $x} {
3494 set x2 [expr {$x1 - $d}]
3495 } else {
3496 set x2 [expr {$x1 + $d}]
3497 }
3498 set y2 [yc $row]
3499 set y1 [expr {$y2 + $d}]
3500 lappend coords $x1 $y1 $x2 $y2
3501 } elseif {$xc < $x - 1} {
3502 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3503 } elseif {$xc > $x + 1} {
3504 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3505 }
3506 set x $xc
3507 }
3508 lappend coords [xc $row $x] [yc $row]
3509 } else {
3510 set xn [xc $row $xp]
3511 set yn [yc $row]
3512 lappend coords $xn $yn
3513 }
3514 if {!$joinhigh} {
3515 assigncolor $id
3516 set t [$canv create line $coords -width [linewidth $id] \
3517 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3518 $canv lower $t
3519 bindline $t $id
3520 set lines [linsert $lines $i [list $row $le $t]]
3521 } else {
3522 $canv coords $ith $coords
3523 if {$arrow ne $ah} {
3524 $canv itemconf $ith -arrow $arrow
3525 }
3526 lset lines $i 0 $row
3527 }
3528 } else {
3529 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3530 set ndir [expr {$xo - $xp}]
3531 set clow [$canv coords $itl]
3532 if {$dir == $ndir} {
3533 set clow [lrange $clow 2 end]
3534 }
3535 set coords [concat $coords $clow]
3536 if {!$joinhigh} {
3537 lset lines [expr {$i-1}] 1 $le
3538 } else {
3539 # coalesce two pieces
3540 $canv delete $ith
3541 set b [lindex $lines [expr {$i-1}] 0]
3542 set e [lindex $lines $i 1]
3543 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3544 }
3545 $canv coords $itl $coords
3546 if {$arrow ne $al} {
3547 $canv itemconf $itl -arrow $arrow
3548 }
3549 }
3550
3551 set linesegs($id) $lines
3552 return $le
3553 }
3554
3555 proc drawparentlinks {id row} {
3556 global rowidlist canv colormap curview parentlist
3557 global idpos linespc
3558
3559 set rowids [lindex $rowidlist $row]
3560 set col [lsearch -exact $rowids $id]
3561 if {$col < 0} return
3562 set olds [lindex $parentlist $row]
3563 set row2 [expr {$row + 1}]
3564 set x [xc $row $col]
3565 set y [yc $row]
3566 set y2 [yc $row2]
3567 set d [expr {int(0.5 * $linespc)}]
3568 set ymid [expr {$y + $d}]
3569 set ids [lindex $rowidlist $row2]
3570 # rmx = right-most X coord used
3571 set rmx 0
3572 foreach p $olds {
3573 set i [lsearch -exact $ids $p]
3574 if {$i < 0} {
3575 puts "oops, parent $p of $id not in list"
3576 continue
3577 }
3578 set x2 [xc $row2 $i]
3579 if {$x2 > $rmx} {
3580 set rmx $x2
3581 }
3582 set j [lsearch -exact $rowids $p]
3583 if {$j < 0} {
3584 # drawlineseg will do this one for us
3585 continue
3586 }
3587 assigncolor $p
3588 # should handle duplicated parents here...
3589 set coords [list $x $y]
3590 if {$i != $col} {
3591 # if attaching to a vertical segment, draw a smaller
3592 # slant for visual distinctness
3593 if {$i == $j} {
3594 if {$i < $col} {
3595 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3596 } else {
3597 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3598 }
3599 } elseif {$i < $col && $i < $j} {
3600 # segment slants towards us already
3601 lappend coords [xc $row $j] $y
3602 } else {
3603 if {$i < $col - 1} {
3604 lappend coords [expr {$x2 + $linespc}] $y
3605 } elseif {$i > $col + 1} {
3606 lappend coords [expr {$x2 - $linespc}] $y
3607 }
3608 lappend coords $x2 $y2
3609 }
3610 } else {
3611 lappend coords $x2 $y2
3612 }
3613 set t [$canv create line $coords -width [linewidth $p] \
3614 -fill $colormap($p) -tags lines.$p]
3615 $canv lower $t
3616 bindline $t $p
3617 }
3618 if {$rmx > [lindex $idpos($id) 1]} {
3619 lset idpos($id) 1 $rmx
3620 redrawtags $id
3621 }
3622 }
3623
3624 proc drawlines {id} {
3625 global canv
3626
3627 $canv itemconf lines.$id -width [linewidth $id]
3628 }
3629
3630 proc drawcmittext {id row col} {
3631 global linespc canv canv2 canv3 canvy0 fgcolor curview
3632 global commitlisted commitinfo rowidlist parentlist
3633 global rowtextx idpos idtags idheads idotherrefs
3634 global linehtag linentag linedtag selectedline
3635 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3636
3637 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3638 set listed [lindex $commitlisted $row]
3639 if {$id eq $nullid} {
3640 set ofill red
3641 } elseif {$id eq $nullid2} {
3642 set ofill green
3643 } else {
3644 set ofill [expr {$listed != 0? "blue": "white"}]
3645 }
3646 set x [xc $row $col]
3647 set y [yc $row]
3648 set orad [expr {$linespc / 3}]
3649 if {$listed <= 1} {
3650 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3651 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3652 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3653 } elseif {$listed == 2} {
3654 # triangle pointing left for left-side commits
3655 set t [$canv create polygon \
3656 [expr {$x - $orad}] $y \
3657 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3658 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3659 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3660 } else {
3661 # triangle pointing right for right-side commits
3662 set t [$canv create polygon \
3663 [expr {$x + $orad - 1}] $y \
3664 [expr {$x - $orad}] [expr {$y - $orad}] \
3665 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3666 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3667 }
3668 $canv raise $t
3669 $canv bind $t <1> {selcanvline {} %x %y}
3670 set rmx [llength [lindex $rowidlist $row]]
3671 set olds [lindex $parentlist $row]
3672 if {$olds ne {}} {
3673 set nextids [lindex $rowidlist [expr {$row + 1}]]
3674 foreach p $olds {
3675 set i [lsearch -exact $nextids $p]
3676 if {$i > $rmx} {
3677 set rmx $i
3678 }
3679 }
3680 }
3681 set xt [xc $row $rmx]
3682 set rowtextx($row) $xt
3683 set idpos($id) [list $x $xt $y]
3684 if {[info exists idtags($id)] || [info exists idheads($id)]
3685 || [info exists idotherrefs($id)]} {
3686 set xt [drawtags $id $x $xt $y]
3687 }
3688 set headline [lindex $commitinfo($id) 0]
3689 set name [lindex $commitinfo($id) 1]
3690 set date [lindex $commitinfo($id) 2]
3691 set date [formatdate $date]
3692 set font mainfont
3693 set nfont mainfont
3694 set isbold [ishighlighted $row]
3695 if {$isbold > 0} {
3696 lappend boldrows $row
3697 set font mainfontbold
3698 if {$isbold > 1} {
3699 lappend boldnamerows $row
3700 set nfont mainfontbold
3701 }
3702 }
3703 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3704 -text $headline -font $font -tags text]
3705 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3706 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3707 -text $name -font $nfont -tags text]
3708 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3709 -text $date -font mainfont -tags text]
3710 if {[info exists selectedline] && $selectedline == $row} {
3711 make_secsel $row
3712 }
3713 set xr [expr {$xt + [font measure $font $headline]}]
3714 if {$xr > $canvxmax} {
3715 set canvxmax $xr
3716 setcanvscroll
3717 }
3718 }
3719
3720 proc drawcmitrow {row} {
3721 global displayorder rowidlist nrows_drawn
3722 global iddrawn markingmatches
3723 global commitinfo parentlist numcommits
3724 global filehighlight fhighlights findpattern nhighlights
3725 global hlview vhighlights
3726 global highlight_related rhighlights
3727
3728 if {$row >= $numcommits} return
3729
3730 set id [lindex $displayorder $row]
3731 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3732 askvhighlight $row $id
3733 }
3734 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3735 askfilehighlight $row $id
3736 }
3737 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3738 askfindhighlight $row $id
3739 }
3740 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3741 askrelhighlight $row $id
3742 }
3743 if {![info exists iddrawn($id)]} {
3744 set col [lsearch -exact [lindex $rowidlist $row] $id]
3745 if {$col < 0} {
3746 puts "oops, row $row id $id not in list"
3747 return
3748 }
3749 if {![info exists commitinfo($id)]} {
3750 getcommit $id
3751 }
3752 assigncolor $id
3753 drawcmittext $id $row $col
3754 set iddrawn($id) 1
3755 incr nrows_drawn
3756 }
3757 if {$markingmatches} {
3758 markrowmatches $row $id
3759 }
3760 }
3761
3762 proc drawcommits {row {endrow {}}} {
3763 global numcommits iddrawn displayorder curview need_redisplay
3764 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3765
3766 if {$row < 0} {
3767 set row 0
3768 }
3769 if {$endrow eq {}} {
3770 set endrow $row
3771 }
3772 if {$endrow >= $numcommits} {
3773 set endrow [expr {$numcommits - 1}]
3774 }
3775
3776 set rl1 [expr {$row - $downarrowlen - 3}]
3777 if {$rl1 < 0} {
3778 set rl1 0
3779 }
3780 set ro1 [expr {$row - 3}]
3781 if {$ro1 < 0} {
3782 set ro1 0
3783 }
3784 set r2 [expr {$endrow + $uparrowlen + 3}]
3785 if {$r2 > $numcommits} {
3786 set r2 $numcommits
3787 }
3788 for {set r $rl1} {$r < $r2} {incr r} {
3789 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3790 if {$rl1 < $r} {
3791 layoutrows $rl1 $r
3792 }
3793 set rl1 [expr {$r + 1}]
3794 }
3795 }
3796 if {$rl1 < $r} {
3797 layoutrows $rl1 $r
3798 }
3799 optimize_rows $ro1 0 $r2
3800 if {$need_redisplay || $nrows_drawn > 2000} {
3801 clear_display
3802 drawvisible
3803 }
3804
3805 # make the lines join to already-drawn rows either side
3806 set r [expr {$row - 1}]
3807 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3808 set r $row
3809 }
3810 set er [expr {$endrow + 1}]
3811 if {$er >= $numcommits ||
3812 ![info exists iddrawn([lindex $displayorder $er])]} {
3813 set er $endrow
3814 }
3815 for {} {$r <= $er} {incr r} {
3816 set id [lindex $displayorder $r]
3817 set wasdrawn [info exists iddrawn($id)]
3818 drawcmitrow $r
3819 if {$r == $er} break
3820 set nextid [lindex $displayorder [expr {$r + 1}]]
3821 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3822 drawparentlinks $id $r
3823
3824 set rowids [lindex $rowidlist $r]
3825 foreach lid $rowids {
3826 if {$lid eq {}} continue
3827 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3828 if {$lid eq $id} {
3829 # see if this is the first child of any of its parents
3830 foreach p [lindex $parentlist $r] {
3831 if {[lsearch -exact $rowids $p] < 0} {
3832 # make this line extend up to the child
3833 set lineend($p) [drawlineseg $p $r $er 0]
3834 }
3835 }
3836 } else {
3837 set lineend($lid) [drawlineseg $lid $r $er 1]
3838 }
3839 }
3840 }
3841 }
3842
3843 proc drawfrac {f0 f1} {
3844 global canv linespc
3845
3846 set ymax [lindex [$canv cget -scrollregion] 3]
3847 if {$ymax eq {} || $ymax == 0} return
3848 set y0 [expr {int($f0 * $ymax)}]
3849 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3850 set y1 [expr {int($f1 * $ymax)}]
3851 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3852 drawcommits $row $endrow
3853 }
3854
3855 proc drawvisible {} {
3856 global canv
3857 eval drawfrac [$canv yview]
3858 }
3859
3860 proc clear_display {} {
3861 global iddrawn linesegs need_redisplay nrows_drawn
3862 global vhighlights fhighlights nhighlights rhighlights
3863
3864 allcanvs delete all
3865 catch {unset iddrawn}
3866 catch {unset linesegs}
3867 catch {unset vhighlights}
3868 catch {unset fhighlights}
3869 catch {unset nhighlights}
3870 catch {unset rhighlights}
3871 set need_redisplay 0
3872 set nrows_drawn 0
3873 }
3874
3875 proc findcrossings {id} {
3876 global rowidlist parentlist numcommits displayorder
3877
3878 set cross {}
3879 set ccross {}
3880 foreach {s e} [rowranges $id] {
3881 if {$e >= $numcommits} {
3882 set e [expr {$numcommits - 1}]
3883 }
3884 if {$e <= $s} continue
3885 for {set row $e} {[incr row -1] >= $s} {} {
3886 set x [lsearch -exact [lindex $rowidlist $row] $id]
3887 if {$x < 0} break
3888 set olds [lindex $parentlist $row]
3889 set kid [lindex $displayorder $row]
3890 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3891 if {$kidx < 0} continue
3892 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3893 foreach p $olds {
3894 set px [lsearch -exact $nextrow $p]
3895 if {$px < 0} continue
3896 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3897 if {[lsearch -exact $ccross $p] >= 0} continue
3898 if {$x == $px + ($kidx < $px? -1: 1)} {
3899 lappend ccross $p
3900 } elseif {[lsearch -exact $cross $p] < 0} {
3901 lappend cross $p
3902 }
3903 }
3904 }
3905 }
3906 }
3907 return [concat $ccross {{}} $cross]
3908 }
3909
3910 proc assigncolor {id} {
3911 global colormap colors nextcolor
3912 global commitrow parentlist children children curview
3913
3914 if {[info exists colormap($id)]} return
3915 set ncolors [llength $colors]
3916 if {[info exists children($curview,$id)]} {
3917 set kids $children($curview,$id)
3918 } else {
3919 set kids {}
3920 }
3921 if {[llength $kids] == 1} {
3922 set child [lindex $kids 0]
3923 if {[info exists colormap($child)]
3924 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3925 set colormap($id) $colormap($child)
3926 return
3927 }
3928 }
3929 set badcolors {}
3930 set origbad {}
3931 foreach x [findcrossings $id] {
3932 if {$x eq {}} {
3933 # delimiter between corner crossings and other crossings
3934 if {[llength $badcolors] >= $ncolors - 1} break
3935 set origbad $badcolors
3936 }
3937 if {[info exists colormap($x)]
3938 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3939 lappend badcolors $colormap($x)
3940 }
3941 }
3942 if {[llength $badcolors] >= $ncolors} {
3943 set badcolors $origbad
3944 }
3945 set origbad $badcolors
3946 if {[llength $badcolors] < $ncolors - 1} {
3947 foreach child $kids {
3948 if {[info exists colormap($child)]
3949 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3950 lappend badcolors $colormap($child)
3951 }