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