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