Fix 'git cvsexportcommit -w $cvsdir ...' when used with relative $GIT_DIR
[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 "[mc "Error executing git rev-list:"] $err"
102 exit 1
103 }
104 set commfd($view) $fd
105 set leftover($view) {}
106 if {$showlocalchanges} {
107 lappend commitinterest($mainheadid) {dodiffindex}
108 }
109 fconfigure $fd -blocking 0 -translation lf -eofchar {}
110 if {$tclencoding != {}} {
111 fconfigure $fd -encoding $tclencoding
112 }
113 filerun $fd [list getcommitlines $fd $view]
114 nowbusy $view [mc "Reading"]
115 if {$view == $curview} {
116 set progressdirn 1
117 set progresscoords {0 0}
118 set proglastnc 0
119 }
120 }
121
122 proc stop_rev_list {} {
123 global commfd curview
124
125 if {![info exists commfd($curview)]} return
126 set fd $commfd($curview)
127 catch {
128 set pid [pid $fd]
129 exec kill $pid
130 }
131 catch {close $fd}
132 unset commfd($curview)
133 }
134
135 proc getcommits {} {
136 global phase canv curview
137
138 set phase getcommits
139 initlayout
140 start_rev_list $curview
141 show_status [mc "Reading commits..."]
142 }
143
144 # This makes a string representation of a positive integer which
145 # sorts as a string in numerical order
146 proc strrep {n} {
147 if {$n < 16} {
148 return [format "%x" $n]
149 } elseif {$n < 256} {
150 return [format "x%.2x" $n]
151 } elseif {$n < 65536} {
152 return [format "y%.4x" $n]
153 }
154 return [format "z%.8x" $n]
155 }
156
157 proc getcommitlines {fd view} {
158 global commitlisted commitinterest
159 global leftover commfd
160 global displayorder commitidx viewcomplete commitrow commitdata
161 global parentlist children curview hlview
162 global vparentlist vdisporder vcmitlisted
163 global ordertok vnextroot idpending
164
165 set stuff [read $fd 500000]
166 # git log doesn't terminate the last commit with a null...
167 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
168 set stuff "\0"
169 }
170 if {$stuff == {}} {
171 if {![eof $fd]} {
172 return 1
173 }
174 # Check if we have seen any ids listed as parents that haven't
175 # appeared in the list
176 foreach vid [array names idpending "$view,*"] {
177 # should only get here if git log is buggy
178 set id [lindex [split $vid ","] 1]
179 set commitrow($vid) $commitidx($view)
180 incr commitidx($view)
181 if {$view == $curview} {
182 lappend parentlist {}
183 lappend displayorder $id
184 lappend commitlisted 0
185 } else {
186 lappend vparentlist($view) {}
187 lappend vdisporder($view) $id
188 lappend vcmitlisted($view) 0
189 }
190 }
191 set viewcomplete($view) 1
192 global viewname progresscoords
193 unset commfd($view)
194 notbusy $view
195 set progresscoords {0 0}
196 adjustprogress
197 # set it blocking so we wait for the process to terminate
198 fconfigure $fd -blocking 1
199 if {[catch {close $fd} err]} {
200 set fv {}
201 if {$view != $curview} {
202 set fv " for the \"$viewname($view)\" view"
203 }
204 if {[string range $err 0 4] == "usage"} {
205 set err "Gitk: error reading commits$fv:\
206 bad arguments to git rev-list."
207 if {$viewname($view) eq "Command line"} {
208 append err \
209 " (Note: arguments to gitk are passed to git rev-list\
210 to allow selection of commits to be displayed.)"
211 }
212 } else {
213 set err "Error reading commits$fv: $err"
214 }
215 error_popup $err
216 }
217 if {$view == $curview} {
218 run chewcommits $view
219 }
220 return 0
221 }
222 set start 0
223 set gotsome 0
224 while 1 {
225 set i [string first "\0" $stuff $start]
226 if {$i < 0} {
227 append leftover($view) [string range $stuff $start end]
228 break
229 }
230 if {$start == 0} {
231 set cmit $leftover($view)
232 append cmit [string range $stuff 0 [expr {$i - 1}]]
233 set leftover($view) {}
234 } else {
235 set cmit [string range $stuff $start [expr {$i - 1}]]
236 }
237 set start [expr {$i + 1}]
238 set j [string first "\n" $cmit]
239 set ok 0
240 set listed 1
241 if {$j >= 0 && [string match "commit *" $cmit]} {
242 set ids [string range $cmit 7 [expr {$j - 1}]]
243 if {[string match {[-<>]*} $ids]} {
244 switch -- [string index $ids 0] {
245 "-" {set listed 0}
246 "<" {set listed 2}
247 ">" {set listed 3}
248 }
249 set ids [string range $ids 1 end]
250 }
251 set ok 1
252 foreach id $ids {
253 if {[string length $id] != 40} {
254 set ok 0
255 break
256 }
257 }
258 }
259 if {!$ok} {
260 set shortcmit $cmit
261 if {[string length $shortcmit] > 80} {
262 set shortcmit "[string range $shortcmit 0 80]..."
263 }
264 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
265 exit 1
266 }
267 set id [lindex $ids 0]
268 if {![info exists ordertok($view,$id)]} {
269 set otok "o[strrep $vnextroot($view)]"
270 incr vnextroot($view)
271 set ordertok($view,$id) $otok
272 } else {
273 set otok $ordertok($view,$id)
274 unset idpending($view,$id)
275 }
276 if {$listed} {
277 set olds [lrange $ids 1 end]
278 if {[llength $olds] == 1} {
279 set p [lindex $olds 0]
280 lappend children($view,$p) $id
281 if {![info exists ordertok($view,$p)]} {
282 set ordertok($view,$p) $ordertok($view,$id)
283 set idpending($view,$p) 1
284 }
285 } else {
286 set i 0
287 foreach p $olds {
288 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
289 lappend children($view,$p) $id
290 }
291 if {![info exists ordertok($view,$p)]} {
292 set ordertok($view,$p) "$otok[strrep $i]]"
293 set idpending($view,$p) 1
294 }
295 incr i
296 }
297 }
298 } else {
299 set olds {}
300 }
301 if {![info exists children($view,$id)]} {
302 set children($view,$id) {}
303 }
304 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
305 set commitrow($view,$id) $commitidx($view)
306 incr commitidx($view)
307 if {$view == $curview} {
308 lappend parentlist $olds
309 lappend displayorder $id
310 lappend commitlisted $listed
311 } else {
312 lappend vparentlist($view) $olds
313 lappend vdisporder($view) $id
314 lappend vcmitlisted($view) $listed
315 }
316 if {[info exists commitinterest($id)]} {
317 foreach script $commitinterest($id) {
318 eval [string map [list "%I" $id] $script]
319 }
320 unset commitinterest($id)
321 }
322 set gotsome 1
323 }
324 if {$gotsome} {
325 run chewcommits $view
326 if {$view == $curview} {
327 # update progress bar
328 global progressdirn progresscoords proglastnc
329 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
330 set proglastnc $commitidx($view)
331 set l [lindex $progresscoords 0]
332 set r [lindex $progresscoords 1]
333 if {$progressdirn} {
334 set r [expr {$r + $inc}]
335 if {$r >= 1.0} {
336 set r 1.0
337 set progressdirn 0
338 }
339 if {$r > 0.2} {
340 set l [expr {$r - 0.2}]
341 }
342 } else {
343 set l [expr {$l - $inc}]
344 if {$l <= 0.0} {
345 set l 0.0
346 set progressdirn 1
347 }
348 set r [expr {$l + 0.2}]
349 }
350 set progresscoords [list $l $r]
351 adjustprogress
352 }
353 }
354 return 2
355 }
356
357 proc chewcommits {view} {
358 global curview hlview viewcomplete
359 global selectedline pending_select
360
361 if {$view == $curview} {
362 layoutmore
363 if {$viewcomplete($view)} {
364 global displayorder commitidx phase
365 global numcommits startmsecs
366
367 if {[info exists pending_select]} {
368 set row [first_real_row]
369 selectline $row 1
370 }
371 if {$commitidx($curview) > 0} {
372 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
373 #puts "overall $ms ms for $numcommits commits"
374 } else {
375 show_status [mc "No commits selected"]
376 }
377 notbusy layout
378 set phase {}
379 }
380 }
381 if {[info exists hlview] && $view == $hlview} {
382 vhighlightmore
383 }
384 return 0
385 }
386
387 proc readcommit {id} {
388 if {[catch {set contents [exec git cat-file commit $id]}]} return
389 parsecommit $id $contents 0
390 }
391
392 proc updatecommits {} {
393 global viewdata curview phase displayorder ordertok idpending
394 global children commitrow selectedline thickerline showneartags
395
396 if {$phase ne {}} {
397 stop_rev_list
398 set phase {}
399 }
400 set n $curview
401 foreach id $displayorder {
402 catch {unset children($n,$id)}
403 catch {unset commitrow($n,$id)}
404 catch {unset ordertok($n,$id)}
405 }
406 foreach vid [array names idpending "$n,*"] {
407 unset idpending($vid)
408 }
409 set curview -1
410 catch {unset selectedline}
411 catch {unset thickerline}
412 catch {unset viewdata($n)}
413 readrefs
414 changedrefs
415 if {$showneartags} {
416 getallcommits
417 }
418 showview $n
419 }
420
421 proc parsecommit {id contents listed} {
422 global commitinfo cdate
423
424 set inhdr 1
425 set comment {}
426 set headline {}
427 set auname {}
428 set audate {}
429 set comname {}
430 set comdate {}
431 set hdrend [string first "\n\n" $contents]
432 if {$hdrend < 0} {
433 # should never happen...
434 set hdrend [string length $contents]
435 }
436 set header [string range $contents 0 [expr {$hdrend - 1}]]
437 set comment [string range $contents [expr {$hdrend + 2}] end]
438 foreach line [split $header "\n"] {
439 set tag [lindex $line 0]
440 if {$tag == "author"} {
441 set audate [lindex $line end-1]
442 set auname [lrange $line 1 end-2]
443 } elseif {$tag == "committer"} {
444 set comdate [lindex $line end-1]
445 set comname [lrange $line 1 end-2]
446 }
447 }
448 set headline {}
449 # take the first non-blank line of the comment as the headline
450 set headline [string trimleft $comment]
451 set i [string first "\n" $headline]
452 if {$i >= 0} {
453 set headline [string range $headline 0 $i]
454 }
455 set headline [string trimright $headline]
456 set i [string first "\r" $headline]
457 if {$i >= 0} {
458 set headline [string trimright [string range $headline 0 $i]]
459 }
460 if {!$listed} {
461 # git rev-list indents the comment by 4 spaces;
462 # if we got this via git cat-file, add the indentation
463 set newcomment {}
464 foreach line [split $comment "\n"] {
465 append newcomment " "
466 append newcomment $line
467 append newcomment "\n"
468 }
469 set comment $newcomment
470 }
471 if {$comdate != {}} {
472 set cdate($id) $comdate
473 }
474 set commitinfo($id) [list $headline $auname $audate \
475 $comname $comdate $comment]
476 }
477
478 proc getcommit {id} {
479 global commitdata commitinfo
480
481 if {[info exists commitdata($id)]} {
482 parsecommit $id $commitdata($id) 1
483 } else {
484 readcommit $id
485 if {![info exists commitinfo($id)]} {
486 set commitinfo($id) [list [mc "No commit information available"]]
487 }
488 }
489 return 1
490 }
491
492 proc readrefs {} {
493 global tagids idtags headids idheads tagobjid
494 global otherrefids idotherrefs mainhead mainheadid
495
496 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
497 catch {unset $v}
498 }
499 set refd [open [list | git show-ref -d] r]
500 while {[gets $refd line] >= 0} {
501 if {[string index $line 40] ne " "} continue
502 set id [string range $line 0 39]
503 set ref [string range $line 41 end]
504 if {![string match "refs/*" $ref]} continue
505 set name [string range $ref 5 end]
506 if {[string match "remotes/*" $name]} {
507 if {![string match "*/HEAD" $name]} {
508 set headids($name) $id
509 lappend idheads($id) $name
510 }
511 } elseif {[string match "heads/*" $name]} {
512 set name [string range $name 6 end]
513 set headids($name) $id
514 lappend idheads($id) $name
515 } elseif {[string match "tags/*" $name]} {
516 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
517 # which is what we want since the former is the commit ID
518 set name [string range $name 5 end]
519 if {[string match "*^{}" $name]} {
520 set name [string range $name 0 end-3]
521 } else {
522 set tagobjid($name) $id
523 }
524 set tagids($name) $id
525 lappend idtags($id) $name
526 } else {
527 set otherrefids($name) $id
528 lappend idotherrefs($id) $name
529 }
530 }
531 catch {close $refd}
532 set mainhead {}
533 set mainheadid {}
534 catch {
535 set thehead [exec git symbolic-ref HEAD]
536 if {[string match "refs/heads/*" $thehead]} {
537 set mainhead [string range $thehead 11 end]
538 if {[info exists headids($mainhead)]} {
539 set mainheadid $headids($mainhead)
540 }
541 }
542 }
543 }
544
545 # skip over fake commits
546 proc first_real_row {} {
547 global nullid nullid2 displayorder numcommits
548
549 for {set row 0} {$row < $numcommits} {incr row} {
550 set id [lindex $displayorder $row]
551 if {$id ne $nullid && $id ne $nullid2} {
552 break
553 }
554 }
555 return $row
556 }
557
558 # update things for a head moved to a child of its previous location
559 proc movehead {id name} {
560 global headids idheads
561
562 removehead $headids($name) $name
563 set headids($name) $id
564 lappend idheads($id) $name
565 }
566
567 # update things when a head has been removed
568 proc removehead {id name} {
569 global headids idheads
570
571 if {$idheads($id) eq $name} {
572 unset idheads($id)
573 } else {
574 set i [lsearch -exact $idheads($id) $name]
575 if {$i >= 0} {
576 set idheads($id) [lreplace $idheads($id) $i $i]
577 }
578 }
579 unset headids($name)
580 }
581
582 proc show_error {w top msg} {
583 message $w.m -text $msg -justify center -aspect 400
584 pack $w.m -side top -fill x -padx 20 -pady 20
585 button $w.ok -text [mc OK] -command "destroy $top"
586 pack $w.ok -side bottom -fill x
587 bind $top <Visibility> "grab $top; focus $top"
588 bind $top <Key-Return> "destroy $top"
589 tkwait window $top
590 }
591
592 proc error_popup msg {
593 set w .error
594 toplevel $w
595 wm transient $w .
596 show_error $w $w $msg
597 }
598
599 proc confirm_popup msg {
600 global confirm_ok
601 set confirm_ok 0
602 set w .confirm
603 toplevel $w
604 wm transient $w .
605 message $w.m -text $msg -justify center -aspect 400
606 pack $w.m -side top -fill x -padx 20 -pady 20
607 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
608 pack $w.ok -side left -fill x
609 button $w.cancel -text [mc Cancel] -command "destroy $w"
610 pack $w.cancel -side right -fill x
611 bind $w <Visibility> "grab $w; focus $w"
612 tkwait window $w
613 return $confirm_ok
614 }
615
616 proc setoptions {} {
617 option add *Panedwindow.showHandle 1 startupFile
618 option add *Panedwindow.sashRelief raised startupFile
619 option add *Button.font uifont startupFile
620 option add *Checkbutton.font uifont startupFile
621 option add *Radiobutton.font uifont startupFile
622 option add *Menu.font uifont startupFile
623 option add *Menubutton.font uifont startupFile
624 option add *Label.font uifont startupFile
625 option add *Message.font uifont startupFile
626 option add *Entry.font uifont startupFile
627 }
628
629 proc makewindow {} {
630 global canv canv2 canv3 linespc charspc ctext cflist
631 global tabstop
632 global findtype findtypemenu findloc findstring fstring geometry
633 global entries sha1entry sha1string sha1but
634 global diffcontextstring diffcontext
635 global maincursor textcursor curtextcursor
636 global rowctxmenu fakerowmenu mergemax wrapcomment
637 global highlight_files gdttype
638 global searchstring sstring
639 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
640 global headctxmenu progresscanv progressitem progresscoords statusw
641 global fprogitem fprogcoord lastprogupdate progupdatepending
642 global rprogitem rprogcoord
643 global have_tk85
644
645 menu .bar
646 .bar add cascade -label [mc "File"] -menu .bar.file
647 menu .bar.file
648 .bar.file add command -label [mc "Update"] -command updatecommits
649 .bar.file add command -label [mc "Reread references"] -command rereadrefs
650 .bar.file add command -label [mc "List references"] -command showrefs
651 .bar.file add command -label [mc "Quit"] -command doquit
652 menu .bar.edit
653 .bar add cascade -label [mc "Edit"] -menu .bar.edit
654 .bar.edit add command -label [mc "Preferences"] -command doprefs
655
656 menu .bar.view
657 .bar add cascade -label [mc "View"] -menu .bar.view
658 .bar.view add command -label [mc "New view..."] -command {newview 0}
659 .bar.view add command -label [mc "Edit view..."] -command editview \
660 -state disabled
661 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
662 .bar.view add separator
663 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
664 -variable selectedview -value 0
665
666 menu .bar.help
667 .bar add cascade -label [mc "Help"] -menu .bar.help
668 .bar.help add command -label [mc "About gitk"] -command about
669 .bar.help add command -label [mc "Key bindings"] -command keys
670 .bar.help configure
671 . configure -menu .bar
672
673 # the gui has upper and lower half, parts of a paned window.
674 panedwindow .ctop -orient vertical
675
676 # possibly use assumed geometry
677 if {![info exists geometry(pwsash0)]} {
678 set geometry(topheight) [expr {15 * $linespc}]
679 set geometry(topwidth) [expr {80 * $charspc}]
680 set geometry(botheight) [expr {15 * $linespc}]
681 set geometry(botwidth) [expr {50 * $charspc}]
682 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
683 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
684 }
685
686 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
687 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
688 frame .tf.histframe
689 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
690
691 # create three canvases
692 set cscroll .tf.histframe.csb
693 set canv .tf.histframe.pwclist.canv
694 canvas $canv \
695 -selectbackground $selectbgcolor \
696 -background $bgcolor -bd 0 \
697 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
698 .tf.histframe.pwclist add $canv
699 set canv2 .tf.histframe.pwclist.canv2
700 canvas $canv2 \
701 -selectbackground $selectbgcolor \
702 -background $bgcolor -bd 0 -yscrollincr $linespc
703 .tf.histframe.pwclist add $canv2
704 set canv3 .tf.histframe.pwclist.canv3
705 canvas $canv3 \
706 -selectbackground $selectbgcolor \
707 -background $bgcolor -bd 0 -yscrollincr $linespc
708 .tf.histframe.pwclist add $canv3
709 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
710 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
711
712 # a scroll bar to rule them
713 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
714 pack $cscroll -side right -fill y
715 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
716 lappend bglist $canv $canv2 $canv3
717 pack .tf.histframe.pwclist -fill both -expand 1 -side left
718
719 # we have two button bars at bottom of top frame. Bar 1
720 frame .tf.bar
721 frame .tf.lbar -height 15
722
723 set sha1entry .tf.bar.sha1
724 set entries $sha1entry
725 set sha1but .tf.bar.sha1label
726 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
727 -command gotocommit -width 8
728 $sha1but conf -disabledforeground [$sha1but cget -foreground]
729 pack .tf.bar.sha1label -side left
730 entry $sha1entry -width 40 -font textfont -textvariable sha1string
731 trace add variable sha1string write sha1change
732 pack $sha1entry -side left -pady 2
733
734 image create bitmap bm-left -data {
735 #define left_width 16
736 #define left_height 16
737 static unsigned char left_bits[] = {
738 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
739 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
740 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
741 }
742 image create bitmap bm-right -data {
743 #define right_width 16
744 #define right_height 16
745 static unsigned char right_bits[] = {
746 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
747 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
748 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
749 }
750 button .tf.bar.leftbut -image bm-left -command goback \
751 -state disabled -width 26
752 pack .tf.bar.leftbut -side left -fill y
753 button .tf.bar.rightbut -image bm-right -command goforw \
754 -state disabled -width 26
755 pack .tf.bar.rightbut -side left -fill y
756
757 # Status label and progress bar
758 set statusw .tf.bar.status
759 label $statusw -width 15 -relief sunken
760 pack $statusw -side left -padx 5
761 set h [expr {[font metrics uifont -linespace] + 2}]
762 set progresscanv .tf.bar.progress
763 canvas $progresscanv -relief sunken -height $h -borderwidth 2
764 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
765 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
766 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
767 pack $progresscanv -side right -expand 1 -fill x
768 set progresscoords {0 0}
769 set fprogcoord 0
770 set rprogcoord 0
771 bind $progresscanv <Configure> adjustprogress
772 set lastprogupdate [clock clicks -milliseconds]
773 set progupdatepending 0
774
775 # build up the bottom bar of upper window
776 label .tf.lbar.flabel -text "[mc "Find"] "
777 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
778 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
779 label .tf.lbar.flab2 -text " [mc "commit"] "
780 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
781 -side left -fill y
782 set gdttype [mc "containing:"]
783 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
784 [mc "containing:"] \
785 [mc "touching paths:"] \
786 [mc "adding/removing string:"]]
787 trace add variable gdttype write gdttype_change
788 pack .tf.lbar.gdttype -side left -fill y
789
790 set findstring {}
791 set fstring .tf.lbar.findstring
792 lappend entries $fstring
793 entry $fstring -width 30 -font textfont -textvariable findstring
794 trace add variable findstring write find_change
795 set findtype [mc "Exact"]
796 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
797 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
798 trace add variable findtype write findcom_change
799 set findloc [mc "All fields"]
800 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
801 [mc "Comments"] [mc "Author"] [mc "Committer"]
802 trace add variable findloc write find_change
803 pack .tf.lbar.findloc -side right
804 pack .tf.lbar.findtype -side right
805 pack $fstring -side left -expand 1 -fill x
806
807 # Finish putting the upper half of the viewer together
808 pack .tf.lbar -in .tf -side bottom -fill x
809 pack .tf.bar -in .tf -side bottom -fill x
810 pack .tf.histframe -fill both -side top -expand 1
811 .ctop add .tf
812 .ctop paneconfigure .tf -height $geometry(topheight)
813 .ctop paneconfigure .tf -width $geometry(topwidth)
814
815 # now build up the bottom
816 panedwindow .pwbottom -orient horizontal
817
818 # lower left, a text box over search bar, scroll bar to the right
819 # if we know window height, then that will set the lower text height, otherwise
820 # we set lower text height which will drive window height
821 if {[info exists geometry(main)]} {
822 frame .bleft -width $geometry(botwidth)
823 } else {
824 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
825 }
826 frame .bleft.top
827 frame .bleft.mid
828
829 button .bleft.top.search -text [mc "Search"] -command dosearch
830 pack .bleft.top.search -side left -padx 5
831 set sstring .bleft.top.sstring
832 entry $sstring -width 20 -font textfont -textvariable searchstring
833 lappend entries $sstring
834 trace add variable searchstring write incrsearch
835 pack $sstring -side left -expand 1 -fill x
836 radiobutton .bleft.mid.diff -text [mc "Diff"] \
837 -command changediffdisp -variable diffelide -value {0 0}
838 radiobutton .bleft.mid.old -text [mc "Old version"] \
839 -command changediffdisp -variable diffelide -value {0 1}
840 radiobutton .bleft.mid.new -text [mc "New version"] \
841 -command changediffdisp -variable diffelide -value {1 0}
842 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
843 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
844 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
845 -from 1 -increment 1 -to 10000000 \
846 -validate all -validatecommand "diffcontextvalidate %P" \
847 -textvariable diffcontextstring
848 .bleft.mid.diffcontext set $diffcontext
849 trace add variable diffcontextstring write diffcontextchange
850 lappend entries .bleft.mid.diffcontext
851 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
852 set ctext .bleft.ctext
853 text $ctext -background $bgcolor -foreground $fgcolor \
854 -state disabled -font textfont \
855 -yscrollcommand scrolltext -wrap none
856 if {$have_tk85} {
857 $ctext conf -tabstyle wordprocessor
858 }
859 scrollbar .bleft.sb -command "$ctext yview"
860 pack .bleft.top -side top -fill x
861 pack .bleft.mid -side top -fill x
862 pack .bleft.sb -side right -fill y
863 pack $ctext -side left -fill both -expand 1
864 lappend bglist $ctext
865 lappend fglist $ctext
866
867 $ctext tag conf comment -wrap $wrapcomment
868 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
869 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
870 $ctext tag conf d0 -fore [lindex $diffcolors 0]
871 $ctext tag conf d1 -fore [lindex $diffcolors 1]
872 $ctext tag conf m0 -fore red
873 $ctext tag conf m1 -fore blue
874 $ctext tag conf m2 -fore green
875 $ctext tag conf m3 -fore purple
876 $ctext tag conf m4 -fore brown
877 $ctext tag conf m5 -fore "#009090"
878 $ctext tag conf m6 -fore magenta
879 $ctext tag conf m7 -fore "#808000"
880 $ctext tag conf m8 -fore "#009000"
881 $ctext tag conf m9 -fore "#ff0080"
882 $ctext tag conf m10 -fore cyan
883 $ctext tag conf m11 -fore "#b07070"
884 $ctext tag conf m12 -fore "#70b0f0"
885 $ctext tag conf m13 -fore "#70f0b0"
886 $ctext tag conf m14 -fore "#f0b070"
887 $ctext tag conf m15 -fore "#ff70b0"
888 $ctext tag conf mmax -fore darkgrey
889 set mergemax 16
890 $ctext tag conf mresult -font textfontbold
891 $ctext tag conf msep -font textfontbold
892 $ctext tag conf found -back yellow
893
894 .pwbottom add .bleft
895 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
896
897 # lower right
898 frame .bright
899 frame .bright.mode
900 radiobutton .bright.mode.patch -text [mc "Patch"] \
901 -command reselectline -variable cmitmode -value "patch"
902 radiobutton .bright.mode.tree -text [mc "Tree"] \
903 -command reselectline -variable cmitmode -value "tree"
904 grid .bright.mode.patch .bright.mode.tree -sticky ew
905 pack .bright.mode -side top -fill x
906 set cflist .bright.cfiles
907 set indent [font measure mainfont "nn"]
908 text $cflist \
909 -selectbackground $selectbgcolor \
910 -background $bgcolor -foreground $fgcolor \
911 -font mainfont \
912 -tabs [list $indent [expr {2 * $indent}]] \
913 -yscrollcommand ".bright.sb set" \
914 -cursor [. cget -cursor] \
915 -spacing1 1 -spacing3 1
916 lappend bglist $cflist
917 lappend fglist $cflist
918 scrollbar .bright.sb -command "$cflist yview"
919 pack .bright.sb -side right -fill y
920 pack $cflist -side left -fill both -expand 1
921 $cflist tag configure highlight \
922 -background [$cflist cget -selectbackground]
923 $cflist tag configure bold -font mainfontbold
924
925 .pwbottom add .bright
926 .ctop add .pwbottom
927
928 # restore window position if known
929 if {[info exists geometry(main)]} {
930 wm geometry . "$geometry(main)"
931 }
932
933 if {[tk windowingsystem] eq {aqua}} {
934 set M1B M1
935 } else {
936 set M1B Control
937 }
938
939 bind .pwbottom <Configure> {resizecdetpanes %W %w}
940 pack .ctop -fill both -expand 1
941 bindall <1> {selcanvline %W %x %y}
942 #bindall <B1-Motion> {selcanvline %W %x %y}
943 if {[tk windowingsystem] == "win32"} {
944 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
945 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
946 } else {
947 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
948 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
949 if {[tk windowingsystem] eq "aqua"} {
950 bindall <MouseWheel> {
951 set delta [expr {- (%D)}]
952 allcanvs yview scroll $delta units
953 }
954 }
955 }
956 bindall <2> "canvscan mark %W %x %y"
957 bindall <B2-Motion> "canvscan dragto %W %x %y"
958 bindkey <Home> selfirstline
959 bindkey <End> sellastline
960 bind . <Key-Up> "selnextline -1"
961 bind . <Key-Down> "selnextline 1"
962 bind . <Shift-Key-Up> "dofind -1 0"
963 bind . <Shift-Key-Down> "dofind 1 0"
964 bindkey <Key-Right> "goforw"
965 bindkey <Key-Left> "goback"
966 bind . <Key-Prior> "selnextpage -1"
967 bind . <Key-Next> "selnextpage 1"
968 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
969 bind . <$M1B-End> "allcanvs yview moveto 1.0"
970 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
971 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
972 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
973 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
974 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
975 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
976 bindkey <Key-space> "$ctext yview scroll 1 pages"
977 bindkey p "selnextline -1"
978 bindkey n "selnextline 1"
979 bindkey z "goback"
980 bindkey x "goforw"
981 bindkey i "selnextline -1"
982 bindkey k "selnextline 1"
983 bindkey j "goback"
984 bindkey l "goforw"
985 bindkey b "$ctext yview scroll -1 pages"
986 bindkey d "$ctext yview scroll 18 units"
987 bindkey u "$ctext yview scroll -18 units"
988 bindkey / {dofind 1 1}
989 bindkey <Key-Return> {dofind 1 1}
990 bindkey ? {dofind -1 1}
991 bindkey f nextfile
992 bindkey <F5> updatecommits
993 bind . <$M1B-q> doquit
994 bind . <$M1B-f> {dofind 1 1}
995 bind . <$M1B-g> {dofind 1 0}
996 bind . <$M1B-r> dosearchback
997 bind . <$M1B-s> dosearch
998 bind . <$M1B-equal> {incrfont 1}
999 bind . <$M1B-plus> {incrfont 1}
1000 bind . <$M1B-KP_Add> {incrfont 1}
1001 bind . <$M1B-minus> {incrfont -1}
1002 bind . <$M1B-KP_Subtract> {incrfont -1}
1003 wm protocol . WM_DELETE_WINDOW doquit
1004 bind . <Button-1> "click %W"
1005 bind $fstring <Key-Return> {dofind 1 1}
1006 bind $sha1entry <Key-Return> gotocommit
1007 bind $sha1entry <<PasteSelection>> clearsha1
1008 bind $cflist <1> {sel_flist %W %x %y; break}
1009 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1010 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1011 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1012
1013 set maincursor [. cget -cursor]
1014 set textcursor [$ctext cget -cursor]
1015 set curtextcursor $textcursor
1016
1017 set rowctxmenu .rowctxmenu
1018 menu $rowctxmenu -tearoff 0
1019 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1020 -command {diffvssel 0}
1021 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1022 -command {diffvssel 1}
1023 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1024 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1025 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1026 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1027 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1028 -command cherrypick
1029 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1030 -command resethead
1031
1032 set fakerowmenu .fakerowmenu
1033 menu $fakerowmenu -tearoff 0
1034 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1035 -command {diffvssel 0}
1036 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1037 -command {diffvssel 1}
1038 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1039 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1040 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1041 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1042
1043 set headctxmenu .headctxmenu
1044 menu $headctxmenu -tearoff 0
1045 $headctxmenu add command -label [mc "Check out this branch"] \
1046 -command cobranch
1047 $headctxmenu add command -label [mc "Remove this branch"] \
1048 -command rmbranch
1049
1050 global flist_menu
1051 set flist_menu .flistctxmenu
1052 menu $flist_menu -tearoff 0
1053 $flist_menu add command -label [mc "Highlight this too"] \
1054 -command {flist_hl 0}
1055 $flist_menu add command -label [mc "Highlight this only"] \
1056 -command {flist_hl 1}
1057 }
1058
1059 # Windows sends all mouse wheel events to the current focused window, not
1060 # the one where the mouse hovers, so bind those events here and redirect
1061 # to the correct window
1062 proc windows_mousewheel_redirector {W X Y D} {
1063 global canv canv2 canv3
1064 set w [winfo containing -displayof $W $X $Y]
1065 if {$w ne ""} {
1066 set u [expr {$D < 0 ? 5 : -5}]
1067 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1068 allcanvs yview scroll $u units
1069 } else {
1070 catch {
1071 $w yview scroll $u units
1072 }
1073 }
1074 }
1075 }
1076
1077 # mouse-2 makes all windows scan vertically, but only the one
1078 # the cursor is in scans horizontally
1079 proc canvscan {op w x y} {
1080 global canv canv2 canv3
1081 foreach c [list $canv $canv2 $canv3] {
1082 if {$c == $w} {
1083 $c scan $op $x $y
1084 } else {
1085 $c scan $op 0 $y
1086 }
1087 }
1088 }
1089
1090 proc scrollcanv {cscroll f0 f1} {
1091 $cscroll set $f0 $f1
1092 drawfrac $f0 $f1
1093 flushhighlights
1094 }
1095
1096 # when we make a key binding for the toplevel, make sure
1097 # it doesn't get triggered when that key is pressed in the
1098 # find string entry widget.
1099 proc bindkey {ev script} {
1100 global entries
1101 bind . $ev $script
1102 set escript [bind Entry $ev]
1103 if {$escript == {}} {
1104 set escript [bind Entry <Key>]
1105 }
1106 foreach e $entries {
1107 bind $e $ev "$escript; break"
1108 }
1109 }
1110
1111 # set the focus back to the toplevel for any click outside
1112 # the entry widgets
1113 proc click {w} {
1114 global ctext entries
1115 foreach e [concat $entries $ctext] {
1116 if {$w == $e} return
1117 }
1118 focus .
1119 }
1120
1121 # Adjust the progress bar for a change in requested extent or canvas size
1122 proc adjustprogress {} {
1123 global progresscanv progressitem progresscoords
1124 global fprogitem fprogcoord lastprogupdate progupdatepending
1125 global rprogitem rprogcoord
1126
1127 set w [expr {[winfo width $progresscanv] - 4}]
1128 set x0 [expr {$w * [lindex $progresscoords 0]}]
1129 set x1 [expr {$w * [lindex $progresscoords 1]}]
1130 set h [winfo height $progresscanv]
1131 $progresscanv coords $progressitem $x0 0 $x1 $h
1132 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1133 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1134 set now [clock clicks -milliseconds]
1135 if {$now >= $lastprogupdate + 100} {
1136 set progupdatepending 0
1137 update
1138 } elseif {!$progupdatepending} {
1139 set progupdatepending 1
1140 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1141 }
1142 }
1143
1144 proc doprogupdate {} {
1145 global lastprogupdate progupdatepending
1146
1147 if {$progupdatepending} {
1148 set progupdatepending 0
1149 set lastprogupdate [clock clicks -milliseconds]
1150 update
1151 }
1152 }
1153
1154 proc savestuff {w} {
1155 global canv canv2 canv3 mainfont textfont uifont tabstop
1156 global stuffsaved findmergefiles maxgraphpct
1157 global maxwidth showneartags showlocalchanges
1158 global viewname viewfiles viewargs viewperm nextviewnum
1159 global cmitmode wrapcomment datetimeformat limitdiffs
1160 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1161
1162 if {$stuffsaved} return
1163 if {![winfo viewable .]} return
1164 catch {
1165 set f [open "~/.gitk-new" w]
1166 puts $f [list set mainfont $mainfont]
1167 puts $f [list set textfont $textfont]
1168 puts $f [list set uifont $uifont]
1169 puts $f [list set tabstop $tabstop]
1170 puts $f [list set findmergefiles $findmergefiles]
1171 puts $f [list set maxgraphpct $maxgraphpct]
1172 puts $f [list set maxwidth $maxwidth]
1173 puts $f [list set cmitmode $cmitmode]
1174 puts $f [list set wrapcomment $wrapcomment]
1175 puts $f [list set showneartags $showneartags]
1176 puts $f [list set showlocalchanges $showlocalchanges]
1177 puts $f [list set datetimeformat $datetimeformat]
1178 puts $f [list set limitdiffs $limitdiffs]
1179 puts $f [list set bgcolor $bgcolor]
1180 puts $f [list set fgcolor $fgcolor]
1181 puts $f [list set colors $colors]
1182 puts $f [list set diffcolors $diffcolors]
1183 puts $f [list set diffcontext $diffcontext]
1184 puts $f [list set selectbgcolor $selectbgcolor]
1185
1186 puts $f "set geometry(main) [wm geometry .]"
1187 puts $f "set geometry(topwidth) [winfo width .tf]"
1188 puts $f "set geometry(topheight) [winfo height .tf]"
1189 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1190 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1191 puts $f "set geometry(botwidth) [winfo width .bleft]"
1192 puts $f "set geometry(botheight) [winfo height .bleft]"
1193
1194 puts -nonewline $f "set permviews {"
1195 for {set v 0} {$v < $nextviewnum} {incr v} {
1196 if {$viewperm($v)} {
1197 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1198 }
1199 }
1200 puts $f "}"
1201 close $f
1202 file rename -force "~/.gitk-new" "~/.gitk"
1203 }
1204 set stuffsaved 1
1205 }
1206
1207 proc resizeclistpanes {win w} {
1208 global oldwidth
1209 if {[info exists oldwidth($win)]} {
1210 set s0 [$win sash coord 0]
1211 set s1 [$win sash coord 1]
1212 if {$w < 60} {
1213 set sash0 [expr {int($w/2 - 2)}]
1214 set sash1 [expr {int($w*5/6 - 2)}]
1215 } else {
1216 set factor [expr {1.0 * $w / $oldwidth($win)}]
1217 set sash0 [expr {int($factor * [lindex $s0 0])}]
1218 set sash1 [expr {int($factor * [lindex $s1 0])}]
1219 if {$sash0 < 30} {
1220 set sash0 30
1221 }
1222 if {$sash1 < $sash0 + 20} {
1223 set sash1 [expr {$sash0 + 20}]
1224 }
1225 if {$sash1 > $w - 10} {
1226 set sash1 [expr {$w - 10}]
1227 if {$sash0 > $sash1 - 20} {
1228 set sash0 [expr {$sash1 - 20}]
1229 }
1230 }
1231 }
1232 $win sash place 0 $sash0 [lindex $s0 1]
1233 $win sash place 1 $sash1 [lindex $s1 1]
1234 }
1235 set oldwidth($win) $w
1236 }
1237
1238 proc resizecdetpanes {win w} {
1239 global oldwidth
1240 if {[info exists oldwidth($win)]} {
1241 set s0 [$win sash coord 0]
1242 if {$w < 60} {
1243 set sash0 [expr {int($w*3/4 - 2)}]
1244 } else {
1245 set factor [expr {1.0 * $w / $oldwidth($win)}]
1246 set sash0 [expr {int($factor * [lindex $s0 0])}]
1247 if {$sash0 < 45} {
1248 set sash0 45
1249 }
1250 if {$sash0 > $w - 15} {
1251 set sash0 [expr {$w - 15}]
1252 }
1253 }
1254 $win sash place 0 $sash0 [lindex $s0 1]
1255 }
1256 set oldwidth($win) $w
1257 }
1258
1259 proc allcanvs args {
1260 global canv canv2 canv3
1261 eval $canv $args
1262 eval $canv2 $args
1263 eval $canv3 $args
1264 }
1265
1266 proc bindall {event action} {
1267 global canv canv2 canv3
1268 bind $canv $event $action
1269 bind $canv2 $event $action
1270 bind $canv3 $event $action
1271 }
1272
1273 proc about {} {
1274 global uifont
1275 set w .about
1276 if {[winfo exists $w]} {
1277 raise $w
1278 return
1279 }
1280 toplevel $w
1281 wm title $w [mc "About gitk"]
1282 message $w.m -text [mc "
1283 Gitk - a commit viewer for git
1284
1285 Copyright © 2005-2006 Paul Mackerras
1286
1287 Use and redistribute under the terms of the GNU General Public License"] \
1288 -justify center -aspect 400 -border 2 -bg white -relief groove
1289 pack $w.m -side top -fill x -padx 2 -pady 2
1290 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1291 pack $w.ok -side bottom
1292 bind $w <Visibility> "focus $w.ok"
1293 bind $w <Key-Escape> "destroy $w"
1294 bind $w <Key-Return> "destroy $w"
1295 }
1296
1297 proc keys {} {
1298 set w .keys
1299 if {[winfo exists $w]} {
1300 raise $w
1301 return
1302 }
1303 if {[tk windowingsystem] eq {aqua}} {
1304 set M1T Cmd
1305 } else {
1306 set M1T Ctrl
1307 }
1308 toplevel $w
1309 wm title $w [mc "Gitk key bindings"]
1310 message $w.m -text [mc "
1311 Gitk key bindings:
1312
1313 <$M1T-Q> Quit
1314 <Home> Move to first commit
1315 <End> Move to last commit
1316 <Up>, p, i Move up one commit
1317 <Down>, n, k Move down one commit
1318 <Left>, z, j Go back in history list
1319 <Right>, x, l Go forward in history list
1320 <PageUp> Move up one page in commit list
1321 <PageDown> Move down one page in commit list
1322 <$M1T-Home> Scroll to top of commit list
1323 <$M1T-End> Scroll to bottom of commit list
1324 <$M1T-Up> Scroll commit list up one line
1325 <$M1T-Down> Scroll commit list down one line
1326 <$M1T-PageUp> Scroll commit list up one page
1327 <$M1T-PageDown> Scroll commit list down one page
1328 <Shift-Up> Find backwards (upwards, later commits)
1329 <Shift-Down> Find forwards (downwards, earlier commits)
1330 <Delete>, b Scroll diff view up one page
1331 <Backspace> Scroll diff view up one page
1332 <Space> Scroll diff view down one page
1333 u Scroll diff view up 18 lines
1334 d Scroll diff view down 18 lines
1335 <$M1T-F> Find
1336 <$M1T-G> Move to next find hit
1337 <Return> Move to next find hit
1338 / Move to next find hit, or redo find
1339 ? Move to previous find hit
1340 f Scroll diff view to next file
1341 <$M1T-S> Search for next hit in diff view
1342 <$M1T-R> Search for previous hit in diff view
1343 <$M1T-KP+> Increase font size
1344 <$M1T-plus> Increase font size
1345 <$M1T-KP-> Decrease font size
1346 <$M1T-minus> Decrease font size
1347 <F5> Update
1348 "] \
1349 -justify left -bg white -border 2 -relief groove
1350 pack $w.m -side top -fill both -padx 2 -pady 2
1351 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1352 pack $w.ok -side bottom
1353 bind $w <Visibility> "focus $w.ok"
1354 bind $w <Key-Escape> "destroy $w"
1355 bind $w <Key-Return> "destroy $w"
1356 }
1357
1358 # Procedures for manipulating the file list window at the
1359 # bottom right of the overall window.
1360
1361 proc treeview {w l openlevs} {
1362 global treecontents treediropen treeheight treeparent treeindex
1363
1364 set ix 0
1365 set treeindex() 0
1366 set lev 0
1367 set prefix {}
1368 set prefixend -1
1369 set prefendstack {}
1370 set htstack {}
1371 set ht 0
1372 set treecontents() {}
1373 $w conf -state normal
1374 foreach f $l {
1375 while {[string range $f 0 $prefixend] ne $prefix} {
1376 if {$lev <= $openlevs} {
1377 $w mark set e:$treeindex($prefix) "end -1c"
1378 $w mark gravity e:$treeindex($prefix) left
1379 }
1380 set treeheight($prefix) $ht
1381 incr ht [lindex $htstack end]
1382 set htstack [lreplace $htstack end end]
1383 set prefixend [lindex $prefendstack end]
1384 set prefendstack [lreplace $prefendstack end end]
1385 set prefix [string range $prefix 0 $prefixend]
1386 incr lev -1
1387 }
1388 set tail [string range $f [expr {$prefixend+1}] end]
1389 while {[set slash [string first "/" $tail]] >= 0} {
1390 lappend htstack $ht
1391 set ht 0
1392 lappend prefendstack $prefixend
1393 incr prefixend [expr {$slash + 1}]
1394 set d [string range $tail 0 $slash]
1395 lappend treecontents($prefix) $d
1396 set oldprefix $prefix
1397 append prefix $d
1398 set treecontents($prefix) {}
1399 set treeindex($prefix) [incr ix]
1400 set treeparent($prefix) $oldprefix
1401 set tail [string range $tail [expr {$slash+1}] end]
1402 if {$lev <= $openlevs} {
1403 set ht 1
1404 set treediropen($prefix) [expr {$lev < $openlevs}]
1405 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1406 $w mark set d:$ix "end -1c"
1407 $w mark gravity d:$ix left
1408 set str "\n"
1409 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1410 $w insert end $str
1411 $w image create end -align center -image $bm -padx 1 \
1412 -name a:$ix
1413 $w insert end $d [highlight_tag $prefix]
1414 $w mark set s:$ix "end -1c"
1415 $w mark gravity s:$ix left
1416 }
1417 incr lev
1418 }
1419 if {$tail ne {}} {
1420 if {$lev <= $openlevs} {
1421 incr ht
1422 set str "\n"
1423 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1424 $w insert end $str
1425 $w insert end $tail [highlight_tag $f]
1426 }
1427 lappend treecontents($prefix) $tail
1428 }
1429 }
1430 while {$htstack ne {}} {
1431 set treeheight($prefix) $ht
1432 incr ht [lindex $htstack end]
1433 set htstack [lreplace $htstack end end]
1434 set prefixend [lindex $prefendstack end]
1435 set prefendstack [lreplace $prefendstack end end]
1436 set prefix [string range $prefix 0 $prefixend]
1437 }
1438 $w conf -state disabled
1439 }
1440
1441 proc linetoelt {l} {
1442 global treeheight treecontents
1443
1444 set y 2
1445 set prefix {}
1446 while {1} {
1447 foreach e $treecontents($prefix) {
1448 if {$y == $l} {
1449 return "$prefix$e"
1450 }
1451 set n 1
1452 if {[string index $e end] eq "/"} {
1453 set n $treeheight($prefix$e)
1454 if {$y + $n > $l} {
1455 append prefix $e
1456 incr y
1457 break
1458 }
1459 }
1460 incr y $n
1461 }
1462 }
1463 }
1464
1465 proc highlight_tree {y prefix} {
1466 global treeheight treecontents cflist
1467
1468 foreach e $treecontents($prefix) {
1469 set path $prefix$e
1470 if {[highlight_tag $path] ne {}} {
1471 $cflist tag add bold $y.0 "$y.0 lineend"
1472 }
1473 incr y
1474 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1475 set y [highlight_tree $y $path]
1476 }
1477 }
1478 return $y
1479 }
1480
1481 proc treeclosedir {w dir} {
1482 global treediropen treeheight treeparent treeindex
1483
1484 set ix $treeindex($dir)
1485 $w conf -state normal
1486 $w delete s:$ix e:$ix
1487 set treediropen($dir) 0
1488 $w image configure a:$ix -image tri-rt
1489 $w conf -state disabled
1490 set n [expr {1 - $treeheight($dir)}]
1491 while {$dir ne {}} {
1492 incr treeheight($dir) $n
1493 set dir $treeparent($dir)
1494 }
1495 }
1496
1497 proc treeopendir {w dir} {
1498 global treediropen treeheight treeparent treecontents treeindex
1499
1500 set ix $treeindex($dir)
1501 $w conf -state normal
1502 $w image configure a:$ix -image tri-dn
1503 $w mark set e:$ix s:$ix
1504 $w mark gravity e:$ix right
1505 set lev 0
1506 set str "\n"
1507 set n [llength $treecontents($dir)]
1508 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1509 incr lev
1510 append str "\t"
1511 incr treeheight($x) $n
1512 }
1513 foreach e $treecontents($dir) {
1514 set de $dir$e
1515 if {[string index $e end] eq "/"} {
1516 set iy $treeindex($de)
1517 $w mark set d:$iy e:$ix
1518 $w mark gravity d:$iy left
1519 $w insert e:$ix $str
1520 set treediropen($de) 0
1521 $w image create e:$ix -align center -image tri-rt -padx 1 \
1522 -name a:$iy
1523 $w insert e:$ix $e [highlight_tag $de]
1524 $w mark set s:$iy e:$ix
1525 $w mark gravity s:$iy left
1526 set treeheight($de) 1
1527 } else {
1528 $w insert e:$ix $str
1529 $w insert e:$ix $e [highlight_tag $de]
1530 }
1531 }
1532 $w mark gravity e:$ix left
1533 $w conf -state disabled
1534 set treediropen($dir) 1
1535 set top [lindex [split [$w index @0,0] .] 0]
1536 set ht [$w cget -height]
1537 set l [lindex [split [$w index s:$ix] .] 0]
1538 if {$l < $top} {
1539 $w yview $l.0
1540 } elseif {$l + $n + 1 > $top + $ht} {
1541 set top [expr {$l + $n + 2 - $ht}]
1542 if {$l < $top} {
1543 set top $l
1544 }
1545 $w yview $top.0
1546 }
1547 }
1548
1549 proc treeclick {w x y} {
1550 global treediropen cmitmode ctext cflist cflist_top
1551
1552 if {$cmitmode ne "tree"} return
1553 if {![info exists cflist_top]} return
1554 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1555 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1556 $cflist tag add highlight $l.0 "$l.0 lineend"
1557 set cflist_top $l
1558 if {$l == 1} {
1559 $ctext yview 1.0
1560 return
1561 }
1562 set e [linetoelt $l]
1563 if {[string index $e end] ne "/"} {
1564 showfile $e
1565 } elseif {$treediropen($e)} {
1566 treeclosedir $w $e
1567 } else {
1568 treeopendir $w $e
1569 }
1570 }
1571
1572 proc setfilelist {id} {
1573 global treefilelist cflist
1574
1575 treeview $cflist $treefilelist($id) 0
1576 }
1577
1578 image create bitmap tri-rt -background black -foreground blue -data {
1579 #define tri-rt_width 13
1580 #define tri-rt_height 13
1581 static unsigned char tri-rt_bits[] = {
1582 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1583 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1584 0x00, 0x00};
1585 } -maskdata {
1586 #define tri-rt-mask_width 13
1587 #define tri-rt-mask_height 13
1588 static unsigned char tri-rt-mask_bits[] = {
1589 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1590 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1591 0x08, 0x00};
1592 }
1593 image create bitmap tri-dn -background black -foreground blue -data {
1594 #define tri-dn_width 13
1595 #define tri-dn_height 13
1596 static unsigned char tri-dn_bits[] = {
1597 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1598 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1599 0x00, 0x00};
1600 } -maskdata {
1601 #define tri-dn-mask_width 13
1602 #define tri-dn-mask_height 13
1603 static unsigned char tri-dn-mask_bits[] = {
1604 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1605 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1606 0x00, 0x00};
1607 }
1608
1609 image create bitmap reficon-T -background black -foreground yellow -data {
1610 #define tagicon_width 13
1611 #define tagicon_height 9
1612 static unsigned char tagicon_bits[] = {
1613 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1614 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1615 } -maskdata {
1616 #define tagicon-mask_width 13
1617 #define tagicon-mask_height 9
1618 static unsigned char tagicon-mask_bits[] = {
1619 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1620 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1621 }
1622 set rectdata {
1623 #define headicon_width 13
1624 #define headicon_height 9
1625 static unsigned char headicon_bits[] = {
1626 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1627 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1628 }
1629 set rectmask {
1630 #define headicon-mask_width 13
1631 #define headicon-mask_height 9
1632 static unsigned char headicon-mask_bits[] = {
1633 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1634 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1635 }
1636 image create bitmap reficon-H -background black -foreground green \
1637 -data $rectdata -maskdata $rectmask
1638 image create bitmap reficon-o -background black -foreground "#ddddff" \
1639 -data $rectdata -maskdata $rectmask
1640
1641 proc init_flist {first} {
1642 global cflist cflist_top selectedline difffilestart
1643
1644 $cflist conf -state normal
1645 $cflist delete 0.0 end
1646 if {$first ne {}} {
1647 $cflist insert end $first
1648 set cflist_top 1
1649 $cflist tag add highlight 1.0 "1.0 lineend"
1650 } else {
1651 catch {unset cflist_top}
1652 }
1653 $cflist conf -state disabled
1654 set difffilestart {}
1655 }
1656
1657 proc highlight_tag {f} {
1658 global highlight_paths
1659
1660 foreach p $highlight_paths {
1661 if {[string match $p $f]} {
1662 return "bold"
1663 }
1664 }
1665 return {}
1666 }
1667
1668 proc highlight_filelist {} {
1669 global cmitmode cflist
1670
1671 $cflist conf -state normal
1672 if {$cmitmode ne "tree"} {
1673 set end [lindex [split [$cflist index end] .] 0]
1674 for {set l 2} {$l < $end} {incr l} {
1675 set line [$cflist get $l.0 "$l.0 lineend"]
1676 if {[highlight_tag $line] ne {}} {
1677 $cflist tag add bold $l.0 "$l.0 lineend"
1678 }
1679 }
1680 } else {
1681 highlight_tree 2 {}
1682 }
1683 $cflist conf -state disabled
1684 }
1685
1686 proc unhighlight_filelist {} {
1687 global cflist
1688
1689 $cflist conf -state normal
1690 $cflist tag remove bold 1.0 end
1691 $cflist conf -state disabled
1692 }
1693
1694 proc add_flist {fl} {
1695 global cflist
1696
1697 $cflist conf -state normal
1698 foreach f $fl {
1699 $cflist insert end "\n"
1700 $cflist insert end $f [highlight_tag $f]
1701 }
1702 $cflist conf -state disabled
1703 }
1704
1705 proc sel_flist {w x y} {
1706 global ctext difffilestart cflist cflist_top cmitmode
1707
1708 if {$cmitmode eq "tree"} return
1709 if {![info exists cflist_top]} return
1710 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1711 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1712 $cflist tag add highlight $l.0 "$l.0 lineend"
1713 set cflist_top $l
1714 if {$l == 1} {
1715 $ctext yview 1.0
1716 } else {
1717 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1718 }
1719 }
1720
1721 proc pop_flist_menu {w X Y x y} {
1722 global ctext cflist cmitmode flist_menu flist_menu_file
1723 global treediffs diffids
1724
1725 stopfinding
1726 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1727 if {$l <= 1} return
1728 if {$cmitmode eq "tree"} {
1729 set e [linetoelt $l]
1730 if {[string index $e end] eq "/"} return
1731 } else {
1732 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1733 }
1734 set flist_menu_file $e
1735 tk_popup $flist_menu $X $Y
1736 }
1737
1738 proc flist_hl {only} {
1739 global flist_menu_file findstring gdttype
1740
1741 set x [shellquote $flist_menu_file]
1742 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1743 set findstring $x
1744 } else {
1745 append findstring " " $x
1746 }
1747 set gdttype [mc "touching paths:"]
1748 }
1749
1750 # Functions for adding and removing shell-type quoting
1751
1752 proc shellquote {str} {
1753 if {![string match "*\['\"\\ \t]*" $str]} {
1754 return $str
1755 }
1756 if {![string match "*\['\"\\]*" $str]} {
1757 return "\"$str\""
1758 }
1759 if {![string match "*'*" $str]} {
1760 return "'$str'"
1761 }
1762 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1763 }
1764
1765 proc shellarglist {l} {
1766 set str {}
1767 foreach a $l {
1768 if {$str ne {}} {
1769 append str " "
1770 }
1771 append str [shellquote $a]
1772 }
1773 return $str
1774 }
1775
1776 proc shelldequote {str} {
1777 set ret {}
1778 set used -1
1779 while {1} {
1780 incr used
1781 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1782 append ret [string range $str $used end]
1783 set used [string length $str]
1784 break
1785 }
1786 set first [lindex $first 0]
1787 set ch [string index $str $first]
1788 if {$first > $used} {
1789 append ret [string range $str $used [expr {$first - 1}]]
1790 set used $first
1791 }
1792 if {$ch eq " " || $ch eq "\t"} break
1793 incr used
1794 if {$ch eq "'"} {
1795 set first [string first "'" $str $used]
1796 if {$first < 0} {
1797 error "unmatched single-quote"
1798 }
1799 append ret [string range $str $used [expr {$first - 1}]]
1800 set used $first
1801 continue
1802 }
1803 if {$ch eq "\\"} {
1804 if {$used >= [string length $str]} {
1805 error "trailing backslash"
1806 }
1807 append ret [string index $str $used]
1808 continue
1809 }
1810 # here ch == "\""
1811 while {1} {
1812 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1813 error "unmatched double-quote"
1814 }
1815 set first [lindex $first 0]
1816 set ch [string index $str $first]
1817 if {$first > $used} {
1818 append ret [string range $str $used [expr {$first - 1}]]
1819 set used $first
1820 }
1821 if {$ch eq "\""} break
1822 incr used
1823 append ret [string index $str $used]
1824 incr used
1825 }
1826 }
1827 return [list $used $ret]
1828 }
1829
1830 proc shellsplit {str} {
1831 set l {}
1832 while {1} {
1833 set str [string trimleft $str]
1834 if {$str eq {}} break
1835 set dq [shelldequote $str]
1836 set n [lindex $dq 0]
1837 set word [lindex $dq 1]
1838 set str [string range $str $n end]
1839 lappend l $word
1840 }
1841 return $l
1842 }
1843
1844 # Code to implement multiple views
1845
1846 proc newview {ishighlight} {
1847 global nextviewnum newviewname newviewperm newishighlight
1848 global newviewargs revtreeargs
1849
1850 set newishighlight $ishighlight
1851 set top .gitkview
1852 if {[winfo exists $top]} {
1853 raise $top
1854 return
1855 }
1856 set newviewname($nextviewnum) "View $nextviewnum"
1857 set newviewperm($nextviewnum) 0
1858 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1859 vieweditor $top $nextviewnum [mc "Gitk view definition"]
1860 }
1861
1862 proc editview {} {
1863 global curview
1864 global viewname viewperm newviewname newviewperm
1865 global viewargs newviewargs
1866
1867 set top .gitkvedit-$curview
1868 if {[winfo exists $top]} {
1869 raise $top
1870 return
1871 }
1872 set newviewname($curview) $viewname($curview)
1873 set newviewperm($curview) $viewperm($curview)
1874 set newviewargs($curview) [shellarglist $viewargs($curview)]
1875 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1876 }
1877
1878 proc vieweditor {top n title} {
1879 global newviewname newviewperm viewfiles bgcolor
1880
1881 toplevel $top
1882 wm title $top $title
1883 label $top.nl -text [mc "Name"]
1884 entry $top.name -width 20 -textvariable newviewname($n)
1885 grid $top.nl $top.name -sticky w -pady 5
1886 checkbutton $top.perm -text [mc "Remember this view"] \
1887 -variable newviewperm($n)
1888 grid $top.perm - -pady 5 -sticky w
1889 message $top.al -aspect 1000 \
1890 -text [mc "Commits to include (arguments to git rev-list):"]
1891 grid $top.al - -sticky w -pady 5
1892 entry $top.args -width 50 -textvariable newviewargs($n) \
1893 -background $bgcolor
1894 grid $top.args - -sticky ew -padx 5
1895 message $top.l -aspect 1000 \
1896 -text [mc "Enter files and directories to include, one per line:"]
1897 grid $top.l - -sticky w
1898 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1899 if {[info exists viewfiles($n)]} {
1900 foreach f $viewfiles($n) {
1901 $top.t insert end $f
1902 $top.t insert end "\n"
1903 }
1904 $top.t delete {end - 1c} end
1905 $top.t mark set insert 0.0
1906 }
1907 grid $top.t - -sticky ew -padx 5
1908 frame $top.buts
1909 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1910 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1911 grid $top.buts.ok $top.buts.can
1912 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1913 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1914 grid $top.buts - -pady 10 -sticky ew
1915 focus $top.t
1916 }
1917
1918 proc doviewmenu {m first cmd op argv} {
1919 set nmenu [$m index end]
1920 for {set i $first} {$i <= $nmenu} {incr i} {
1921 if {[$m entrycget $i -command] eq $cmd} {
1922 eval $m $op $i $argv
1923 break
1924 }
1925 }
1926 }
1927
1928 proc allviewmenus {n op args} {
1929 # global viewhlmenu
1930
1931 doviewmenu .bar.view 5 [list showview $n] $op $args
1932 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1933 }
1934
1935 proc newviewok {top n} {
1936 global nextviewnum newviewperm newviewname newishighlight
1937 global viewname viewfiles viewperm selectedview curview
1938 global viewargs newviewargs viewhlmenu
1939
1940 if {[catch {
1941 set newargs [shellsplit $newviewargs($n)]
1942 } err]} {
1943 error_popup "[mc "Error in commit selection arguments:"] $err"
1944 wm raise $top
1945 focus $top
1946 return
1947 }
1948 set files {}
1949 foreach f [split [$top.t get 0.0 end] "\n"] {
1950 set ft [string trim $f]
1951 if {$ft ne {}} {
1952 lappend files $ft
1953 }
1954 }
1955 if {![info exists viewfiles($n)]} {
1956 # creating a new view
1957 incr nextviewnum
1958 set viewname($n) $newviewname($n)
1959 set viewperm($n) $newviewperm($n)
1960 set viewfiles($n) $files
1961 set viewargs($n) $newargs
1962 addviewmenu $n
1963 if {!$newishighlight} {
1964 run showview $n
1965 } else {
1966 run addvhighlight $n
1967 }
1968 } else {
1969 # editing an existing view
1970 set viewperm($n) $newviewperm($n)
1971 if {$newviewname($n) ne $viewname($n)} {
1972 set viewname($n) $newviewname($n)
1973 doviewmenu .bar.view 5 [list showview $n] \
1974 entryconf [list -label $viewname($n)]
1975 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1976 # entryconf [list -label $viewname($n) -value $viewname($n)]
1977 }
1978 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1979 set viewfiles($n) $files
1980 set viewargs($n) $newargs
1981 if {$curview == $n} {
1982 run updatecommits
1983 }
1984 }
1985 }
1986 catch {destroy $top}
1987 }
1988
1989 proc delview {} {
1990 global curview viewdata viewperm hlview selectedhlview
1991
1992 if {$curview == 0} return
1993 if {[info exists hlview] && $hlview == $curview} {
1994 set selectedhlview [mc "None"]
1995 unset hlview
1996 }
1997 allviewmenus $curview delete
1998 set viewdata($curview) {}
1999 set viewperm($curview) 0
2000 showview 0
2001 }
2002
2003 proc addviewmenu {n} {
2004 global viewname viewhlmenu
2005
2006 .bar.view add radiobutton -label $viewname($n) \
2007 -command [list showview $n] -variable selectedview -value $n
2008 #$viewhlmenu add radiobutton -label $viewname($n) \
2009 # -command [list addvhighlight $n] -variable selectedhlview
2010 }
2011
2012 proc flatten {var} {
2013 global $var
2014
2015 set ret {}
2016 foreach i [array names $var] {
2017 lappend ret $i [set $var\($i\)]
2018 }
2019 return $ret
2020 }
2021
2022 proc unflatten {var l} {
2023 global $var
2024
2025 catch {unset $var}
2026 foreach {i v} $l {
2027 set $var\($i\) $v
2028 }
2029 }
2030
2031 proc showview {n} {
2032 global curview viewdata viewfiles
2033 global displayorder parentlist rowidlist rowisopt rowfinal
2034 global colormap rowtextx commitrow nextcolor canvxmax
2035 global numcommits commitlisted
2036 global selectedline currentid canv canvy0
2037 global treediffs
2038 global pending_select phase
2039 global commitidx
2040 global commfd
2041 global selectedview selectfirst
2042 global vparentlist vdisporder vcmitlisted
2043 global hlview selectedhlview commitinterest
2044
2045 if {$n == $curview} return
2046 set selid {}
2047 if {[info exists selectedline]} {
2048 set selid $currentid
2049 set y [yc $selectedline]
2050 set ymax [lindex [$canv cget -scrollregion] 3]
2051 set span [$canv yview]
2052 set ytop [expr {[lindex $span 0] * $ymax}]
2053 set ybot [expr {[lindex $span 1] * $ymax}]
2054 if {$ytop < $y && $y < $ybot} {
2055 set yscreen [expr {$y - $ytop}]
2056 } else {
2057 set yscreen [expr {($ybot - $ytop) / 2}]
2058 }
2059 } elseif {[info exists pending_select]} {
2060 set selid $pending_select
2061 unset pending_select
2062 }
2063 unselectline
2064 normalline
2065 if {$curview >= 0} {
2066 set vparentlist($curview) $parentlist
2067 set vdisporder($curview) $displayorder
2068 set vcmitlisted($curview) $commitlisted
2069 if {$phase ne {} ||
2070 ![info exists viewdata($curview)] ||
2071 [lindex $viewdata($curview) 0] ne {}} {
2072 set viewdata($curview) \
2073 [list $phase $rowidlist $rowisopt $rowfinal]
2074 }
2075 }
2076 catch {unset treediffs}
2077 clear_display
2078 if {[info exists hlview] && $hlview == $n} {
2079 unset hlview
2080 set selectedhlview [mc "None"]
2081 }
2082 catch {unset commitinterest}
2083
2084 set curview $n
2085 set selectedview $n
2086 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2087 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2088
2089 run refill_reflist
2090 if {![info exists viewdata($n)]} {
2091 if {$selid ne {}} {
2092 set pending_select $selid
2093 }
2094 getcommits
2095 return
2096 }
2097
2098 set v $viewdata($n)
2099 set phase [lindex $v 0]
2100 set displayorder $vdisporder($n)
2101 set parentlist $vparentlist($n)
2102 set commitlisted $vcmitlisted($n)
2103 set rowidlist [lindex $v 1]
2104 set rowisopt [lindex $v 2]
2105 set rowfinal [lindex $v 3]
2106 set numcommits $commitidx($n)
2107
2108 catch {unset colormap}
2109 catch {unset rowtextx}
2110 set nextcolor 0
2111 set canvxmax [$canv cget -width]
2112 set curview $n
2113 set row 0
2114 setcanvscroll
2115 set yf 0
2116 set row {}
2117 set selectfirst 0
2118 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2119 set row $commitrow($n,$selid)
2120 # try to get the selected row in the same position on the screen
2121 set ymax [lindex [$canv cget -scrollregion] 3]
2122 set ytop [expr {[yc $row] - $yscreen}]
2123 if {$ytop < 0} {
2124 set ytop 0
2125 }
2126 set yf [expr {$ytop * 1.0 / $ymax}]
2127 }
2128 allcanvs yview moveto $yf
2129 drawvisible
2130 if {$row ne {}} {
2131 selectline $row 0
2132 } elseif {$selid ne {}} {
2133 set pending_select $selid
2134 } else {
2135 set row [first_real_row]
2136 if {$row < $numcommits} {
2137 selectline $row 0
2138 } else {
2139 set selectfirst 1
2140 }
2141 }
2142 if {$phase ne {}} {
2143 if {$phase eq "getcommits"} {
2144 show_status [mc "Reading commits..."]
2145 }
2146 run chewcommits $n
2147 } elseif {$numcommits == 0} {
2148 show_status [mc "No commits selected"]
2149 }
2150 }
2151
2152 # Stuff relating to the highlighting facility
2153
2154 proc ishighlighted {row} {
2155 global vhighlights fhighlights nhighlights rhighlights
2156
2157 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2158 return $nhighlights($row)
2159 }
2160 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2161 return $vhighlights($row)
2162 }
2163 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2164 return $fhighlights($row)
2165 }
2166 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2167 return $rhighlights($row)
2168 }
2169 return 0
2170 }
2171
2172 proc bolden {row font} {
2173 global canv linehtag selectedline boldrows
2174
2175 lappend boldrows $row
2176 $canv itemconf $linehtag($row) -font $font
2177 if {[info exists selectedline] && $row == $selectedline} {
2178 $canv delete secsel
2179 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2180 -outline {{}} -tags secsel \
2181 -fill [$canv cget -selectbackground]]
2182 $canv lower $t
2183 }
2184 }
2185
2186 proc bolden_name {row font} {
2187 global canv2 linentag selectedline boldnamerows
2188
2189 lappend boldnamerows $row
2190 $canv2 itemconf $linentag($row) -font $font
2191 if {[info exists selectedline] && $row == $selectedline} {
2192 $canv2 delete secsel
2193 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2194 -outline {{}} -tags secsel \
2195 -fill [$canv2 cget -selectbackground]]
2196 $canv2 lower $t
2197 }
2198 }
2199
2200 proc unbolden {} {
2201 global boldrows
2202
2203 set stillbold {}
2204 foreach row $boldrows {
2205 if {![ishighlighted $row]} {
2206 bolden $row mainfont
2207 } else {
2208 lappend stillbold $row
2209 }
2210 }
2211 set boldrows $stillbold
2212 }
2213
2214 proc addvhighlight {n} {
2215 global hlview curview viewdata vhl_done vhighlights commitidx
2216
2217 if {[info exists hlview]} {
2218 delvhighlight
2219 }
2220 set hlview $n
2221 if {$n != $curview && ![info exists viewdata($n)]} {
2222 set viewdata($n) [list getcommits {{}} 0 0 0]
2223 set vparentlist($n) {}
2224 set vdisporder($n) {}
2225 set vcmitlisted($n) {}
2226 start_rev_list $n
2227 }
2228 set vhl_done $commitidx($hlview)
2229 if {$vhl_done > 0} {
2230 drawvisible
2231 }
2232 }
2233
2234 proc delvhighlight {} {
2235 global hlview vhighlights
2236
2237 if {![info exists hlview]} return
2238 unset hlview
2239 catch {unset vhighlights}
2240 unbolden
2241 }
2242
2243 proc vhighlightmore {} {
2244 global hlview vhl_done commitidx vhighlights
2245 global displayorder vdisporder curview
2246
2247 set max $commitidx($hlview)
2248 if {$hlview == $curview} {
2249 set disp $displayorder
2250 } else {
2251 set disp $vdisporder($hlview)
2252 }
2253 set vr [visiblerows]
2254 set r0 [lindex $vr 0]
2255 set r1 [lindex $vr 1]
2256 for {set i $vhl_done} {$i < $max} {incr i} {
2257 set id [lindex $disp $i]
2258 if {[info exists commitrow($curview,$id)]} {
2259 set row $commitrow($curview,$id)
2260 if {$r0 <= $row && $row <= $r1} {
2261 if {![highlighted $row]} {
2262 bolden $row mainfontbold
2263 }
2264 set vhighlights($row) 1
2265 }
2266 }
2267 }
2268 set vhl_done $max
2269 }
2270
2271 proc askvhighlight {row id} {
2272 global hlview vhighlights commitrow iddrawn
2273
2274 if {[info exists commitrow($hlview,$id)]} {
2275 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2276 bolden $row mainfontbold
2277 }
2278 set vhighlights($row) 1
2279 } else {
2280 set vhighlights($row) 0
2281 }
2282 }
2283
2284 proc hfiles_change {} {
2285 global highlight_files filehighlight fhighlights fh_serial
2286 global highlight_paths gdttype
2287
2288 if {[info exists filehighlight]} {
2289 # delete previous highlights
2290 catch {close $filehighlight}
2291 unset filehighlight
2292 catch {unset fhighlights}
2293 unbolden
2294 unhighlight_filelist
2295 }
2296 set highlight_paths {}
2297 after cancel do_file_hl $fh_serial
2298 incr fh_serial
2299 if {$highlight_files ne {}} {
2300 after 300 do_file_hl $fh_serial
2301 }
2302 }
2303
2304 proc gdttype_change {name ix op} {
2305 global gdttype highlight_files findstring findpattern
2306
2307 stopfinding
2308 if {$findstring ne {}} {
2309 if {$gdttype eq [mc "containing:"]} {
2310 if {$highlight_files ne {}} {
2311 set highlight_files {}
2312 hfiles_change
2313 }
2314 findcom_change
2315 } else {
2316 if {$findpattern ne {}} {
2317 set findpattern {}
2318 findcom_change
2319 }
2320 set highlight_files $findstring
2321 hfiles_change
2322 }
2323 drawvisible
2324 }
2325 # enable/disable findtype/findloc menus too
2326 }
2327
2328 proc find_change {name ix op} {
2329 global gdttype findstring highlight_files
2330
2331 stopfinding
2332 if {$gdttype eq [mc "containing:"]} {
2333 findcom_change
2334 } else {
2335 if {$highlight_files ne $findstring} {
2336 set highlight_files $findstring
2337 hfiles_change
2338 }
2339 }
2340 drawvisible
2341 }
2342
2343 proc findcom_change args {
2344 global nhighlights boldnamerows
2345 global findpattern findtype findstring gdttype
2346
2347 stopfinding
2348 # delete previous highlights, if any
2349 foreach row $boldnamerows {
2350 bolden_name $row mainfont
2351 }
2352 set boldnamerows {}
2353 catch {unset nhighlights}
2354 unbolden
2355 unmarkmatches
2356 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2357 set findpattern {}
2358 } elseif {$findtype eq [mc "Regexp"]} {
2359 set findpattern $findstring
2360 } else {
2361 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2362 $findstring]
2363 set findpattern "*$e*"
2364 }
2365 }
2366
2367 proc makepatterns {l} {
2368 set ret {}
2369 foreach e $l {
2370 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2371 if {[string index $ee end] eq "/"} {
2372 lappend ret "$ee*"
2373 } else {
2374 lappend ret $ee
2375 lappend ret "$ee/*"
2376 }
2377 }
2378 return $ret
2379 }
2380
2381 proc do_file_hl {serial} {
2382 global highlight_files filehighlight highlight_paths gdttype fhl_list
2383
2384 if {$gdttype eq [mc "touching paths:"]} {
2385 if {[catch {set paths [shellsplit $highlight_files]}]} return
2386 set highlight_paths [makepatterns $paths]
2387 highlight_filelist
2388 set gdtargs [concat -- $paths]
2389 } elseif {$gdttype eq [mc "adding/removing string:"]} {
2390 set gdtargs [list "-S$highlight_files"]
2391 } else {
2392 # must be "containing:", i.e. we're searching commit info
2393 return
2394 }
2395 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2396 set filehighlight [open $cmd r+]
2397 fconfigure $filehighlight -blocking 0
2398 filerun $filehighlight readfhighlight
2399 set fhl_list {}
2400 drawvisible
2401 flushhighlights
2402 }
2403
2404 proc flushhighlights {} {
2405 global filehighlight fhl_list
2406
2407 if {[info exists filehighlight]} {
2408 lappend fhl_list {}
2409 puts $filehighlight ""
2410 flush $filehighlight
2411 }
2412 }
2413
2414 proc askfilehighlight {row id} {
2415 global filehighlight fhighlights fhl_list
2416
2417 lappend fhl_list $id
2418 set fhighlights($row) -1
2419 puts $filehighlight $id
2420 }
2421
2422 proc readfhighlight {} {
2423 global filehighlight fhighlights commitrow curview iddrawn
2424 global fhl_list find_dirn
2425
2426 if {![info exists filehighlight]} {
2427 return 0
2428 }
2429 set nr 0
2430 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2431 set line [string trim $line]
2432 set i [lsearch -exact $fhl_list $line]
2433 if {$i < 0} continue
2434 for {set j 0} {$j < $i} {incr j} {
2435 set id [lindex $fhl_list $j]
2436 if {[info exists commitrow($curview,$id)]} {
2437 set fhighlights($commitrow($curview,$id)) 0
2438 }
2439 }
2440 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2441 if {$line eq {}} continue
2442 if {![info exists commitrow($curview,$line)]} continue
2443 set row $commitrow($curview,$line)
2444 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2445 bolden $row mainfontbold
2446 }
2447 set fhighlights($row) 1
2448 }
2449 if {[eof $filehighlight]} {
2450 # strange...
2451 puts "oops, git diff-tree died"
2452 catch {close $filehighlight}
2453 unset filehighlight
2454 return 0
2455 }
2456 if {[info exists find_dirn]} {
2457 run findmore
2458 }
2459 return 1
2460 }
2461
2462 proc doesmatch {f} {
2463 global findtype findpattern
2464
2465 if {$findtype eq [mc "Regexp"]} {
2466 return [regexp $findpattern $f]
2467 } elseif {$findtype eq [mc "IgnCase"]} {
2468 return [string match -nocase $findpattern $f]
2469 } else {
2470 return [string match $findpattern $f]
2471 }
2472 }
2473
2474 proc askfindhighlight {row id} {
2475 global nhighlights commitinfo iddrawn
2476 global findloc
2477 global markingmatches
2478
2479 if {![info exists commitinfo($id)]} {
2480 getcommit $id
2481 }
2482 set info $commitinfo($id)
2483 set isbold 0
2484 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2485 foreach f $info ty $fldtypes {
2486 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2487 [doesmatch $f]} {
2488 if {$ty eq [mc "Author"]} {
2489 set isbold 2
2490 break
2491 }
2492 set isbold 1
2493 }
2494 }
2495 if {$isbold && [info exists iddrawn($id)]} {
2496 if {![ishighlighted $row]} {
2497 bolden $row mainfontbold
2498 if {$isbold > 1} {
2499 bolden_name $row mainfontbold
2500 }
2501 }
2502 if {$markingmatches} {
2503 markrowmatches $row $id
2504 }
2505 }
2506 set nhighlights($row) $isbold
2507 }
2508
2509 proc markrowmatches {row id} {
2510 global canv canv2 linehtag linentag commitinfo findloc
2511
2512 set headline [lindex $commitinfo($id) 0]
2513 set author [lindex $commitinfo($id) 1]
2514 $canv delete match$row
2515 $canv2 delete match$row
2516 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2517 set m [findmatches $headline]
2518 if {$m ne {}} {
2519 markmatches $canv $row $headline $linehtag($row) $m \
2520 [$canv itemcget $linehtag($row) -font] $row
2521 }
2522 }
2523 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2524 set m [findmatches $author]
2525 if {$m ne {}} {
2526 markmatches $canv2 $row $author $linentag($row) $m \
2527 [$canv2 itemcget $linentag($row) -font] $row
2528 }
2529 }
2530 }
2531
2532 proc vrel_change {name ix op} {
2533 global highlight_related
2534
2535 rhighlight_none
2536 if {$highlight_related ne [mc "None"]} {
2537 run drawvisible
2538 }
2539 }
2540
2541 # prepare for testing whether commits are descendents or ancestors of a
2542 proc rhighlight_sel {a} {
2543 global descendent desc_todo ancestor anc_todo
2544 global highlight_related rhighlights
2545
2546 catch {unset descendent}
2547 set desc_todo [list $a]
2548 catch {unset ancestor}
2549 set anc_todo [list $a]
2550 if {$highlight_related ne [mc "None"]} {
2551 rhighlight_none
2552 run drawvisible
2553 }
2554 }
2555
2556 proc rhighlight_none {} {
2557 global rhighlights
2558
2559 catch {unset rhighlights}
2560 unbolden
2561 }
2562
2563 proc is_descendent {a} {
2564 global curview children commitrow descendent desc_todo
2565
2566 set v $curview
2567 set la $commitrow($v,$a)
2568 set todo $desc_todo
2569 set leftover {}
2570 set done 0
2571 for {set i 0} {$i < [llength $todo]} {incr i} {
2572 set do [lindex $todo $i]
2573 if {$commitrow($v,$do) < $la} {
2574 lappend leftover $do
2575 continue
2576 }
2577 foreach nk $children($v,$do) {
2578 if {![info exists descendent($nk)]} {
2579 set descendent($nk) 1
2580 lappend todo $nk
2581 if {$nk eq $a} {
2582 set done 1
2583 }
2584 }
2585 }
2586 if {$done} {
2587 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2588 return
2589 }
2590 }
2591 set descendent($a) 0
2592 set desc_todo $leftover
2593 }
2594
2595 proc is_ancestor {a} {
2596 global curview parentlist commitrow ancestor anc_todo
2597
2598 set v $curview
2599 set la $commitrow($v,$a)
2600 set todo $anc_todo
2601 set leftover {}
2602 set done 0
2603 for {set i 0} {$i < [llength $todo]} {incr i} {
2604 set do [lindex $todo $i]
2605 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2606 lappend leftover $do
2607 continue
2608 }
2609 foreach np [lindex $parentlist $commitrow($v,$do)] {
2610 if {![info exists ancestor($np)]} {
2611 set ancestor($np) 1
2612 lappend todo $np
2613 if {$np eq $a} {
2614 set done 1
2615 }
2616 }
2617 }
2618 if {$done} {
2619 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2620 return
2621 }
2622 }
2623 set ancestor($a) 0
2624 set anc_todo $leftover
2625 }
2626
2627 proc askrelhighlight {row id} {
2628 global descendent highlight_related iddrawn rhighlights
2629 global selectedline ancestor
2630
2631 if {![info exists selectedline]} return
2632 set isbold 0
2633 if {$highlight_related eq [mc "Descendant"] ||
2634 $highlight_related eq [mc "Not descendant"]} {
2635 if {![info exists descendent($id)]} {
2636 is_descendent $id
2637 }
2638 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2639 set isbold 1
2640 }
2641 } elseif {$highlight_related eq [mc "Ancestor"] ||
2642 $highlight_related eq [mc "Not ancestor"]} {
2643 if {![info exists ancestor($id)]} {
2644 is_ancestor $id
2645 }
2646 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2647 set isbold 1
2648 }
2649 }
2650 if {[info exists iddrawn($id)]} {
2651 if {$isbold && ![ishighlighted $row]} {
2652 bolden $row mainfontbold
2653 }
2654 }
2655 set rhighlights($row) $isbold
2656 }
2657
2658 # Graph layout functions
2659
2660 proc shortids {ids} {
2661 set res {}
2662 foreach id $ids {
2663 if {[llength $id] > 1} {
2664 lappend res [shortids $id]
2665 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2666 lappend res [string range $id 0 7]
2667 } else {
2668 lappend res $id
2669 }
2670 }
2671 return $res
2672 }
2673
2674 proc ntimes {n o} {
2675 set ret {}
2676 set o [list $o]
2677 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2678 if {($n & $mask) != 0} {
2679 set ret [concat $ret $o]
2680 }
2681 set o [concat $o $o]
2682 }
2683 return $ret
2684 }
2685
2686 # Work out where id should go in idlist so that order-token
2687 # values increase from left to right
2688 proc idcol {idlist id {i 0}} {
2689 global ordertok curview
2690
2691 set t $ordertok($curview,$id)
2692 if {$i >= [llength $idlist] ||
2693 $t < $ordertok($curview,[lindex $idlist $i])} {
2694 if {$i > [llength $idlist]} {
2695 set i [llength $idlist]
2696 }
2697 while {[incr i -1] >= 0 &&
2698 $t < $ordertok($curview,[lindex $idlist $i])} {}
2699 incr i
2700 } else {
2701 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2702 while {[incr i] < [llength $idlist] &&
2703 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2704 }
2705 }
2706 return $i
2707 }
2708
2709 proc initlayout {} {
2710 global rowidlist rowisopt rowfinal displayorder commitlisted
2711 global numcommits canvxmax canv
2712 global nextcolor
2713 global parentlist
2714 global colormap rowtextx
2715 global selectfirst
2716
2717 set numcommits 0
2718 set displayorder {}
2719 set commitlisted {}
2720 set parentlist {}
2721 set nextcolor 0
2722 set rowidlist {}
2723 set rowisopt {}
2724 set rowfinal {}
2725 set canvxmax [$canv cget -width]
2726 catch {unset colormap}
2727 catch {unset rowtextx}
2728 set selectfirst 1
2729 }
2730
2731 proc setcanvscroll {} {
2732 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2733
2734 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2735 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2736 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2737 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2738 }
2739
2740 proc visiblerows {} {
2741 global canv numcommits linespc
2742
2743 set ymax [lindex [$canv cget -scrollregion] 3]
2744 if {$ymax eq {} || $ymax == 0} return
2745 set f [$canv yview]
2746 set y0 [expr {int([lindex $f 0] * $ymax)}]
2747 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2748 if {$r0 < 0} {
2749 set r0 0
2750 }
2751 set y1 [expr {int([lindex $f 1] * $ymax)}]
2752 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2753 if {$r1 >= $numcommits} {
2754 set r1 [expr {$numcommits - 1}]
2755 }
2756 return [list $r0 $r1]
2757 }
2758
2759 proc layoutmore {} {
2760 global commitidx viewcomplete numcommits
2761 global uparrowlen downarrowlen mingaplen curview
2762
2763 set show $commitidx($curview)
2764 if {$show > $numcommits || $viewcomplete($curview)} {
2765 showstuff $show $viewcomplete($curview)
2766 }
2767 }
2768
2769 proc showstuff {canshow last} {
2770 global numcommits commitrow pending_select selectedline curview
2771 global mainheadid displayorder selectfirst
2772 global lastscrollset commitinterest
2773
2774 if {$numcommits == 0} {
2775 global phase
2776 set phase "incrdraw"
2777 allcanvs delete all
2778 }
2779 set r0 $numcommits
2780 set prev $numcommits
2781 set numcommits $canshow
2782 set t [clock clicks -milliseconds]
2783 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2784 set lastscrollset $t
2785 setcanvscroll
2786 }
2787 set rows [visiblerows]
2788 set r1 [lindex $rows 1]
2789 if {$r1 >= $canshow} {
2790 set r1 [expr {$canshow - 1}]
2791 }
2792 if {$r0 <= $r1} {
2793 drawcommits $r0 $r1
2794 }
2795 if {[info exists pending_select] &&
2796 [info exists commitrow($curview,$pending_select)] &&
2797 $commitrow($curview,$pending_select) < $numcommits} {
2798 selectline $commitrow($curview,$pending_select) 1
2799 }
2800 if {$selectfirst} {
2801 if {[info exists selectedline] || [info exists pending_select]} {
2802 set selectfirst 0
2803 } else {
2804 set l [first_real_row]
2805 selectline $l 1
2806 set selectfirst 0
2807 }
2808 }
2809 }
2810
2811 proc doshowlocalchanges {} {
2812 global curview mainheadid phase commitrow
2813
2814 if {[info exists commitrow($curview,$mainheadid)] &&
2815 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2816 dodiffindex
2817 } elseif {$phase ne {}} {
2818 lappend commitinterest($mainheadid) {}
2819 }
2820 }
2821
2822 proc dohidelocalchanges {} {
2823 global localfrow localirow lserial
2824
2825 if {$localfrow >= 0} {
2826 removerow $localfrow
2827 set localfrow -1
2828 if {$localirow > 0} {
2829 incr localirow -1
2830 }
2831 }
2832 if {$localirow >= 0} {
2833 removerow $localirow
2834 set localirow -1
2835 }
2836 incr lserial
2837 }
2838
2839 # spawn off a process to do git diff-index --cached HEAD
2840 proc dodiffindex {} {
2841 global localirow localfrow lserial showlocalchanges
2842
2843 if {!$showlocalchanges} return
2844 incr lserial
2845 set localfrow -1
2846 set localirow -1
2847 set fd [open "|git diff-index --cached HEAD" r]
2848 fconfigure $fd -blocking 0
2849 filerun $fd [list readdiffindex $fd $lserial]
2850 }
2851
2852 proc readdiffindex {fd serial} {
2853 global localirow commitrow mainheadid nullid2 curview
2854 global commitinfo commitdata lserial
2855
2856 set isdiff 1
2857 if {[gets $fd line] < 0} {
2858 if {![eof $fd]} {
2859 return 1
2860 }
2861 set isdiff 0
2862 }
2863 # we only need to see one line and we don't really care what it says...
2864 close $fd
2865
2866 # now see if there are any local changes not checked in to the index
2867 if {$serial == $lserial} {
2868 set fd [open "|git diff-files" r]
2869 fconfigure $fd -blocking 0
2870 filerun $fd [list readdifffiles $fd $serial]
2871 }
2872
2873 if {$isdiff && $serial == $lserial && $localirow == -1} {
2874 # add the line for the changes in the index to the graph
2875 set localirow $commitrow($curview,$mainheadid)
2876 set hl [mc "Local changes checked in to index but not committed"]
2877 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2878 set commitdata($nullid2) "\n $hl\n"
2879 insertrow $localirow $nullid2
2880 }
2881 return 0
2882 }
2883
2884 proc readdifffiles {fd serial} {
2885 global localirow localfrow commitrow mainheadid nullid curview
2886 global commitinfo commitdata lserial
2887
2888 set isdiff 1
2889 if {[gets $fd line] < 0} {
2890 if {![eof $fd]} {
2891 return 1
2892 }
2893 set isdiff 0
2894 }
2895 # we only need to see one line and we don't really care what it says...
2896 close $fd
2897
2898 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2899 # add the line for the local diff to the graph
2900 if {$localirow >= 0} {
2901 set localfrow $localirow
2902 incr localirow
2903 } else {
2904 set localfrow $commitrow($curview,$mainheadid)
2905 }
2906 set hl [mc "Local uncommitted changes, not checked in to index"]
2907 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2908 set commitdata($nullid) "\n $hl\n"
2909 insertrow $localfrow $nullid
2910 }
2911 return 0
2912 }
2913
2914 proc nextuse {id row} {
2915 global commitrow curview children
2916
2917 if {[info exists children($curview,$id)]} {
2918 foreach kid $children($curview,$id) {
2919 if {![info exists commitrow($curview,$kid)]} {
2920 return -1
2921 }
2922 if {$commitrow($curview,$kid) > $row} {
2923 return $commitrow($curview,$kid)
2924 }
2925 }
2926 }
2927 if {[info exists commitrow($curview,$id)]} {
2928 return $commitrow($curview,$id)
2929 }
2930 return -1
2931 }
2932
2933 proc prevuse {id row} {
2934 global commitrow curview children
2935
2936 set ret -1
2937 if {[info exists children($curview,$id)]} {
2938 foreach kid $children($curview,$id) {
2939 if {![info exists commitrow($curview,$kid)]} break
2940 if {$commitrow($curview,$kid) < $row} {
2941 set ret $commitrow($curview,$kid)
2942 }
2943 }
2944 }
2945 return $ret
2946 }
2947
2948 proc make_idlist {row} {
2949 global displayorder parentlist uparrowlen downarrowlen mingaplen
2950 global commitidx curview ordertok children commitrow
2951
2952 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2953 if {$r < 0} {
2954 set r 0
2955 }
2956 set ra [expr {$row - $downarrowlen}]
2957 if {$ra < 0} {
2958 set ra 0
2959 }
2960 set rb [expr {$row + $uparrowlen}]
2961 if {$rb > $commitidx($curview)} {
2962 set rb $commitidx($curview)
2963 }
2964 set ids {}
2965 for {} {$r < $ra} {incr r} {
2966 set nextid [lindex $displayorder [expr {$r + 1}]]
2967 foreach p [lindex $parentlist $r] {
2968 if {$p eq $nextid} continue
2969 set rn [nextuse $p $r]
2970 if {$rn >= $row &&
2971 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2972 lappend ids [list $ordertok($curview,$p) $p]
2973 }
2974 }
2975 }
2976 for {} {$r < $row} {incr r} {
2977 set nextid [lindex $displayorder [expr {$r + 1}]]
2978 foreach p [lindex $parentlist $r] {
2979 if {$p eq $nextid} continue
2980 set rn [nextuse $p $r]
2981 if {$rn < 0 || $rn >= $row} {
2982 lappend ids [list $ordertok($curview,$p) $p]
2983 }
2984 }
2985 }
2986 set id [lindex $displayorder $row]
2987 lappend ids [list $ordertok($curview,$id) $id]
2988 while {$r < $rb} {
2989 foreach p [lindex $parentlist $r] {
2990 set firstkid [lindex $children($curview,$p) 0]
2991 if {$commitrow($curview,$firstkid) < $row} {
2992 lappend ids [list $ordertok($curview,$p) $p]
2993 }
2994 }
2995 incr r
2996 set id [lindex $displayorder $r]
2997 if {$id ne {}} {
2998 set firstkid [lindex $children($curview,$id) 0]
2999 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3000 lappend ids [list $ordertok($curview,$id) $id]
3001 }
3002 }
3003 }
3004 set idlist {}
3005 foreach idx [lsort -unique $ids] {
3006 lappend idlist [lindex $idx 1]
3007 }
3008 return $idlist
3009 }
3010
3011 proc rowsequal {a b} {
3012 while {[set i [lsearch -exact $a {}]] >= 0} {
3013 set a [lreplace $a $i $i]
3014 }
3015 while {[set i [lsearch -exact $b {}]] >= 0} {
3016 set b [lreplace $b $i $i]
3017 }
3018 return [expr {$a eq $b}]
3019 }
3020
3021 proc makeupline {id row rend col} {
3022 global rowidlist uparrowlen downarrowlen mingaplen
3023
3024 for {set r $rend} {1} {set r $rstart} {
3025 set rstart [prevuse $id $r]
3026 if {$rstart < 0} return
3027 if {$rstart < $row} break
3028 }
3029 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3030 set rstart [expr {$rend - $uparrowlen - 1}]
3031 }
3032 for {set r $rstart} {[incr r] <= $row} {} {
3033 set idlist [lindex $rowidlist $r]
3034 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3035 set col [idcol $idlist $id $col]
3036 lset rowidlist $r [linsert $idlist $col $id]
3037 changedrow $r
3038 }
3039 }
3040 }
3041
3042 proc layoutrows {row endrow} {
3043 global rowidlist rowisopt rowfinal displayorder
3044 global uparrowlen downarrowlen maxwidth mingaplen
3045 global children parentlist
3046 global commitidx viewcomplete curview commitrow
3047
3048 set idlist {}
3049 if {$row > 0} {
3050 set rm1 [expr {$row - 1}]
3051 foreach id [lindex $rowidlist $rm1] {
3052 if {$id ne {}} {
3053 lappend idlist $id
3054 }
3055 }
3056 set final [lindex $rowfinal $rm1]
3057 }
3058 for {} {$row < $endrow} {incr row} {
3059 set rm1 [expr {$row - 1}]
3060 if {$rm1 < 0 || $idlist eq {}} {
3061 set idlist [make_idlist $row]
3062 set final 1
3063 } else {
3064 set id [lindex $displayorder $rm1]
3065 set col [lsearch -exact $idlist $id]
3066 set idlist [lreplace $idlist $col $col]
3067 foreach p [lindex $parentlist $rm1] {
3068 if {[lsearch -exact $idlist $p] < 0} {
3069 set col [idcol $idlist $p $col]
3070 set idlist [linsert $idlist $col $p]
3071 # if not the first child, we have to insert a line going up
3072 if {$id ne [lindex $children($curview,$p) 0]} {
3073 makeupline $p $rm1 $row $col
3074 }
3075 }
3076 }
3077 set id [lindex $displayorder $row]
3078 if {$row > $downarrowlen} {
3079 set termrow [expr {$row - $downarrowlen - 1}]
3080 foreach p [lindex $parentlist $termrow] {
3081 set i [lsearch -exact $idlist $p]
3082 if {$i < 0} continue
3083 set nr [nextuse $p $termrow]
3084 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3085 set idlist [lreplace $idlist $i $i]
3086 }
3087 }
3088 }
3089 set col [lsearch -exact $idlist $id]
3090 if {$col < 0} {
3091 set col [idcol $idlist $id]
3092 set idlist [linsert $idlist $col $id]
3093 if {$children($curview,$id) ne {}} {
3094 makeupline $id $rm1 $row $col
3095 }
3096 }
3097 set r [expr {$row + $uparrowlen - 1}]
3098 if {$r < $commitidx($curview)} {
3099 set x $col
3100 foreach p [lindex $parentlist $r] {
3101 if {[lsearch -exact $idlist $p] >= 0} continue
3102 set fk [lindex $children($curview,$p) 0]
3103 if {$commitrow($curview,$fk) < $row} {
3104 set x [idcol $idlist $p $x]
3105 set idlist [linsert $idlist $x $p]
3106 }
3107 }
3108 if {[incr r] < $commitidx($curview)} {
3109 set p [lindex $displayorder $r]
3110 if {[lsearch -exact $idlist $p] < 0} {
3111 set fk [lindex $children($curview,$p) 0]
3112 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3113 set x [idcol $idlist $p $x]
3114 set idlist [linsert $idlist $x $p]
3115 }
3116 }
3117 }
3118 }
3119 }
3120 if {$final && !$viewcomplete($curview) &&
3121 $row + $uparrowlen + $mingaplen + $downarrowlen
3122 >= $commitidx($curview)} {
3123 set final 0
3124 }
3125 set l [llength $rowidlist]
3126 if {$row == $l} {
3127 lappend rowidlist $idlist
3128 lappend rowisopt 0
3129 lappend rowfinal $final
3130 } elseif {$row < $l} {
3131 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3132 lset rowidlist $row $idlist
3133 changedrow $row
3134 }
3135 lset rowfinal $row $final
3136 } else {
3137 set pad [ntimes [expr {$row - $l}] {}]
3138 set rowidlist [concat $rowidlist $pad]
3139 lappend rowidlist $idlist
3140 set rowfinal [concat $rowfinal $pad]
3141 lappend rowfinal $final
3142 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3143 }
3144 }
3145 return $row
3146 }
3147
3148 proc changedrow {row} {
3149 global displayorder iddrawn rowisopt need_redisplay
3150
3151 set l [llength $rowisopt]
3152 if {$row < $l} {
3153 lset rowisopt $row 0
3154 if {$row + 1 < $l} {
3155 lset rowisopt [expr {$row + 1}] 0
3156 if {$row + 2 < $l} {
3157 lset rowisopt [expr {$row + 2}] 0
3158 }
3159 }
3160 }
3161 set id [lindex $displayorder $row]
3162 if {[info exists iddrawn($id)]} {
3163 set need_redisplay 1
3164 }
3165 }
3166
3167 proc insert_pad {row col npad} {
3168 global rowidlist
3169
3170 set pad [ntimes $npad {}]
3171 set idlist [lindex $rowidlist $row]
3172 set bef [lrange $idlist 0 [expr {$col - 1}]]
3173 set aft [lrange $idlist $col end]
3174 set i [lsearch -exact $aft {}]
3175 if {$i > 0} {
3176 set aft [lreplace $aft $i $i]
3177 }
3178 lset rowidlist $row [concat $bef $pad $aft]
3179 changedrow $row
3180 }
3181
3182 proc optimize_rows {row col endrow} {
3183 global rowidlist rowisopt displayorder curview children
3184
3185 if {$row < 1} {
3186 set row 1
3187 }
3188 for {} {$row < $endrow} {incr row; set col 0} {
3189 if {[lindex $rowisopt $row]} continue
3190 set haspad 0
3191 set y0 [expr {$row - 1}]
3192 set ym [expr {$row - 2}]
3193 set idlist [lindex $rowidlist $row]
3194 set previdlist [lindex $rowidlist $y0]
3195 if {$idlist eq {} || $previdlist eq {}} continue
3196 if {$ym >= 0} {
3197 set pprevidlist [lindex $rowidlist $ym]
3198 if {$pprevidlist eq {}} continue
3199 } else {
3200 set pprevidlist {}
3201 }
3202 set x0 -1
3203 set xm -1
3204 for {} {$col < [llength $idlist]} {incr col} {
3205 set id [lindex $idlist $col]
3206 if {[lindex $previdlist $col] eq $id} continue
3207 if {$id eq {}} {
3208 set haspad 1
3209 continue
3210 }
3211 set x0 [lsearch -exact $previdlist $id]
3212 if {$x0 < 0} continue
3213 set z [expr {$x0 - $col}]
3214 set isarrow 0
3215 set z0 {}
3216 if {$ym >= 0} {
3217 set xm [lsearch -exact $pprevidlist $id]
3218 if {$xm >= 0} {
3219 set z0 [expr {$xm - $x0}]
3220 }
3221 }
3222 if {$z0 eq {}} {
3223 # if row y0 is the first child of $id then it's not an arrow
3224 if {[lindex $children($curview,$id) 0] ne
3225 [lindex $displayorder $y0]} {
3226 set isarrow 1
3227 }
3228 }
3229 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3230 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3231 set isarrow 1
3232 }
3233 # Looking at lines from this row to the previous row,
3234 # make them go straight up if they end in an arrow on
3235 # the previous row; otherwise make them go straight up
3236 # or at 45 degrees.
3237 if {$z < -1 || ($z < 0 && $isarrow)} {
3238 # Line currently goes left too much;
3239 # insert pads in the previous row, then optimize it
3240 set npad [expr {-1 - $z + $isarrow}]
3241 insert_pad $y0 $x0 $npad
3242 if {$y0 > 0} {
3243 optimize_rows $y0 $x0 $row
3244 }
3245 set previdlist [lindex $rowidlist $y0]
3246 set x0 [lsearch -exact $previdlist $id]
3247 set z [expr {$x0 - $col}]
3248 if {$z0 ne {}} {
3249 set pprevidlist [lindex $rowidlist $ym]
3250 set xm [lsearch -exact $pprevidlist $id]
3251 set z0 [expr {$xm - $x0}]
3252 }
3253 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3254 # Line currently goes right too much;
3255 # insert pads in this line
3256 set npad [expr {$z - 1 + $isarrow}]
3257 insert_pad $row $col $npad
3258 set idlist [lindex $rowidlist $row]
3259 incr col $npad
3260 set z [expr {$x0 - $col}]
3261 set haspad 1
3262 }
3263 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3264 # this line links to its first child on row $row-2
3265 set id [lindex $displayorder $ym]
3266 set xc [lsearch -exact $pprevidlist $id]
3267 if {$xc >= 0} {
3268 set z0 [expr {$xc - $x0}]
3269 }
3270 }
3271 # avoid lines jigging left then immediately right
3272 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3273 insert_pad $y0 $x0 1
3274 incr x0
3275 optimize_rows $y0 $x0 $row
3276 set previdlist [lindex $rowidlist $y0]
3277 }
3278 }
3279 if {!$haspad} {
3280 # Find the first column that doesn't have a line going right
3281 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3282 set id [lindex $idlist $col]
3283 if {$id eq {}} break
3284 set x0 [lsearch -exact $previdlist $id]
3285 if {$x0 < 0} {
3286 # check if this is the link to the first child
3287 set kid [lindex $displayorder $y0]
3288 if {[lindex $children($curview,$id) 0] eq $kid} {
3289 # it is, work out offset to child
3290 set x0 [lsearch -exact $previdlist $kid]
3291 }
3292 }
3293 if {$x0 <= $col} break
3294 }
3295 # Insert a pad at that column as long as it has a line and
3296 # isn't the last column
3297 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3298 set idlist [linsert $idlist $col {}]
3299 lset rowidlist $row $idlist
3300 changedrow $row
3301 }
3302 }
3303 }
3304 }
3305
3306 proc xc {row col} {
3307 global canvx0 linespc
3308 return [expr {$canvx0 + $col * $linespc}]
3309 }
3310
3311 proc yc {row} {
3312 global canvy0 linespc
3313 return [expr {$canvy0 + $row * $linespc}]
3314 }
3315
3316 proc linewidth {id} {
3317 global thickerline lthickness
3318
3319 set wid $lthickness
3320 if {[info exists thickerline] && $id eq $thickerline} {
3321 set wid [expr {2 * $lthickness}]
3322 }
3323 return $wid
3324 }
3325
3326 proc rowranges {id} {
3327 global commitrow curview children uparrowlen downarrowlen
3328 global rowidlist
3329
3330 set kids $children($curview,$id)
3331 if {$kids eq {}} {
3332 return {}
3333 }
3334 set ret {}
3335 lappend kids $id
3336 foreach child $kids {
3337 if {![info exists commitrow($curview,$child)]} break
3338 set row $commitrow($curview,$child)
3339 if {![info exists prev]} {
3340 lappend ret [expr {$row + 1}]
3341 } else {
3342 if {$row <= $prevrow} {
3343 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3344 }
3345 # see if the line extends the whole way from prevrow to row
3346 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3347 [lsearch -exact [lindex $rowidlist \
3348 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3349 # it doesn't, see where it ends
3350 set r [expr {$prevrow + $downarrowlen}]
3351 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3352 while {[incr r -1] > $prevrow &&
3353 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3354 } else {
3355 while {[incr r] <= $row &&
3356 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3357 incr r -1
3358 }
3359 lappend ret $r
3360 # see where it starts up again
3361 set r [expr {$row - $uparrowlen}]
3362 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3363 while {[incr r] < $row &&
3364 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3365 } else {
3366 while {[incr r -1] >= $prevrow &&
3367 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3368 incr r
3369 }
3370 lappend ret $r
3371 }
3372 }
3373 if {$child eq $id} {
3374 lappend ret $row
3375 }
3376 set prev $id
3377 set prevrow $row
3378 }
3379 return $ret
3380 }
3381
3382 proc drawlineseg {id row endrow arrowlow} {
3383 global rowidlist displayorder iddrawn linesegs
3384 global canv colormap linespc curview maxlinelen parentlist
3385
3386 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3387 set le [expr {$row + 1}]
3388 set arrowhigh 1
3389 while {1} {
3390 set c [lsearch -exact [lindex $rowidlist $le] $id]
3391 if {$c < 0} {
3392 incr le -1
3393 break
3394 }
3395 lappend cols $c
3396 set x [lindex $displayorder $le]
3397 if {$x eq $id} {
3398 set arrowhigh 0
3399 break
3400 }
3401 if {[info exists iddrawn($x)] || $le == $endrow} {
3402 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3403 if {$c >= 0} {
3404 lappend cols $c
3405 set arrowhigh 0
3406 }
3407 break
3408 }
3409 incr le
3410 }
3411 if {$le <= $row} {
3412 return $row
3413 }
3414
3415 set lines {}
3416 set i 0
3417 set joinhigh 0
3418 if {[info exists linesegs($id)]} {
3419 set lines $linesegs($id)
3420 foreach li $lines {
3421 set r0 [lindex $li 0]
3422 if {$r0 > $row} {
3423 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3424 set joinhigh 1
3425 }
3426 break
3427 }
3428 incr i
3429 }
3430 }
3431 set joinlow 0
3432 if {$i > 0} {
3433 set li [lindex $lines [expr {$i-1}]]
3434 set r1 [lindex $li 1]
3435 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3436 set joinlow 1
3437 }
3438 }
3439
3440 set x [lindex $cols [expr {$le - $row}]]
3441 set xp [lindex $cols [expr {$le - 1 - $row}]]
3442 set dir [expr {$xp - $x}]
3443 if {$joinhigh} {
3444 set ith [lindex $lines $i 2]
3445 set coords [$canv coords $ith]
3446 set ah [$canv itemcget $ith -arrow]
3447 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3448 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3449 if {$x2 ne {} && $x - $x2 == $dir} {
3450 set coords [lrange $coords 0 end-2]
3451 }
3452 } else {
3453 set coords [list [xc $le $x] [yc $le]]
3454 }
3455 if {$joinlow} {
3456 set itl [lindex $lines [expr {$i-1}] 2]
3457 set al [$canv itemcget $itl -arrow]
3458 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3459 } elseif {$arrowlow} {
3460 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3461 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3462 set arrowlow 0
3463 }
3464 }
3465 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3466 for {set y $le} {[incr y -1] > $row} {} {
3467 set x $xp
3468 set xp [lindex $cols [expr {$y - 1 - $row}]]
3469 set ndir [expr {$xp - $x}]
3470 if {$dir != $ndir || $xp < 0} {
3471 lappend coords [xc $y $x] [yc $y]
3472 }
3473 set dir $ndir
3474 }
3475 if {!$joinlow} {
3476 if {$xp < 0} {
3477 # join parent line to first child
3478 set ch [lindex $displayorder $row]
3479 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3480 if {$xc < 0} {
3481 puts "oops: drawlineseg: child $ch not on row $row"
3482 } elseif {$xc != $x} {
3483 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3484 set d [expr {int(0.5 * $linespc)}]
3485 set x1 [xc $row $x]
3486 if {$xc < $x} {
3487 set x2 [expr {$x1 - $d}]
3488 } else {
3489 set x2 [expr {$x1 + $d}]
3490 }
3491 set y2 [yc $row]
3492 set y1 [expr {$y2 + $d}]
3493 lappend coords $x1 $y1 $x2 $y2
3494 } elseif {$xc < $x - 1} {
3495 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3496 } elseif {$xc > $x + 1} {
3497 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3498 }
3499 set x $xc
3500 }
3501 lappend coords [xc $row $x] [yc $row]
3502 } else {
3503 set xn [xc $row $xp]
3504 set yn [yc $row]
3505 lappend coords $xn $yn
3506 }
3507 if {!$joinhigh} {
3508 assigncolor $id
3509 set t [$canv create line $coords -width [linewidth $id] \
3510 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3511 $canv lower $t
3512 bindline $t $id
3513 set lines [linsert $lines $i [list $row $le $t]]
3514 } else {
3515 $canv coords $ith $coords
3516 if {$arrow ne $ah} {
3517 $canv itemconf $ith -arrow $arrow
3518 }
3519 lset lines $i 0 $row
3520 }
3521 } else {
3522 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3523 set ndir [expr {$xo - $xp}]
3524 set clow [$canv coords $itl]
3525 if {$dir == $ndir} {
3526 set clow [lrange $clow 2 end]
3527 }
3528 set coords [concat $coords $clow]
3529 if {!$joinhigh} {
3530 lset lines [expr {$i-1}] 1 $le
3531 } else {
3532 # coalesce two pieces
3533 $canv delete $ith
3534 set b [lindex $lines [expr {$i-1}] 0]
3535 set e [lindex $lines $i 1]
3536 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3537 }
3538 $canv coords $itl $coords
3539 if {$arrow ne $al} {
3540 $canv itemconf $itl -arrow $arrow
3541 }
3542 }
3543
3544 set linesegs($id) $lines
3545 return $le
3546 }
3547
3548 proc drawparentlinks {id row} {
3549 global rowidlist canv colormap curview parentlist
3550 global idpos linespc
3551
3552 set rowids [lindex $rowidlist $row]
3553 set col [lsearch -exact $rowids $id]
3554 if {$col < 0} return
3555 set olds [lindex $parentlist $row]
3556 set row2 [expr {$row + 1}]
3557 set x [xc $row $col]
3558 set y [yc $row]
3559 set y2 [yc $row2]
3560 set d [expr {int(0.5 * $linespc)}]
3561 set ymid [expr {$y + $d}]
3562 set ids [lindex $rowidlist $row2]
3563 # rmx = right-most X coord used
3564 set rmx 0
3565 foreach p $olds {
3566 set i [lsearch -exact $ids $p]
3567 if {$i < 0} {
3568 puts "oops, parent $p of $id not in list"
3569 continue
3570 }
3571 set x2 [xc $row2 $i]
3572 if {$x2 > $rmx} {
3573 set rmx $x2
3574 }
3575 set j [lsearch -exact $rowids $p]
3576 if {$j < 0} {
3577 # drawlineseg will do this one for us
3578 continue
3579 }
3580 assigncolor $p
3581 # should handle duplicated parents here...
3582 set coords [list $x $y]
3583 if {$i != $col} {
3584 # if attaching to a vertical segment, draw a smaller
3585 # slant for visual distinctness
3586 if {$i == $j} {
3587 if {$i < $col} {
3588 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3589 } else {
3590 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3591 }
3592 } elseif {$i < $col && $i < $j} {
3593 # segment slants towards us already
3594 lappend coords [xc $row $j] $y
3595 } else {
3596 if {$i < $col - 1} {
3597 lappend coords [expr {$x2 + $linespc}] $y
3598 } elseif {$i > $col + 1} {
3599 lappend coords [expr {$x2 - $linespc}] $y
3600 }
3601 lappend coords $x2 $y2
3602 }
3603 } else {
3604 lappend coords $x2 $y2
3605 }
3606 set t [$canv create line $coords -width [linewidth $p] \
3607 -fill $colormap($p) -tags lines.$p]
3608 $canv lower $t
3609 bindline $t $p
3610 }
3611 if {$rmx > [lindex $idpos($id) 1]} {
3612 lset idpos($id) 1 $rmx
3613 redrawtags $id
3614 }
3615 }
3616
3617 proc drawlines {id} {
3618 global canv
3619
3620 $canv itemconf lines.$id -width [linewidth $id]
3621 }
3622
3623 proc drawcmittext {id row col} {
3624 global linespc canv canv2 canv3 canvy0 fgcolor curview
3625 global commitlisted commitinfo rowidlist parentlist
3626 global rowtextx idpos idtags idheads idotherrefs
3627 global linehtag linentag linedtag selectedline
3628 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3629
3630 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3631 set listed [lindex $commitlisted $row]
3632 if {$id eq $nullid} {
3633 set ofill red
3634 } elseif {$id eq $nullid2} {
3635 set ofill green
3636 } else {
3637 set ofill [expr {$listed != 0? "blue": "white"}]
3638 }
3639 set x [xc $row $col]
3640 set y [yc $row]
3641 set orad [expr {$linespc / 3}]
3642 if {$listed <= 1} {
3643 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3644 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3645 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3646 } elseif {$listed == 2} {
3647 # triangle pointing left for left-side commits
3648 set t [$canv create polygon \
3649 [expr {$x - $orad}] $y \
3650 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3651 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3652 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3653 } else {
3654 # triangle pointing right for right-side commits
3655 set t [$canv create polygon \
3656 [expr {$x + $orad - 1}] $y \
3657 [expr {$x - $orad}] [expr {$y - $orad}] \
3658 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3659 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3660 }
3661 $canv raise $t
3662 $canv bind $t <1> {selcanvline {} %x %y}
3663 set rmx [llength [lindex $rowidlist $row]]
3664 set olds [lindex $parentlist $row]
3665 if {$olds ne {}} {
3666 set nextids [lindex $rowidlist [expr {$row + 1}]]
3667 foreach p $olds {
3668 set i [lsearch -exact $nextids $p]
3669 if {$i > $rmx} {
3670 set rmx $i
3671 }
3672 }
3673 }
3674 set xt [xc $row $rmx]
3675 set rowtextx($row) $xt
3676 set idpos($id) [list $x $xt $y]
3677 if {[info exists idtags($id)] || [info exists idheads($id)]
3678 || [info exists idotherrefs($id)]} {
3679 set xt [drawtags $id $x $xt $y]
3680 }
3681 set headline [lindex $commitinfo($id) 0]
3682 set name [lindex $commitinfo($id) 1]
3683 set date [lindex $commitinfo($id) 2]
3684 set date [formatdate $date]
3685 set font mainfont
3686 set nfont mainfont
3687 set isbold [ishighlighted $row]
3688 if {$isbold > 0} {
3689 lappend boldrows $row
3690 set font mainfontbold
3691 if {$isbold > 1} {
3692 lappend boldnamerows $row
3693 set nfont mainfontbold
3694 }
3695 }
3696 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3697 -text $headline -font $font -tags text]
3698 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3699 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3700 -text $name -font $nfont -tags text]
3701 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3702 -text $date -font mainfont -tags text]
3703 if {[info exists selectedline] && $selectedline == $row} {
3704 make_secsel $row
3705 }
3706 set xr [expr {$xt + [font measure $font $headline]}]
3707 if {$xr > $canvxmax} {
3708 set canvxmax $xr
3709 setcanvscroll
3710 }
3711 }
3712
3713 proc drawcmitrow {row} {
3714 global displayorder rowidlist nrows_drawn
3715 global iddrawn markingmatches
3716 global commitinfo parentlist numcommits
3717 global filehighlight fhighlights findpattern nhighlights
3718 global hlview vhighlights
3719 global highlight_related rhighlights
3720
3721 if {$row >= $numcommits} return
3722
3723 set id [lindex $displayorder $row]
3724 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3725 askvhighlight $row $id
3726 }
3727 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3728 askfilehighlight $row $id
3729 }
3730 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3731 askfindhighlight $row $id
3732 }
3733 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3734 askrelhighlight $row $id
3735 }
3736 if {![info exists iddrawn($id)]} {
3737 set col [lsearch -exact [lindex $rowidlist $row] $id]
3738 if {$col < 0} {
3739 puts "oops, row $row id $id not in list"
3740 return
3741 }
3742 if {![info exists commitinfo($id)]} {
3743 getcommit $id
3744 }
3745 assigncolor $id
3746 drawcmittext $id $row $col
3747 set iddrawn($id) 1
3748 incr nrows_drawn
3749 }
3750 if {$markingmatches} {
3751 markrowmatches $row $id
3752 }
3753 }
3754
3755 proc drawcommits {row {endrow {}}} {
3756 global numcommits iddrawn displayorder curview need_redisplay
3757 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3758
3759 if {$row < 0} {
3760 set row 0
3761 }
3762 if {$endrow eq {}} {
3763 set endrow $row
3764 }
3765 if {$endrow >= $numcommits} {
3766 set endrow [expr {$numcommits - 1}]
3767 }
3768
3769 set rl1 [expr {$row - $downarrowlen - 3}]
3770 if {$rl1 < 0} {
3771 set rl1 0
3772 }
3773 set ro1 [expr {$row - 3}]
3774 if {$ro1 < 0} {
3775 set ro1 0
3776 }
3777 set r2 [expr {$endrow + $uparrowlen + 3}]
3778 if {$r2 > $numcommits} {
3779 set r2 $numcommits
3780 }
3781 for {set r $rl1} {$r < $r2} {incr r} {
3782 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3783 if {$rl1 < $r} {
3784 layoutrows $rl1 $r
3785 }
3786 set rl1 [expr {$r + 1}]
3787 }
3788 }
3789 if {$rl1 < $r} {
3790 layoutrows $rl1 $r
3791 }
3792 optimize_rows $ro1 0 $r2
3793 if {$need_redisplay || $nrows_drawn > 2000} {
3794 clear_display
3795 drawvisible
3796 }
3797
3798 # make the lines join to already-drawn rows either side
3799 set r [expr {$row - 1}]
3800 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3801 set r $row
3802 }
3803 set er [expr {$endrow + 1}]
3804 if {$er >= $numcommits ||
3805 ![info exists iddrawn([lindex $displayorder $er])]} {
3806 set er $endrow
3807 }
3808 for {} {$r <= $er} {incr r} {
3809 set id [lindex $displayorder $r]
3810 set wasdrawn [info exists iddrawn($id)]
3811 drawcmitrow $r
3812 if {$r == $er} break
3813 set nextid [lindex $displayorder [expr {$r + 1}]]
3814 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3815 drawparentlinks $id $r
3816
3817 set rowids [lindex $rowidlist $r]
3818 foreach lid $rowids {
3819 if {$lid eq {}} continue
3820 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3821 if {$lid eq $id} {
3822 # see if this is the first child of any of its parents
3823 foreach p [lindex $parentlist $r] {
3824 if {[lsearch -exact $rowids $p] < 0} {
3825 # make this line extend up to the child
3826 set lineend($p) [drawlineseg $p $r $er 0]
3827 }
3828 }
3829 } else {
3830 set lineend($lid) [drawlineseg $lid $r $er 1]
3831 }
3832 }
3833 }
3834 }
3835
3836 proc drawfrac {f0 f1} {
3837 global canv linespc
3838
3839 set ymax [lindex [$canv cget -scrollregion] 3]
3840 if {$ymax eq {} || $ymax == 0} return
3841 set y0 [expr {int($f0 * $ymax)}]
3842 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3843 set y1 [expr {int(