1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec 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
10proc 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.
24proc 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
36proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
38}
39
40proc 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
50proc 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
82proc start_rev_list {view} {
83 global startmsecs
84 global commfd leftover tclencoding datemode
85 global viewargs viewfiles commitidx viewcomplete vnextroot
86 global showlocalchanges commitinterest mainheadid
87
88 set startmsecs [clock clicks -milliseconds]
89 set commitidx($view) 0
90 set viewcomplete($view) 0
91 set vnextroot($view) 0
92 set order "--topo-order"
93 if {$datemode} {
94 set order "--date-order"
95 }
96 if {[catch {
97 set fd [open [concat | git log -z --pretty=raw $order --parents \
98 --boundary $viewargs($view) "--" $viewfiles($view)] r]
99 } err]} {
100 error_popup "Error executing git rev-list: $err"
101 exit 1
102 }
103 set commfd($view) $fd
104 set leftover($view) {}
105 if {$showlocalchanges} {
106 lappend commitinterest($mainheadid) {dodiffindex}
107 }
108 fconfigure $fd -blocking 0 -translation lf -eofchar {}
109 if {$tclencoding != {}} {
110 fconfigure $fd -encoding $tclencoding
111 }
112 filerun $fd [list getcommitlines $fd $view]
113 nowbusy $view
114}
115
116proc stop_rev_list {} {
117 global commfd curview
118
119 if {![info exists commfd($curview)]} return
120 set fd $commfd($curview)
121 catch {
122 set pid [pid $fd]
123 exec kill $pid
124 }
125 catch {close $fd}
126 unset commfd($curview)
127}
128
129proc getcommits {} {
130 global phase canv mainfont curview
131
132 set phase getcommits
133 initlayout
134 start_rev_list $curview
135 show_status "Reading commits..."
136}
137
138# This makes a string representation of a positive integer which
139# sorts as a string in numerical order
140proc strrep {n} {
141 if {$n < 16} {
142 return [format "%x" $n]
143 } elseif {$n < 256} {
144 return [format "x%.2x" $n]
145 } elseif {$n < 65536} {
146 return [format "y%.4x" $n]
147 }
148 return [format "z%.8x" $n]
149}
150
151proc getcommitlines {fd view} {
152 global commitlisted commitinterest
153 global leftover commfd
154 global displayorder commitidx viewcomplete commitrow commitdata
155 global parentlist children curview hlview
156 global vparentlist vdisporder vcmitlisted
157 global ordertok vnextroot idpending
158
159 set stuff [read $fd 500000]
160 # git log doesn't terminate the last commit with a null...
161 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
162 set stuff "\0"
163 }
164 if {$stuff == {}} {
165 if {![eof $fd]} {
166 return 1
167 }
168 # Check if we have seen any ids listed as parents that haven't
169 # appeared in the list
170 foreach vid [array names idpending "$view,*"] {
171 # should only get here if git log is buggy
172 set id [lindex [split $vid ","] 1]
173 set commitrow($vid) $commitidx($view)
174 incr commitidx($view)
175 if {$view == $curview} {
176 lappend parentlist {}
177 lappend displayorder $id
178 lappend commitlisted 0
179 } else {
180 lappend vparentlist($view) {}
181 lappend vdisporder($view) $id
182 lappend vcmitlisted($view) 0
183 }
184 }
185 set viewcomplete($view) 1
186 global viewname
187 unset commfd($view)
188 notbusy $view
189 # set it blocking so we wait for the process to terminate
190 fconfigure $fd -blocking 1
191 if {[catch {close $fd} err]} {
192 set fv {}
193 if {$view != $curview} {
194 set fv " for the \"$viewname($view)\" view"
195 }
196 if {[string range $err 0 4] == "usage"} {
197 set err "Gitk: error reading commits$fv:\
198 bad arguments to git rev-list."
199 if {$viewname($view) eq "Command line"} {
200 append err \
201 " (Note: arguments to gitk are passed to git rev-list\
202 to allow selection of commits to be displayed.)"
203 }
204 } else {
205 set err "Error reading commits$fv: $err"
206 }
207 error_popup $err
208 }
209 if {$view == $curview} {
210 run chewcommits $view
211 }
212 return 0
213 }
214 set start 0
215 set gotsome 0
216 while 1 {
217 set i [string first "\0" $stuff $start]
218 if {$i < 0} {
219 append leftover($view) [string range $stuff $start end]
220 break
221 }
222 if {$start == 0} {
223 set cmit $leftover($view)
224 append cmit [string range $stuff 0 [expr {$i - 1}]]
225 set leftover($view) {}
226 } else {
227 set cmit [string range $stuff $start [expr {$i - 1}]]
228 }
229 set start [expr {$i + 1}]
230 set j [string first "\n" $cmit]
231 set ok 0
232 set listed 1
233 if {$j >= 0 && [string match "commit *" $cmit]} {
234 set ids [string range $cmit 7 [expr {$j - 1}]]
235 if {[string match {[-<>]*} $ids]} {
236 switch -- [string index $ids 0] {
237 "-" {set listed 0}
238 "<" {set listed 2}
239 ">" {set listed 3}
240 }
241 set ids [string range $ids 1 end]
242 }
243 set ok 1
244 foreach id $ids {
245 if {[string length $id] != 40} {
246 set ok 0
247 break
248 }
249 }
250 }
251 if {!$ok} {
252 set shortcmit $cmit
253 if {[string length $shortcmit] > 80} {
254 set shortcmit "[string range $shortcmit 0 80]..."
255 }
256 error_popup "Can't parse git log output: {$shortcmit}"
257 exit 1
258 }
259 set id [lindex $ids 0]
260 if {![info exists ordertok($view,$id)]} {
261 set otok "o[strrep $vnextroot($view)]"
262 incr vnextroot($view)
263 set ordertok($view,$id) $otok
264 } else {
265 set otok $ordertok($view,$id)
266 unset idpending($view,$id)
267 }
268 if {$listed} {
269 set olds [lrange $ids 1 end]
270 if {[llength $olds] == 1} {
271 set p [lindex $olds 0]
272 lappend children($view,$p) $id
273 if {![info exists ordertok($view,$p)]} {
274 set ordertok($view,$p) $ordertok($view,$id)
275 set idpending($view,$p) 1
276 }
277 } else {
278 set i 0
279 foreach p $olds {
280 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
281 lappend children($view,$p) $id
282 }
283 if {![info exists ordertok($view,$p)]} {
284 set ordertok($view,$p) "$otok[strrep $i]]"
285 set idpending($view,$p) 1
286 }
287 incr i
288 }
289 }
290 } else {
291 set olds {}
292 }
293 if {![info exists children($view,$id)]} {
294 set children($view,$id) {}
295 }
296 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
297 set commitrow($view,$id) $commitidx($view)
298 incr commitidx($view)
299 if {$view == $curview} {
300 lappend parentlist $olds
301 lappend displayorder $id
302 lappend commitlisted $listed
303 } else {
304 lappend vparentlist($view) $olds
305 lappend vdisporder($view) $id
306 lappend vcmitlisted($view) $listed
307 }
308 if {[info exists commitinterest($id)]} {
309 foreach script $commitinterest($id) {
310 eval [string map [list "%I" $id] $script]
311 }
312 unset commitinterest($id)
313 }
314 set gotsome 1
315 }
316 if {$gotsome} {
317 run chewcommits $view
318 }
319 return 2
320}
321
322proc chewcommits {view} {
323 global curview hlview viewcomplete
324 global selectedline pending_select
325
326 if {$view == $curview} {
327 layoutmore
328 if {$viewcomplete($view)} {
329 global displayorder commitidx phase
330 global numcommits startmsecs
331
332 if {[info exists pending_select]} {
333 set row [first_real_row]
334 selectline $row 1
335 }
336 if {$commitidx($curview) > 0} {
337 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
338 #puts "overall $ms ms for $numcommits commits"
339 } else {
340 show_status "No commits selected"
341 }
342 notbusy layout
343 set phase {}
344 }
345 }
346 if {[info exists hlview] && $view == $hlview} {
347 vhighlightmore
348 }
349 return 0
350}
351
352proc readcommit {id} {
353 if {[catch {set contents [exec git cat-file commit $id]}]} return
354 parsecommit $id $contents 0
355}
356
357proc updatecommits {} {
358 global viewdata curview phase displayorder ordertok idpending
359 global children commitrow selectedline thickerline showneartags
360
361 if {$phase ne {}} {
362 stop_rev_list
363 set phase {}
364 }
365 set n $curview
366 foreach id $displayorder {
367 catch {unset children($n,$id)}
368 catch {unset commitrow($n,$id)}
369 catch {unset ordertok($n,$id)}
370 }
371 foreach vid [array names idpending "$n,*"] {
372 unset idpending($vid)
373 }
374 set curview -1
375 catch {unset selectedline}
376 catch {unset thickerline}
377 catch {unset viewdata($n)}
378 readrefs
379 changedrefs
380 if {$showneartags} {
381 getallcommits
382 }
383 showview $n
384}
385
386proc parsecommit {id contents listed} {
387 global commitinfo cdate
388
389 set inhdr 1
390 set comment {}
391 set headline {}
392 set auname {}
393 set audate {}
394 set comname {}
395 set comdate {}
396 set hdrend [string first "\n\n" $contents]
397 if {$hdrend < 0} {
398 # should never happen...
399 set hdrend [string length $contents]
400 }
401 set header [string range $contents 0 [expr {$hdrend - 1}]]
402 set comment [string range $contents [expr {$hdrend + 2}] end]
403 foreach line [split $header "\n"] {
404 set tag [lindex $line 0]
405 if {$tag == "author"} {
406 set audate [lindex $line end-1]
407 set auname [lrange $line 1 end-2]
408 } elseif {$tag == "committer"} {
409 set comdate [lindex $line end-1]
410 set comname [lrange $line 1 end-2]
411 }
412 }
413 set headline {}
414 # take the first non-blank line of the comment as the headline
415 set headline [string trimleft $comment]
416 set i [string first "\n" $headline]
417 if {$i >= 0} {
418 set headline [string range $headline 0 $i]
419 }
420 set headline [string trimright $headline]
421 set i [string first "\r" $headline]
422 if {$i >= 0} {
423 set headline [string trimright [string range $headline 0 $i]]
424 }
425 if {!$listed} {
426 # git rev-list indents the comment by 4 spaces;
427 # if we got this via git cat-file, add the indentation
428 set newcomment {}
429 foreach line [split $comment "\n"] {
430 append newcomment " "
431 append newcomment $line
432 append newcomment "\n"
433 }
434 set comment $newcomment
435 }
436 if {$comdate != {}} {
437 set cdate($id) $comdate
438 }
439 set commitinfo($id) [list $headline $auname $audate \
440 $comname $comdate $comment]
441}
442
443proc getcommit {id} {
444 global commitdata commitinfo
445
446 if {[info exists commitdata($id)]} {
447 parsecommit $id $commitdata($id) 1
448 } else {
449 readcommit $id
450 if {![info exists commitinfo($id)]} {
451 set commitinfo($id) {"No commit information available"}
452 }
453 }
454 return 1
455}
456
457proc readrefs {} {
458 global tagids idtags headids idheads tagobjid
459 global otherrefids idotherrefs mainhead mainheadid
460
461 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
462 catch {unset $v}
463 }
464 set refd [open [list | git show-ref -d] r]
465 while {[gets $refd line] >= 0} {
466 if {[string index $line 40] ne " "} continue
467 set id [string range $line 0 39]
468 set ref [string range $line 41 end]
469 if {![string match "refs/*" $ref]} continue
470 set name [string range $ref 5 end]
471 if {[string match "remotes/*" $name]} {
472 if {![string match "*/HEAD" $name]} {
473 set headids($name) $id
474 lappend idheads($id) $name
475 }
476 } elseif {[string match "heads/*" $name]} {
477 set name [string range $name 6 end]
478 set headids($name) $id
479 lappend idheads($id) $name
480 } elseif {[string match "tags/*" $name]} {
481 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
482 # which is what we want since the former is the commit ID
483 set name [string range $name 5 end]
484 if {[string match "*^{}" $name]} {
485 set name [string range $name 0 end-3]
486 } else {
487 set tagobjid($name) $id
488 }
489 set tagids($name) $id
490 lappend idtags($id) $name
491 } else {
492 set otherrefids($name) $id
493 lappend idotherrefs($id) $name
494 }
495 }
496 catch {close $refd}
497 set mainhead {}
498 set mainheadid {}
499 catch {
500 set thehead [exec git symbolic-ref HEAD]
501 if {[string match "refs/heads/*" $thehead]} {
502 set mainhead [string range $thehead 11 end]
503 if {[info exists headids($mainhead)]} {
504 set mainheadid $headids($mainhead)
505 }
506 }
507 }
508}
509
510# skip over fake commits
511proc first_real_row {} {
512 global nullid nullid2 displayorder numcommits
513
514 for {set row 0} {$row < $numcommits} {incr row} {
515 set id [lindex $displayorder $row]
516 if {$id ne $nullid && $id ne $nullid2} {
517 break
518 }
519 }
520 return $row
521}
522
523# update things for a head moved to a child of its previous location
524proc movehead {id name} {
525 global headids idheads
526
527 removehead $headids($name) $name
528 set headids($name) $id
529 lappend idheads($id) $name
530}
531
532# update things when a head has been removed
533proc removehead {id name} {
534 global headids idheads
535
536 if {$idheads($id) eq $name} {
537 unset idheads($id)
538 } else {
539 set i [lsearch -exact $idheads($id) $name]
540 if {$i >= 0} {
541 set idheads($id) [lreplace $idheads($id) $i $i]
542 }
543 }
544 unset headids($name)
545}
546
547proc show_error {w top msg} {
548 message $w.m -text $msg -justify center -aspect 400
549 pack $w.m -side top -fill x -padx 20 -pady 20
550 button $w.ok -text OK -command "destroy $top"
551 pack $w.ok -side bottom -fill x
552 bind $top <Visibility> "grab $top; focus $top"
553 bind $top <Key-Return> "destroy $top"
554 tkwait window $top
555}
556
557proc error_popup msg {
558 set w .error
559 toplevel $w
560 wm transient $w .
561 show_error $w $w $msg
562}
563
564proc confirm_popup msg {
565 global confirm_ok
566 set confirm_ok 0
567 set w .confirm
568 toplevel $w
569 wm transient $w .
570 message $w.m -text $msg -justify center -aspect 400
571 pack $w.m -side top -fill x -padx 20 -pady 20
572 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
573 pack $w.ok -side left -fill x
574 button $w.cancel -text Cancel -command "destroy $w"
575 pack $w.cancel -side right -fill x
576 bind $w <Visibility> "grab $w; focus $w"
577 tkwait window $w
578 return $confirm_ok
579}
580
581proc makewindow {} {
582 global canv canv2 canv3 linespc charspc ctext cflist
583 global textfont mainfont uifont tabstop
584 global findtype findtypemenu findloc findstring fstring geometry
585 global entries sha1entry sha1string sha1but
586 global diffcontextstring diffcontext
587 global maincursor textcursor curtextcursor
588 global rowctxmenu fakerowmenu mergemax wrapcomment
589 global highlight_files gdttype
590 global searchstring sstring
591 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
592 global headctxmenu
593
594 menu .bar
595 .bar add cascade -label "File" -menu .bar.file
596 .bar configure -font $uifont
597 menu .bar.file
598 .bar.file add command -label "Update" -command updatecommits
599 .bar.file add command -label "Reread references" -command rereadrefs
600 .bar.file add command -label "List references" -command showrefs
601 .bar.file add command -label "Quit" -command doquit
602 .bar.file configure -font $uifont
603 menu .bar.edit
604 .bar add cascade -label "Edit" -menu .bar.edit
605 .bar.edit add command -label "Preferences" -command doprefs
606 .bar.edit configure -font $uifont
607
608 menu .bar.view -font $uifont
609 .bar add cascade -label "View" -menu .bar.view
610 .bar.view add command -label "New view..." -command {newview 0}
611 .bar.view add command -label "Edit view..." -command editview \
612 -state disabled
613 .bar.view add command -label "Delete view" -command delview -state disabled
614 .bar.view add separator
615 .bar.view add radiobutton -label "All files" -command {showview 0} \
616 -variable selectedview -value 0
617
618 menu .bar.help
619 .bar add cascade -label "Help" -menu .bar.help
620 .bar.help add command -label "About gitk" -command about
621 .bar.help add command -label "Key bindings" -command keys
622 .bar.help configure -font $uifont
623 . configure -menu .bar
624
625 # the gui has upper and lower half, parts of a paned window.
626 panedwindow .ctop -orient vertical
627
628 # possibly use assumed geometry
629 if {![info exists geometry(pwsash0)]} {
630 set geometry(topheight) [expr {15 * $linespc}]
631 set geometry(topwidth) [expr {80 * $charspc}]
632 set geometry(botheight) [expr {15 * $linespc}]
633 set geometry(botwidth) [expr {50 * $charspc}]
634 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
635 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
636 }
637
638 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
639 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
640 frame .tf.histframe
641 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
642
643 # create three canvases
644 set cscroll .tf.histframe.csb
645 set canv .tf.histframe.pwclist.canv
646 canvas $canv \
647 -selectbackground $selectbgcolor \
648 -background $bgcolor -bd 0 \
649 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
650 .tf.histframe.pwclist add $canv
651 set canv2 .tf.histframe.pwclist.canv2
652 canvas $canv2 \
653 -selectbackground $selectbgcolor \
654 -background $bgcolor -bd 0 -yscrollincr $linespc
655 .tf.histframe.pwclist add $canv2
656 set canv3 .tf.histframe.pwclist.canv3
657 canvas $canv3 \
658 -selectbackground $selectbgcolor \
659 -background $bgcolor -bd 0 -yscrollincr $linespc
660 .tf.histframe.pwclist add $canv3
661 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
662 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
663
664 # a scroll bar to rule them
665 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
666 pack $cscroll -side right -fill y
667 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
668 lappend bglist $canv $canv2 $canv3
669 pack .tf.histframe.pwclist -fill both -expand 1 -side left
670
671 # we have two button bars at bottom of top frame. Bar 1
672 frame .tf.bar
673 frame .tf.lbar -height 15
674
675 set sha1entry .tf.bar.sha1
676 set entries $sha1entry
677 set sha1but .tf.bar.sha1label
678 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
679 -command gotocommit -width 8 -font $uifont
680 $sha1but conf -disabledforeground [$sha1but cget -foreground]
681 pack .tf.bar.sha1label -side left
682 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
683 trace add variable sha1string write sha1change
684 pack $sha1entry -side left -pady 2
685
686 image create bitmap bm-left -data {
687 #define left_width 16
688 #define left_height 16
689 static unsigned char left_bits[] = {
690 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
691 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
692 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
693 }
694 image create bitmap bm-right -data {
695 #define right_width 16
696 #define right_height 16
697 static unsigned char right_bits[] = {
698 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
699 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
700 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
701 }
702 button .tf.bar.leftbut -image bm-left -command goback \
703 -state disabled -width 26
704 pack .tf.bar.leftbut -side left -fill y
705 button .tf.bar.rightbut -image bm-right -command goforw \
706 -state disabled -width 26
707 pack .tf.bar.rightbut -side left -fill y
708
709 # build up the bottom bar of upper window
710 label .tf.lbar.flabel -text "Find " -font $uifont
711 button .tf.lbar.fnext -text "next" -command dofind -font $uifont
712 button .tf.lbar.fprev -text "prev" -command {dofind 1} -font $uifont
713 label .tf.lbar.flab2 -text " commit " -font $uifont
714 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
715 -side left -fill y
716 set gdttype "containing:"
717 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
718 "containing:" \
719 "touching paths:" \
720 "adding/removing string:"]
721 trace add variable gdttype write gdttype_change
722 $gm conf -font $uifont
723 .tf.lbar.gdttype conf -font $uifont
724 pack .tf.lbar.gdttype -side left -fill y
725
726 set findstring {}
727 set fstring .tf.lbar.findstring
728 lappend entries $fstring
729 entry $fstring -width 30 -font $textfont -textvariable findstring
730 trace add variable findstring write find_change
731 set findtype Exact
732 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
733 findtype Exact IgnCase Regexp]
734 trace add variable findtype write findcom_change
735 .tf.lbar.findtype configure -font $uifont
736 .tf.lbar.findtype.menu configure -font $uifont
737 set findloc "All fields"
738 tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
739 Comments Author Committer
740 trace add variable findloc write find_change
741 .tf.lbar.findloc configure -font $uifont
742 .tf.lbar.findloc.menu configure -font $uifont
743 pack .tf.lbar.findloc -side right
744 pack .tf.lbar.findtype -side right
745 pack $fstring -side left -expand 1 -fill x
746
747 # Finish putting the upper half of the viewer together
748 pack .tf.lbar -in .tf -side bottom -fill x
749 pack .tf.bar -in .tf -side bottom -fill x
750 pack .tf.histframe -fill both -side top -expand 1
751 .ctop add .tf
752 .ctop paneconfigure .tf -height $geometry(topheight)
753 .ctop paneconfigure .tf -width $geometry(topwidth)
754
755 # now build up the bottom
756 panedwindow .pwbottom -orient horizontal
757
758 # lower left, a text box over search bar, scroll bar to the right
759 # if we know window height, then that will set the lower text height, otherwise
760 # we set lower text height which will drive window height
761 if {[info exists geometry(main)]} {
762 frame .bleft -width $geometry(botwidth)
763 } else {
764 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
765 }
766 frame .bleft.top
767 frame .bleft.mid
768
769 button .bleft.top.search -text "Search" -command dosearch \
770 -font $uifont
771 pack .bleft.top.search -side left -padx 5
772 set sstring .bleft.top.sstring
773 entry $sstring -width 20 -font $textfont -textvariable searchstring
774 lappend entries $sstring
775 trace add variable searchstring write incrsearch
776 pack $sstring -side left -expand 1 -fill x
777 radiobutton .bleft.mid.diff -text "Diff" \
778 -command changediffdisp -variable diffelide -value {0 0}
779 radiobutton .bleft.mid.old -text "Old version" \
780 -command changediffdisp -variable diffelide -value {0 1}
781 radiobutton .bleft.mid.new -text "New version" \
782 -command changediffdisp -variable diffelide -value {1 0}
783 label .bleft.mid.labeldiffcontext -text " Lines of context: " \
784 -font $uifont
785 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
786 spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
787 -from 1 -increment 1 -to 10000000 \
788 -validate all -validatecommand "diffcontextvalidate %P" \
789 -textvariable diffcontextstring
790 .bleft.mid.diffcontext set $diffcontext
791 trace add variable diffcontextstring write diffcontextchange
792 lappend entries .bleft.mid.diffcontext
793 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
794 set ctext .bleft.ctext
795 text $ctext -background $bgcolor -foreground $fgcolor \
796 -tabs "[expr {$tabstop * $charspc}]" \
797 -state disabled -font $textfont \
798 -yscrollcommand scrolltext -wrap none
799 scrollbar .bleft.sb -command "$ctext yview"
800 pack .bleft.top -side top -fill x
801 pack .bleft.mid -side top -fill x
802 pack .bleft.sb -side right -fill y
803 pack $ctext -side left -fill both -expand 1
804 lappend bglist $ctext
805 lappend fglist $ctext
806
807 $ctext tag conf comment -wrap $wrapcomment
808 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
809 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
810 $ctext tag conf d0 -fore [lindex $diffcolors 0]
811 $ctext tag conf d1 -fore [lindex $diffcolors 1]
812 $ctext tag conf m0 -fore red
813 $ctext tag conf m1 -fore blue
814 $ctext tag conf m2 -fore green
815 $ctext tag conf m3 -fore purple
816 $ctext tag conf m4 -fore brown
817 $ctext tag conf m5 -fore "#009090"
818 $ctext tag conf m6 -fore magenta
819 $ctext tag conf m7 -fore "#808000"
820 $ctext tag conf m8 -fore "#009000"
821 $ctext tag conf m9 -fore "#ff0080"
822 $ctext tag conf m10 -fore cyan
823 $ctext tag conf m11 -fore "#b07070"
824 $ctext tag conf m12 -fore "#70b0f0"
825 $ctext tag conf m13 -fore "#70f0b0"
826 $ctext tag conf m14 -fore "#f0b070"
827 $ctext tag conf m15 -fore "#ff70b0"
828 $ctext tag conf mmax -fore darkgrey
829 set mergemax 16
830 $ctext tag conf mresult -font [concat $textfont bold]
831 $ctext tag conf msep -font [concat $textfont bold]
832 $ctext tag conf found -back yellow
833
834 .pwbottom add .bleft
835 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
836
837 # lower right
838 frame .bright
839 frame .bright.mode
840 radiobutton .bright.mode.patch -text "Patch" \
841 -command reselectline -variable cmitmode -value "patch"
842 .bright.mode.patch configure -font $uifont
843 radiobutton .bright.mode.tree -text "Tree" \
844 -command reselectline -variable cmitmode -value "tree"
845 .bright.mode.tree configure -font $uifont
846 grid .bright.mode.patch .bright.mode.tree -sticky ew
847 pack .bright.mode -side top -fill x
848 set cflist .bright.cfiles
849 set indent [font measure $mainfont "nn"]
850 text $cflist \
851 -selectbackground $selectbgcolor \
852 -background $bgcolor -foreground $fgcolor \
853 -font $mainfont \
854 -tabs [list $indent [expr {2 * $indent}]] \
855 -yscrollcommand ".bright.sb set" \
856 -cursor [. cget -cursor] \
857 -spacing1 1 -spacing3 1
858 lappend bglist $cflist
859 lappend fglist $cflist
860 scrollbar .bright.sb -command "$cflist yview"
861 pack .bright.sb -side right -fill y
862 pack $cflist -side left -fill both -expand 1
863 $cflist tag configure highlight \
864 -background [$cflist cget -selectbackground]
865 $cflist tag configure bold -font [concat $mainfont bold]
866
867 .pwbottom add .bright
868 .ctop add .pwbottom
869
870 # restore window position if known
871 if {[info exists geometry(main)]} {
872 wm geometry . "$geometry(main)"
873 }
874
875 if {[tk windowingsystem] eq {aqua}} {
876 set M1B M1
877 } else {
878 set M1B Control
879 }
880
881 bind .pwbottom <Configure> {resizecdetpanes %W %w}
882 pack .ctop -fill both -expand 1
883 bindall <1> {selcanvline %W %x %y}
884 #bindall <B1-Motion> {selcanvline %W %x %y}
885 if {[tk windowingsystem] == "win32"} {
886 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
887 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
888 } else {
889 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
890 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
891 }
892 bindall <2> "canvscan mark %W %x %y"
893 bindall <B2-Motion> "canvscan dragto %W %x %y"
894 bindkey <Home> selfirstline
895 bindkey <End> sellastline
896 bind . <Key-Up> "selnextline -1"
897 bind . <Key-Down> "selnextline 1"
898 bindkey <Key-Right> "goforw"
899 bindkey <Key-Left> "goback"
900 bind . <Key-Prior> "selnextpage -1"
901 bind . <Key-Next> "selnextpage 1"
902 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
903 bind . <$M1B-End> "allcanvs yview moveto 1.0"
904 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
905 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
906 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
907 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
908 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
909 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
910 bindkey <Key-space> "$ctext yview scroll 1 pages"
911 bindkey p "selnextline -1"
912 bindkey n "selnextline 1"
913 bindkey z "goback"
914 bindkey x "goforw"
915 bindkey i "selnextline -1"
916 bindkey k "selnextline 1"
917 bindkey j "goback"
918 bindkey l "goforw"
919 bindkey b "$ctext yview scroll -1 pages"
920 bindkey d "$ctext yview scroll 18 units"
921 bindkey u "$ctext yview scroll -18 units"
922 bindkey / {findnext 1}
923 bindkey <Key-Return> {findnext 0}
924 bindkey ? findprev
925 bindkey f nextfile
926 bindkey <F5> updatecommits
927 bind . <$M1B-q> doquit
928 bind . <$M1B-f> dofind
929 bind . <$M1B-g> {findnext 0}
930 bind . <$M1B-r> dosearchback
931 bind . <$M1B-s> dosearch
932 bind . <$M1B-equal> {incrfont 1}
933 bind . <$M1B-KP_Add> {incrfont 1}
934 bind . <$M1B-minus> {incrfont -1}
935 bind . <$M1B-KP_Subtract> {incrfont -1}
936 wm protocol . WM_DELETE_WINDOW doquit
937 bind . <Button-1> "click %W"
938 bind $fstring <Key-Return> dofind
939 bind $sha1entry <Key-Return> gotocommit
940 bind $sha1entry <<PasteSelection>> clearsha1
941 bind $cflist <1> {sel_flist %W %x %y; break}
942 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
943 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
944 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
945
946 set maincursor [. cget -cursor]
947 set textcursor [$ctext cget -cursor]
948 set curtextcursor $textcursor
949
950 set rowctxmenu .rowctxmenu
951 menu $rowctxmenu -tearoff 0
952 $rowctxmenu add command -label "Diff this -> selected" \
953 -command {diffvssel 0}
954 $rowctxmenu add command -label "Diff selected -> this" \
955 -command {diffvssel 1}
956 $rowctxmenu add command -label "Make patch" -command mkpatch
957 $rowctxmenu add command -label "Create tag" -command mktag
958 $rowctxmenu add command -label "Write commit to file" -command writecommit
959 $rowctxmenu add command -label "Create new branch" -command mkbranch
960 $rowctxmenu add command -label "Cherry-pick this commit" \
961 -command cherrypick
962 $rowctxmenu add command -label "Reset HEAD branch to here" \
963 -command resethead
964
965 set fakerowmenu .fakerowmenu
966 menu $fakerowmenu -tearoff 0
967 $fakerowmenu add command -label "Diff this -> selected" \
968 -command {diffvssel 0}
969 $fakerowmenu add command -label "Diff selected -> this" \
970 -command {diffvssel 1}
971 $fakerowmenu add command -label "Make patch" -command mkpatch
972# $fakerowmenu add command -label "Commit" -command {mkcommit 0}
973# $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
974# $fakerowmenu add command -label "Revert local changes" -command revertlocal
975
976 set headctxmenu .headctxmenu
977 menu $headctxmenu -tearoff 0
978 $headctxmenu add command -label "Check out this branch" \
979 -command cobranch
980 $headctxmenu add command -label "Remove this branch" \
981 -command rmbranch
982
983 global flist_menu
984 set flist_menu .flistctxmenu
985 menu $flist_menu -tearoff 0
986 $flist_menu add command -label "Highlight this too" \
987 -command {flist_hl 0}
988 $flist_menu add command -label "Highlight this only" \
989 -command {flist_hl 1}
990}
991
992# Windows sends all mouse wheel events to the current focused window, not
993# the one where the mouse hovers, so bind those events here and redirect
994# to the correct window
995proc windows_mousewheel_redirector {W X Y D} {
996 global canv canv2 canv3
997 set w [winfo containing -displayof $W $X $Y]
998 if {$w ne ""} {
999 set u [expr {$D < 0 ? 5 : -5}]
1000 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1001 allcanvs yview scroll $u units
1002 } else {
1003 catch {
1004 $w yview scroll $u units
1005 }
1006 }
1007 }
1008}
1009
1010# mouse-2 makes all windows scan vertically, but only the one
1011# the cursor is in scans horizontally
1012proc canvscan {op w x y} {
1013 global canv canv2 canv3
1014 foreach c [list $canv $canv2 $canv3] {
1015 if {$c == $w} {
1016 $c scan $op $x $y
1017 } else {
1018 $c scan $op 0 $y
1019 }
1020 }
1021}
1022
1023proc scrollcanv {cscroll f0 f1} {
1024 $cscroll set $f0 $f1
1025 drawfrac $f0 $f1
1026 flushhighlights
1027}
1028
1029# when we make a key binding for the toplevel, make sure
1030# it doesn't get triggered when that key is pressed in the
1031# find string entry widget.
1032proc bindkey {ev script} {
1033 global entries
1034 bind . $ev $script
1035 set escript [bind Entry $ev]
1036 if {$escript == {}} {
1037 set escript [bind Entry <Key>]
1038 }
1039 foreach e $entries {
1040 bind $e $ev "$escript; break"
1041 }
1042}
1043
1044# set the focus back to the toplevel for any click outside
1045# the entry widgets
1046proc click {w} {
1047 global ctext entries
1048 foreach e [concat $entries $ctext] {
1049 if {$w == $e} return
1050 }
1051 focus .
1052}
1053
1054proc savestuff {w} {
1055 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1056 global stuffsaved findmergefiles maxgraphpct
1057 global maxwidth showneartags showlocalchanges
1058 global viewname viewfiles viewargs viewperm nextviewnum
1059 global cmitmode wrapcomment datetimeformat
1060 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1061
1062 if {$stuffsaved} return
1063 if {![winfo viewable .]} return
1064 catch {
1065 set f [open "~/.gitk-new" w]
1066 puts $f [list set mainfont $mainfont]
1067 puts $f [list set textfont $textfont]
1068 puts $f [list set uifont $uifont]
1069 puts $f [list set tabstop $tabstop]
1070 puts $f [list set findmergefiles $findmergefiles]
1071 puts $f [list set maxgraphpct $maxgraphpct]
1072 puts $f [list set maxwidth $maxwidth]
1073 puts $f [list set cmitmode $cmitmode]
1074 puts $f [list set wrapcomment $wrapcomment]
1075 puts $f [list set showneartags $showneartags]
1076 puts $f [list set showlocalchanges $showlocalchanges]
1077 puts $f [list set datetimeformat $datetimeformat]
1078 puts $f [list set bgcolor $bgcolor]
1079 puts $f [list set fgcolor $fgcolor]
1080 puts $f [list set colors $colors]
1081 puts $f [list set diffcolors $diffcolors]
1082 puts $f [list set diffcontext $diffcontext]
1083 puts $f [list set selectbgcolor $selectbgcolor]
1084
1085 puts $f "set geometry(main) [wm geometry .]"
1086 puts $f "set geometry(topwidth) [winfo width .tf]"
1087 puts $f "set geometry(topheight) [winfo height .tf]"
1088 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1089 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1090 puts $f "set geometry(botwidth) [winfo width .bleft]"
1091 puts $f "set geometry(botheight) [winfo height .bleft]"
1092
1093 puts -nonewline $f "set permviews {"
1094 for {set v 0} {$v < $nextviewnum} {incr v} {
1095 if {$viewperm($v)} {
1096 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1097 }
1098 }
1099 puts $f "}"
1100 close $f
1101 file rename -force "~/.gitk-new" "~/.gitk"
1102 }
1103 set stuffsaved 1
1104}
1105
1106proc resizeclistpanes {win w} {
1107 global oldwidth
1108 if {[info exists oldwidth($win)]} {
1109 set s0 [$win sash coord 0]
1110 set s1 [$win sash coord 1]
1111 if {$w < 60} {
1112 set sash0 [expr {int($w/2 - 2)}]
1113 set sash1 [expr {int($w*5/6 - 2)}]
1114 } else {
1115 set factor [expr {1.0 * $w / $oldwidth($win)}]
1116 set sash0 [expr {int($factor * [lindex $s0 0])}]
1117 set sash1 [expr {int($factor * [lindex $s1 0])}]
1118 if {$sash0 < 30} {
1119 set sash0 30
1120 }
1121 if {$sash1 < $sash0 + 20} {
1122 set sash1 [expr {$sash0 + 20}]
1123 }
1124 if {$sash1 > $w - 10} {
1125 set sash1 [expr {$w - 10}]
1126 if {$sash0 > $sash1 - 20} {
1127 set sash0 [expr {$sash1 - 20}]
1128 }
1129 }
1130 }
1131 $win sash place 0 $sash0 [lindex $s0 1]
1132 $win sash place 1 $sash1 [lindex $s1 1]
1133 }
1134 set oldwidth($win) $w
1135}
1136
1137proc resizecdetpanes {win w} {
1138 global oldwidth
1139 if {[info exists oldwidth($win)]} {
1140 set s0 [$win sash coord 0]
1141 if {$w < 60} {
1142 set sash0 [expr {int($w*3/4 - 2)}]
1143 } else {
1144 set factor [expr {1.0 * $w / $oldwidth($win)}]
1145 set sash0 [expr {int($factor * [lindex $s0 0])}]
1146 if {$sash0 < 45} {
1147 set sash0 45
1148 }
1149 if {$sash0 > $w - 15} {
1150 set sash0 [expr {$w - 15}]
1151 }
1152 }
1153 $win sash place 0 $sash0 [lindex $s0 1]
1154 }
1155 set oldwidth($win) $w
1156}
1157
1158proc allcanvs args {
1159 global canv canv2 canv3
1160 eval $canv $args
1161 eval $canv2 $args
1162 eval $canv3 $args
1163}
1164
1165proc bindall {event action} {
1166 global canv canv2 canv3
1167 bind $canv $event $action
1168 bind $canv2 $event $action
1169 bind $canv3 $event $action
1170}
1171
1172proc about {} {
1173 global uifont
1174 set w .about
1175 if {[winfo exists $w]} {
1176 raise $w
1177 return
1178 }
1179 toplevel $w
1180 wm title $w "About gitk"
1181 message $w.m -text {
1182Gitk - a commit viewer for git
1183
1184Copyright © 2005-2006 Paul Mackerras
1185
1186Use and redistribute under the terms of the GNU General Public License} \
1187 -justify center -aspect 400 -border 2 -bg white -relief groove
1188 pack $w.m -side top -fill x -padx 2 -pady 2
1189 $w.m configure -font $uifont
1190 button $w.ok -text Close -command "destroy $w" -default active
1191 pack $w.ok -side bottom
1192 $w.ok configure -font $uifont
1193 bind $w <Visibility> "focus $w.ok"
1194 bind $w <Key-Escape> "destroy $w"
1195 bind $w <Key-Return> "destroy $w"
1196}
1197
1198proc keys {} {
1199 global uifont
1200 set w .keys
1201 if {[winfo exists $w]} {
1202 raise $w
1203 return
1204 }
1205 if {[tk windowingsystem] eq {aqua}} {
1206 set M1T Cmd
1207 } else {
1208 set M1T Ctrl
1209 }
1210 toplevel $w
1211 wm title $w "Gitk key bindings"
1212 message $w.m -text "
1213Gitk key bindings:
1214
1215<$M1T-Q> Quit
1216<Home> Move to first commit
1217<End> Move to last commit
1218<Up>, p, i Move up one commit
1219<Down>, n, k Move down one commit
1220<Left>, z, j Go back in history list
1221<Right>, x, l Go forward in history list
1222<PageUp> Move up one page in commit list
1223<PageDown> Move down one page in commit list
1224<$M1T-Home> Scroll to top of commit list
1225<$M1T-End> Scroll to bottom of commit list
1226<$M1T-Up> Scroll commit list up one line
1227<$M1T-Down> Scroll commit list down one line
1228<$M1T-PageUp> Scroll commit list up one page
1229<$M1T-PageDown> Scroll commit list down one page
1230<Shift-Up> Move to previous highlighted line
1231<Shift-Down> Move to next highlighted line
1232<Delete>, b Scroll diff view up one page
1233<Backspace> Scroll diff view up one page
1234<Space> Scroll diff view down one page
1235u Scroll diff view up 18 lines
1236d Scroll diff view down 18 lines
1237<$M1T-F> Find
1238<$M1T-G> Move to next find hit
1239<Return> Move to next find hit
1240/ Move to next find hit, or redo find
1241? Move to previous find hit
1242f Scroll diff view to next file
1243<$M1T-S> Search for next hit in diff view
1244<$M1T-R> Search for previous hit in diff view
1245<$M1T-KP+> Increase font size
1246<$M1T-plus> Increase font size
1247<$M1T-KP-> Decrease font size
1248<$M1T-minus> Decrease font size
1249<F5> Update
1250" \
1251 -justify left -bg white -border 2 -relief groove
1252 pack $w.m -side top -fill both -padx 2 -pady 2
1253 $w.m configure -font $uifont
1254 button $w.ok -text Close -command "destroy $w" -default active
1255 pack $w.ok -side bottom
1256 $w.ok configure -font $uifont
1257 bind $w <Visibility> "focus $w.ok"
1258 bind $w <Key-Escape> "destroy $w"
1259 bind $w <Key-Return> "destroy $w"
1260}
1261
1262# Procedures for manipulating the file list window at the
1263# bottom right of the overall window.
1264
1265proc treeview {w l openlevs} {
1266 global treecontents treediropen treeheight treeparent treeindex
1267
1268 set ix 0
1269 set treeindex() 0
1270 set lev 0
1271 set prefix {}
1272 set prefixend -1
1273 set prefendstack {}
1274 set htstack {}
1275 set ht 0
1276 set treecontents() {}
1277 $w conf -state normal
1278 foreach f $l {
1279 while {[string range $f 0 $prefixend] ne $prefix} {
1280 if {$lev <= $openlevs} {
1281 $w mark set e:$treeindex($prefix) "end -1c"
1282 $w mark gravity e:$treeindex($prefix) left
1283 }
1284 set treeheight($prefix) $ht
1285 incr ht [lindex $htstack end]
1286 set htstack [lreplace $htstack end end]
1287 set prefixend [lindex $prefendstack end]
1288 set prefendstack [lreplace $prefendstack end end]
1289 set prefix [string range $prefix 0 $prefixend]
1290 incr lev -1
1291 }
1292 set tail [string range $f [expr {$prefixend+1}] end]
1293 while {[set slash [string first "/" $tail]] >= 0} {
1294 lappend htstack $ht
1295 set ht 0
1296 lappend prefendstack $prefixend
1297 incr prefixend [expr {$slash + 1}]
1298 set d [string range $tail 0 $slash]
1299 lappend treecontents($prefix) $d
1300 set oldprefix $prefix
1301 append prefix $d
1302 set treecontents($prefix) {}
1303 set treeindex($prefix) [incr ix]
1304 set treeparent($prefix) $oldprefix
1305 set tail [string range $tail [expr {$slash+1}] end]
1306 if {$lev <= $openlevs} {
1307 set ht 1
1308 set treediropen($prefix) [expr {$lev < $openlevs}]
1309 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1310 $w mark set d:$ix "end -1c"
1311 $w mark gravity d:$ix left
1312 set str "\n"
1313 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1314 $w insert end $str
1315 $w image create end -align center -image $bm -padx 1 \
1316 -name a:$ix
1317 $w insert end $d [highlight_tag $prefix]
1318 $w mark set s:$ix "end -1c"
1319 $w mark gravity s:$ix left
1320 }
1321 incr lev
1322 }
1323 if {$tail ne {}} {
1324 if {$lev <= $openlevs} {
1325 incr ht
1326 set str "\n"
1327 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1328 $w insert end $str
1329 $w insert end $tail [highlight_tag $f]
1330 }
1331 lappend treecontents($prefix) $tail
1332 }
1333 }
1334 while {$htstack ne {}} {
1335 set treeheight($prefix) $ht
1336 incr ht [lindex $htstack end]
1337 set htstack [lreplace $htstack end end]
1338 set prefixend [lindex $prefendstack end]
1339 set prefendstack [lreplace $prefendstack end end]
1340 set prefix [string range $prefix 0 $prefixend]
1341 }
1342 $w conf -state disabled
1343}
1344
1345proc linetoelt {l} {
1346 global treeheight treecontents
1347
1348 set y 2
1349 set prefix {}
1350 while {1} {
1351 foreach e $treecontents($prefix) {
1352 if {$y == $l} {
1353 return "$prefix$e"
1354 }
1355 set n 1
1356 if {[string index $e end] eq "/"} {
1357 set n $treeheight($prefix$e)
1358 if {$y + $n > $l} {
1359 append prefix $e
1360 incr y
1361 break
1362 }
1363 }
1364 incr y $n
1365 }
1366 }
1367}
1368
1369proc highlight_tree {y prefix} {
1370 global treeheight treecontents cflist
1371
1372 foreach e $treecontents($prefix) {
1373 set path $prefix$e
1374 if {[highlight_tag $path] ne {}} {
1375 $cflist tag add bold $y.0 "$y.0 lineend"
1376 }
1377 incr y
1378 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1379 set y [highlight_tree $y $path]
1380 }
1381 }
1382 return $y
1383}
1384
1385proc treeclosedir {w dir} {
1386 global treediropen treeheight treeparent treeindex
1387
1388 set ix $treeindex($dir)
1389 $w conf -state normal
1390 $w delete s:$ix e:$ix
1391 set treediropen($dir) 0
1392 $w image configure a:$ix -image tri-rt
1393 $w conf -state disabled
1394 set n [expr {1 - $treeheight($dir)}]
1395 while {$dir ne {}} {
1396 incr treeheight($dir) $n
1397 set dir $treeparent($dir)
1398 }
1399}
1400
1401proc treeopendir {w dir} {
1402 global treediropen treeheight treeparent treecontents treeindex
1403
1404 set ix $treeindex($dir)
1405 $w conf -state normal
1406 $w image configure a:$ix -image tri-dn
1407 $w mark set e:$ix s:$ix
1408 $w mark gravity e:$ix right
1409 set lev 0
1410 set str "\n"
1411 set n [llength $treecontents($dir)]
1412 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1413 incr lev
1414 append str "\t"
1415 incr treeheight($x) $n
1416 }
1417 foreach e $treecontents($dir) {
1418 set de $dir$e
1419 if {[string index $e end] eq "/"} {
1420 set iy $treeindex($de)
1421 $w mark set d:$iy e:$ix
1422 $w mark gravity d:$iy left
1423 $w insert e:$ix $str
1424 set treediropen($de) 0
1425 $w image create e:$ix -align center -image tri-rt -padx 1 \
1426 -name a:$iy
1427 $w insert e:$ix $e [highlight_tag $de]
1428 $w mark set s:$iy e:$ix
1429 $w mark gravity s:$iy left
1430 set treeheight($de) 1
1431 } else {
1432 $w insert e:$ix $str
1433 $w insert e:$ix $e [highlight_tag $de]
1434 }
1435 }
1436 $w mark gravity e:$ix left
1437 $w conf -state disabled
1438 set treediropen($dir) 1
1439 set top [lindex [split [$w index @0,0] .] 0]
1440 set ht [$w cget -height]
1441 set l [lindex [split [$w index s:$ix] .] 0]
1442 if {$l < $top} {
1443 $w yview $l.0
1444 } elseif {$l + $n + 1 > $top + $ht} {
1445 set top [expr {$l + $n + 2 - $ht}]
1446 if {$l < $top} {
1447 set top $l
1448 }
1449 $w yview $top.0
1450 }
1451}
1452
1453proc treeclick {w x y} {
1454 global treediropen cmitmode ctext cflist cflist_top
1455
1456 if {$cmitmode ne "tree"} return
1457 if {![info exists cflist_top]} return
1458 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1459 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1460 $cflist tag add highlight $l.0 "$l.0 lineend"
1461 set cflist_top $l
1462 if {$l == 1} {
1463 $ctext yview 1.0
1464 return
1465 }
1466 set e [linetoelt $l]
1467 if {[string index $e end] ne "/"} {
1468 showfile $e
1469 } elseif {$treediropen($e)} {
1470 treeclosedir $w $e
1471 } else {
1472 treeopendir $w $e
1473 }
1474}
1475
1476proc setfilelist {id} {
1477 global treefilelist cflist
1478
1479 treeview $cflist $treefilelist($id) 0
1480}
1481
1482image create bitmap tri-rt -background black -foreground blue -data {
1483 #define tri-rt_width 13
1484 #define tri-rt_height 13
1485 static unsigned char tri-rt_bits[] = {
1486 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1487 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1488 0x00, 0x00};
1489} -maskdata {
1490 #define tri-rt-mask_width 13
1491 #define tri-rt-mask_height 13
1492 static unsigned char tri-rt-mask_bits[] = {
1493 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1494 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1495 0x08, 0x00};
1496}
1497image create bitmap tri-dn -background black -foreground blue -data {
1498 #define tri-dn_width 13
1499 #define tri-dn_height 13
1500 static unsigned char tri-dn_bits[] = {
1501 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1502 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1503 0x00, 0x00};
1504} -maskdata {
1505 #define tri-dn-mask_width 13
1506 #define tri-dn-mask_height 13
1507 static unsigned char tri-dn-mask_bits[] = {
1508 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1509 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1510 0x00, 0x00};
1511}
1512
1513image create bitmap reficon-T -background black -foreground yellow -data {
1514 #define tagicon_width 13
1515 #define tagicon_height 9
1516 static unsigned char tagicon_bits[] = {
1517 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1518 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1519} -maskdata {
1520 #define tagicon-mask_width 13
1521 #define tagicon-mask_height 9
1522 static unsigned char tagicon-mask_bits[] = {
1523 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1524 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1525}
1526set rectdata {
1527 #define headicon_width 13
1528 #define headicon_height 9
1529 static unsigned char headicon_bits[] = {
1530 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1531 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1532}
1533set rectmask {
1534 #define headicon-mask_width 13
1535 #define headicon-mask_height 9
1536 static unsigned char headicon-mask_bits[] = {
1537 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1538 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1539}
1540image create bitmap reficon-H -background black -foreground green \
1541 -data $rectdata -maskdata $rectmask
1542image create bitmap reficon-o -background black -foreground "#ddddff" \
1543 -data $rectdata -maskdata $rectmask
1544
1545proc init_flist {first} {
1546 global cflist cflist_top selectedline difffilestart
1547
1548 $cflist conf -state normal
1549 $cflist delete 0.0 end
1550 if {$first ne {}} {
1551 $cflist insert end $first
1552 set cflist_top 1
1553 $cflist tag add highlight 1.0 "1.0 lineend"
1554 } else {
1555 catch {unset cflist_top}
1556 }
1557 $cflist conf -state disabled
1558 set difffilestart {}
1559}
1560
1561proc highlight_tag {f} {
1562 global highlight_paths
1563
1564 foreach p $highlight_paths {
1565 if {[string match $p $f]} {
1566 return "bold"
1567 }
1568 }
1569 return {}
1570}
1571
1572proc highlight_filelist {} {
1573 global cmitmode cflist
1574
1575 $cflist conf -state normal
1576 if {$cmitmode ne "tree"} {
1577 set end [lindex [split [$cflist index end] .] 0]
1578 for {set l 2} {$l < $end} {incr l} {
1579 set line [$cflist get $l.0 "$l.0 lineend"]
1580 if {[highlight_tag $line] ne {}} {
1581 $cflist tag add bold $l.0 "$l.0 lineend"
1582 }
1583 }
1584 } else {
1585 highlight_tree 2 {}
1586 }
1587 $cflist conf -state disabled
1588}
1589
1590proc unhighlight_filelist {} {
1591 global cflist
1592
1593 $cflist conf -state normal
1594 $cflist tag remove bold 1.0 end
1595 $cflist conf -state disabled
1596}
1597
1598proc add_flist {fl} {
1599 global cflist
1600
1601 $cflist conf -state normal
1602 foreach f $fl {
1603 $cflist insert end "\n"
1604 $cflist insert end $f [highlight_tag $f]
1605 }
1606 $cflist conf -state disabled
1607}
1608
1609proc sel_flist {w x y} {
1610 global ctext difffilestart cflist cflist_top cmitmode
1611
1612 if {$cmitmode eq "tree"} return
1613 if {![info exists cflist_top]} return
1614 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1615 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1616 $cflist tag add highlight $l.0 "$l.0 lineend"
1617 set cflist_top $l
1618 if {$l == 1} {
1619 $ctext yview 1.0
1620 } else {
1621 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1622 }
1623}
1624
1625proc pop_flist_menu {w X Y x y} {
1626 global ctext cflist cmitmode flist_menu flist_menu_file
1627 global treediffs diffids
1628
1629 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1630 if {$l <= 1} return
1631 if {$cmitmode eq "tree"} {
1632 set e [linetoelt $l]
1633 if {[string index $e end] eq "/"} return
1634 } else {
1635 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1636 }
1637 set flist_menu_file $e
1638 tk_popup $flist_menu $X $Y
1639}
1640
1641proc flist_hl {only} {
1642 global flist_menu_file highlight_files
1643
1644 set x [shellquote $flist_menu_file]
1645 if {$only || $highlight_files eq {}} {
1646 set highlight_files $x
1647 } else {
1648 append highlight_files " " $x
1649 }
1650}
1651
1652# Functions for adding and removing shell-type quoting
1653
1654proc shellquote {str} {
1655 if {![string match "*\['\"\\ \t]*" $str]} {
1656 return $str
1657 }
1658 if {![string match "*\['\"\\]*" $str]} {
1659 return "\"$str\""
1660 }
1661 if {![string match "*'*" $str]} {
1662 return "'$str'"
1663 }
1664 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1665}
1666
1667proc shellarglist {l} {
1668 set str {}
1669 foreach a $l {
1670 if {$str ne {}} {
1671 append str " "
1672 }
1673 append str [shellquote $a]
1674 }
1675 return $str
1676}
1677
1678proc shelldequote {str} {
1679 set ret {}
1680 set used -1
1681 while {1} {
1682 incr used
1683 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1684 append ret [string range $str $used end]
1685 set used [string length $str]
1686 break
1687 }
1688 set first [lindex $first 0]
1689 set ch [string index $str $first]
1690 if {$first > $used} {
1691 append ret [string range $str $used [expr {$first - 1}]]
1692 set used $first
1693 }
1694 if {$ch eq " " || $ch eq "\t"} break
1695 incr used
1696 if {$ch eq "'"} {
1697 set first [string first "'" $str $used]
1698 if {$first < 0} {
1699 error "unmatched single-quote"
1700 }
1701 append ret [string range $str $used [expr {$first - 1}]]
1702 set used $first
1703 continue
1704 }
1705 if {$ch eq "\\"} {
1706 if {$used >= [string length $str]} {
1707 error "trailing backslash"
1708 }
1709 append ret [string index $str $used]
1710 continue
1711 }
1712 # here ch == "\""
1713 while {1} {
1714 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1715 error "unmatched double-quote"
1716 }
1717 set first [lindex $first 0]
1718 set ch [string index $str $first]
1719 if {$first > $used} {
1720 append ret [string range $str $used [expr {$first - 1}]]
1721 set used $first
1722 }
1723 if {$ch eq "\""} break
1724 incr used
1725 append ret [string index $str $used]
1726 incr used
1727 }
1728 }
1729 return [list $used $ret]
1730}
1731
1732proc shellsplit {str} {
1733 set l {}
1734 while {1} {
1735 set str [string trimleft $str]
1736 if {$str eq {}} break
1737 set dq [shelldequote $str]
1738 set n [lindex $dq 0]
1739 set word [lindex $dq 1]
1740 set str [string range $str $n end]
1741 lappend l $word
1742 }
1743 return $l
1744}
1745
1746# Code to implement multiple views
1747
1748proc newview {ishighlight} {
1749 global nextviewnum newviewname newviewperm uifont newishighlight
1750 global newviewargs revtreeargs
1751
1752 set newishighlight $ishighlight
1753 set top .gitkview
1754 if {[winfo exists $top]} {
1755 raise $top
1756 return
1757 }
1758 set newviewname($nextviewnum) "View $nextviewnum"
1759 set newviewperm($nextviewnum) 0
1760 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1761 vieweditor $top $nextviewnum "Gitk view definition"
1762}
1763
1764proc editview {} {
1765 global curview
1766 global viewname viewperm newviewname newviewperm
1767 global viewargs newviewargs
1768
1769 set top .gitkvedit-$curview
1770 if {[winfo exists $top]} {
1771 raise $top
1772 return
1773 }
1774 set newviewname($curview) $viewname($curview)
1775 set newviewperm($curview) $viewperm($curview)
1776 set newviewargs($curview) [shellarglist $viewargs($curview)]
1777 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1778}
1779
1780proc vieweditor {top n title} {
1781 global newviewname newviewperm viewfiles
1782 global uifont
1783
1784 toplevel $top
1785 wm title $top $title
1786 label $top.nl -text "Name" -font $uifont
1787 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1788 grid $top.nl $top.name -sticky w -pady 5
1789 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1790 -font $uifont
1791 grid $top.perm - -pady 5 -sticky w
1792 message $top.al -aspect 1000 -font $uifont \
1793 -text "Commits to include (arguments to git rev-list):"
1794 grid $top.al - -sticky w -pady 5
1795 entry $top.args -width 50 -textvariable newviewargs($n) \
1796 -background white -font $uifont
1797 grid $top.args - -sticky ew -padx 5
1798 message $top.l -aspect 1000 -font $uifont \
1799 -text "Enter files and directories to include, one per line:"
1800 grid $top.l - -sticky w
1801 text $top.t -width 40 -height 10 -background white -font $uifont
1802 if {[info exists viewfiles($n)]} {
1803 foreach f $viewfiles($n) {
1804 $top.t insert end $f
1805 $top.t insert end "\n"
1806 }
1807 $top.t delete {end - 1c} end
1808 $top.t mark set insert 0.0
1809 }
1810 grid $top.t - -sticky ew -padx 5
1811 frame $top.buts
1812 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1813 -font $uifont
1814 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1815 -font $uifont
1816 grid $top.buts.ok $top.buts.can
1817 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1818 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1819 grid $top.buts - -pady 10 -sticky ew
1820 focus $top.t
1821}
1822
1823proc doviewmenu {m first cmd op argv} {
1824 set nmenu [$m index end]
1825 for {set i $first} {$i <= $nmenu} {incr i} {
1826 if {[$m entrycget $i -command] eq $cmd} {
1827 eval $m $op $i $argv
1828 break
1829 }
1830 }
1831}
1832
1833proc allviewmenus {n op args} {
1834 # global viewhlmenu
1835
1836 doviewmenu .bar.view 5 [list showview $n] $op $args
1837 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1838}
1839
1840proc newviewok {top n} {
1841 global nextviewnum newviewperm newviewname newishighlight
1842 global viewname viewfiles viewperm selectedview curview
1843 global viewargs newviewargs viewhlmenu
1844
1845 if {[catch {
1846 set newargs [shellsplit $newviewargs($n)]
1847 } err]} {
1848 error_popup "Error in commit selection arguments: $err"
1849 wm raise $top
1850 focus $top
1851 return
1852 }
1853 set files {}
1854 foreach f [split [$top.t get 0.0 end] "\n"] {
1855 set ft [string trim $f]
1856 if {$ft ne {}} {
1857 lappend files $ft
1858 }
1859 }
1860 if {![info exists viewfiles($n)]} {
1861 # creating a new view
1862 incr nextviewnum
1863 set viewname($n) $newviewname($n)
1864 set viewperm($n) $newviewperm($n)
1865 set viewfiles($n) $files
1866 set viewargs($n) $newargs
1867 addviewmenu $n
1868 if {!$newishighlight} {
1869 run showview $n
1870 } else {
1871 run addvhighlight $n
1872 }
1873 } else {
1874 # editing an existing view
1875 set viewperm($n) $newviewperm($n)
1876 if {$newviewname($n) ne $viewname($n)} {
1877 set viewname($n) $newviewname($n)
1878 doviewmenu .bar.view 5 [list showview $n] \
1879 entryconf [list -label $viewname($n)]
1880 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1881 # entryconf [list -label $viewname($n) -value $viewname($n)]
1882 }
1883 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1884 set viewfiles($n) $files
1885 set viewargs($n) $newargs
1886 if {$curview == $n} {
1887 run updatecommits
1888 }
1889 }
1890 }
1891 catch {destroy $top}
1892}
1893
1894proc delview {} {
1895 global curview viewdata viewperm hlview selectedhlview
1896
1897 if {$curview == 0} return
1898 if {[info exists hlview] && $hlview == $curview} {
1899 set selectedhlview None
1900 unset hlview
1901 }
1902 allviewmenus $curview delete
1903 set viewdata($curview) {}
1904 set viewperm($curview) 0
1905 showview 0
1906}
1907
1908proc addviewmenu {n} {
1909 global viewname viewhlmenu
1910
1911 .bar.view add radiobutton -label $viewname($n) \
1912 -command [list showview $n] -variable selectedview -value $n
1913 #$viewhlmenu add radiobutton -label $viewname($n) \
1914 # -command [list addvhighlight $n] -variable selectedhlview
1915}
1916
1917proc flatten {var} {
1918 global $var
1919
1920 set ret {}
1921 foreach i [array names $var] {
1922 lappend ret $i [set $var\($i\)]
1923 }
1924 return $ret
1925}
1926
1927proc unflatten {var l} {
1928 global $var
1929
1930 catch {unset $var}
1931 foreach {i v} $l {
1932 set $var\($i\) $v
1933 }
1934}
1935
1936proc showview {n} {
1937 global curview viewdata viewfiles
1938 global displayorder parentlist rowidlist rowisopt rowfinal
1939 global colormap rowtextx commitrow nextcolor canvxmax
1940 global numcommits commitlisted
1941 global selectedline currentid canv canvy0
1942 global treediffs
1943 global pending_select phase
1944 global commitidx
1945 global commfd
1946 global selectedview selectfirst
1947 global vparentlist vdisporder vcmitlisted
1948 global hlview selectedhlview commitinterest
1949
1950 if {$n == $curview} return
1951 set selid {}
1952 if {[info exists selectedline]} {
1953 set selid $currentid
1954 set y [yc $selectedline]
1955 set ymax [lindex [$canv cget -scrollregion] 3]
1956 set span [$canv yview]
1957 set ytop [expr {[lindex $span 0] * $ymax}]
1958 set ybot [expr {[lindex $span 1] * $ymax}]
1959 if {$ytop < $y && $y < $ybot} {
1960 set yscreen [expr {$y - $ytop}]
1961 } else {
1962 set yscreen [expr {($ybot - $ytop) / 2}]
1963 }
1964 } elseif {[info exists pending_select]} {
1965 set selid $pending_select
1966 unset pending_select
1967 }
1968 unselectline
1969 normalline
1970 if {$curview >= 0} {
1971 set vparentlist($curview) $parentlist
1972 set vdisporder($curview) $displayorder
1973 set vcmitlisted($curview) $commitlisted
1974 if {$phase ne {} ||
1975 ![info exists viewdata($curview)] ||
1976 [lindex $viewdata($curview) 0] ne {}} {
1977 set viewdata($curview) \
1978 [list $phase $rowidlist $rowisopt $rowfinal]
1979 }
1980 }
1981 catch {unset treediffs}
1982 clear_display
1983 if {[info exists hlview] && $hlview == $n} {
1984 unset hlview
1985 set selectedhlview None
1986 }
1987 catch {unset commitinterest}
1988
1989 set curview $n
1990 set selectedview $n
1991 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1992 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1993
1994 run refill_reflist
1995 if {![info exists viewdata($n)]} {
1996 if {$selid ne {}} {
1997 set pending_select $selid
1998 }
1999 getcommits
2000 return
2001 }
2002
2003 set v $viewdata($n)
2004 set phase [lindex $v 0]
2005 set displayorder $vdisporder($n)
2006 set parentlist $vparentlist($n)
2007 set commitlisted $vcmitlisted($n)
2008 set rowidlist [lindex $v 1]
2009 set rowisopt [lindex $v 2]
2010 set rowfinal [lindex $v 3]
2011 set numcommits $commitidx($n)
2012
2013 catch {unset colormap}
2014 catch {unset rowtextx}
2015 set nextcolor 0
2016 set canvxmax [$canv cget -width]
2017 set curview $n
2018 set row 0
2019 setcanvscroll
2020 set yf 0
2021 set row {}
2022 set selectfirst 0
2023 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2024 set row $commitrow($n,$selid)
2025 # try to get the selected row in the same position on the screen
2026 set ymax [lindex [$canv cget -scrollregion] 3]
2027 set ytop [expr {[yc $row] - $yscreen}]
2028 if {$ytop < 0} {
2029 set ytop 0
2030 }
2031 set yf [expr {$ytop * 1.0 / $ymax}]
2032 }
2033 allcanvs yview moveto $yf
2034 drawvisible
2035 if {$row ne {}} {
2036 selectline $row 0
2037 } elseif {$selid ne {}} {
2038 set pending_select $selid
2039 } else {
2040 set row [first_real_row]
2041 if {$row < $numcommits} {
2042 selectline $row 0
2043 } else {
2044 set selectfirst 1
2045 }
2046 }
2047 if {$phase ne {}} {
2048 if {$phase eq "getcommits"} {
2049 show_status "Reading commits..."
2050 }
2051 run chewcommits $n
2052 } elseif {$numcommits == 0} {
2053 show_status "No commits selected"
2054 }
2055}
2056
2057# Stuff relating to the highlighting facility
2058
2059proc ishighlighted {row} {
2060 global vhighlights fhighlights nhighlights rhighlights
2061
2062 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2063 return $nhighlights($row)
2064 }
2065 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2066 return $vhighlights($row)
2067 }
2068 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2069 return $fhighlights($row)
2070 }
2071 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2072 return $rhighlights($row)
2073 }
2074 return 0
2075}
2076
2077proc bolden {row font} {
2078 global canv linehtag selectedline boldrows
2079
2080 lappend boldrows $row
2081 $canv itemconf $linehtag($row) -font $font
2082 if {[info exists selectedline] && $row == $selectedline} {
2083 $canv delete secsel
2084 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2085 -outline {{}} -tags secsel \
2086 -fill [$canv cget -selectbackground]]
2087 $canv lower $t
2088 }
2089}
2090
2091proc bolden_name {row font} {
2092 global canv2 linentag selectedline boldnamerows
2093
2094 lappend boldnamerows $row
2095 $canv2 itemconf $linentag($row) -font $font
2096 if {[info exists selectedline] && $row == $selectedline} {
2097 $canv2 delete secsel
2098 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2099 -outline {{}} -tags secsel \
2100 -fill [$canv2 cget -selectbackground]]
2101 $canv2 lower $t
2102 }
2103}
2104
2105proc unbolden {} {
2106 global mainfont boldrows
2107
2108 set stillbold {}
2109 foreach row $boldrows {
2110 if {![ishighlighted $row]} {
2111 bolden $row $mainfont
2112 } else {
2113 lappend stillbold $row
2114 }
2115 }
2116 set boldrows $stillbold
2117}
2118
2119proc addvhighlight {n} {
2120 global hlview curview viewdata vhl_done vhighlights commitidx
2121
2122 if {[info exists hlview]} {
2123 delvhighlight
2124 }
2125 set hlview $n
2126 if {$n != $curview && ![info exists viewdata($n)]} {
2127 set viewdata($n) [list getcommits {{}} 0 0 0]
2128 set vparentlist($n) {}
2129 set vdisporder($n) {}
2130 set vcmitlisted($n) {}
2131 start_rev_list $n
2132 }
2133 set vhl_done $commitidx($hlview)
2134 if {$vhl_done > 0} {
2135 drawvisible
2136 }
2137}
2138
2139proc delvhighlight {} {
2140 global hlview vhighlights
2141
2142 if {![info exists hlview]} return
2143 unset hlview
2144 catch {unset vhighlights}
2145 unbolden
2146}
2147
2148proc vhighlightmore {} {
2149 global hlview vhl_done commitidx vhighlights
2150 global displayorder vdisporder curview mainfont
2151
2152 set font [concat $mainfont bold]
2153 set max $commitidx($hlview)
2154 if {$hlview == $curview} {
2155 set disp $displayorder
2156 } else {
2157 set disp $vdisporder($hlview)
2158 }
2159 set vr [visiblerows]
2160 set r0 [lindex $vr 0]
2161 set r1 [lindex $vr 1]
2162 for {set i $vhl_done} {$i < $max} {incr i} {
2163 set id [lindex $disp $i]
2164 if {[info exists commitrow($curview,$id)]} {
2165 set row $commitrow($curview,$id)
2166 if {$r0 <= $row && $row <= $r1} {
2167 if {![highlighted $row]} {
2168 bolden $row $font
2169 }
2170 set vhighlights($row) 1
2171 }
2172 }
2173 }
2174 set vhl_done $max
2175}
2176
2177proc askvhighlight {row id} {
2178 global hlview vhighlights commitrow iddrawn mainfont
2179
2180 if {[info exists commitrow($hlview,$id)]} {
2181 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2182 bolden $row [concat $mainfont bold]
2183 }
2184 set vhighlights($row) 1
2185 } else {
2186 set vhighlights($row) 0
2187 }
2188}
2189
2190proc hfiles_change {} {
2191 global highlight_files filehighlight fhighlights fh_serial
2192 global mainfont highlight_paths gdttype
2193
2194 if {[info exists filehighlight]} {
2195 # delete previous highlights
2196 catch {close $filehighlight}
2197 unset filehighlight
2198 catch {unset fhighlights}
2199 unbolden
2200 unhighlight_filelist
2201 }
2202 set highlight_paths {}
2203 after cancel do_file_hl $fh_serial
2204 incr fh_serial
2205 if {$highlight_files ne {}} {
2206 after 300 do_file_hl $fh_serial
2207 }
2208}
2209
2210proc gdttype_change {name ix op} {
2211 global gdttype highlight_files findstring findpattern
2212
2213 if {$findstring ne {}} {
2214 if {$gdttype eq "containing:"} {
2215 if {$highlight_files ne {}} {
2216 set highlight_files {}
2217 hfiles_change
2218 }
2219 findcom_change
2220 } else {
2221 if {$findpattern ne {}} {
2222 set findpattern {}
2223 findcom_change
2224 }
2225 set highlight_files $findstring
2226 hfiles_change
2227 }
2228 drawvisible
2229 }
2230 # enable/disable findtype/findloc menus too
2231}
2232
2233proc find_change {name ix op} {
2234 global gdttype findstring highlight_files
2235
2236 if {$gdttype eq "containing:"} {
2237 findcom_change
2238 } else {
2239 if {$highlight_files ne $findstring} {
2240 set highlight_files $findstring
2241 hfiles_change
2242 }
2243 }
2244 drawvisible
2245}
2246
2247proc findcom_change {} {
2248 global nhighlights mainfont boldnamerows
2249 global findpattern findtype findstring gdttype
2250
2251 # delete previous highlights, if any
2252 foreach row $boldnamerows {
2253 bolden_name $row $mainfont
2254 }
2255 set boldnamerows {}
2256 catch {unset nhighlights}
2257 unbolden
2258 unmarkmatches
2259 if {$gdttype ne "containing:" || $findstring eq {}} {
2260 set findpattern {}
2261 } elseif {$findtype eq "Regexp"} {
2262 set findpattern $findstring
2263 } else {
2264 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2265 $findstring]
2266 set findpattern "*$e*"
2267 }
2268}
2269
2270proc makepatterns {l} {
2271 set ret {}
2272 foreach e $l {
2273 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2274 if {[string index $ee end] eq "/"} {
2275 lappend ret "$ee*"
2276 } else {
2277 lappend ret $ee
2278 lappend ret "$ee/*"
2279 }
2280 }
2281 return $ret
2282}
2283
2284proc do_file_hl {serial} {
2285 global highlight_files filehighlight highlight_paths gdttype fhl_list
2286
2287 if {$gdttype eq "touching paths:"} {
2288 if {[catch {set paths [shellsplit $highlight_files]}]} return
2289 set highlight_paths [makepatterns $paths]
2290 highlight_filelist
2291 set gdtargs [concat -- $paths]
2292 } elseif {$gdttype eq "adding/removing string:"} {
2293 set gdtargs [list "-S$highlight_files"]
2294 } else {
2295 # must be "containing:", i.e. we're searching commit info
2296 return
2297 }
2298 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2299 set filehighlight [open $cmd r+]
2300 fconfigure $filehighlight -blocking 0
2301 filerun $filehighlight readfhighlight
2302 set fhl_list {}
2303 drawvisible
2304 flushhighlights
2305}
2306
2307proc flushhighlights {} {
2308 global filehighlight fhl_list
2309
2310 if {[info exists filehighlight]} {
2311 lappend fhl_list {}
2312 puts $filehighlight ""
2313 flush $filehighlight
2314 }
2315}
2316
2317proc askfilehighlight {row id} {
2318 global filehighlight fhighlights fhl_list
2319
2320 lappend fhl_list $id
2321 set fhighlights($row) -1
2322 puts $filehighlight $id
2323}
2324
2325proc readfhighlight {} {
2326 global filehighlight fhighlights commitrow curview mainfont iddrawn
2327 global fhl_list find_dirn
2328
2329 if {![info exists filehighlight]} {
2330 return 0
2331 }
2332 set nr 0
2333 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2334 set line [string trim $line]
2335 set i [lsearch -exact $fhl_list $line]
2336 if {$i < 0} continue
2337 for {set j 0} {$j < $i} {incr j} {
2338 set id [lindex $fhl_list $j]
2339 if {[info exists commitrow($curview,$id)]} {
2340 set fhighlights($commitrow($curview,$id)) 0
2341 }
2342 }
2343 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2344 if {$line eq {}} continue
2345 if {![info exists commitrow($curview,$line)]} continue
2346 set row $commitrow($curview,$line)
2347 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2348 bolden $row [concat $mainfont bold]
2349 }
2350 set fhighlights($row) 1
2351 }
2352 if {[eof $filehighlight]} {
2353 # strange...
2354 puts "oops, git diff-tree died"
2355 catch {close $filehighlight}
2356 unset filehighlight
2357 return 0
2358 }
2359 if {[info exists find_dirn]} {
2360 if {$find_dirn > 0} {
2361 run findmore
2362 } else {
2363 run findmorerev
2364 }
2365 }
2366 return 1
2367}
2368
2369proc doesmatch {f} {
2370 global findtype findpattern
2371
2372 if {$findtype eq "Regexp"} {
2373 return [regexp $findpattern $f]
2374 } elseif {$findtype eq "IgnCase"} {
2375 return [string match -nocase $findpattern $f]
2376 } else {
2377 return [string match $findpattern $f]
2378 }
2379}
2380
2381proc askfindhighlight {row id} {
2382 global nhighlights commitinfo iddrawn mainfont
2383 global findloc
2384 global markingmatches
2385
2386 if {![info exists commitinfo($id)]} {
2387 getcommit $id
2388 }
2389 set info $commitinfo($id)
2390 set isbold 0
2391 set fldtypes {Headline Author Date Committer CDate Comments}
2392 foreach f $info ty $fldtypes {
2393 if {($findloc eq "All fields" || $findloc eq $ty) &&
2394 [doesmatch $f]} {
2395 if {$ty eq "Author"} {
2396 set isbold 2
2397 break
2398 }
2399 set isbold 1
2400 }
2401 }
2402 if {$isbold && [info exists iddrawn($id)]} {
2403 set f [concat $mainfont bold]
2404 if {![ishighlighted $row]} {
2405 bolden $row $f
2406 if {$isbold > 1} {
2407 bolden_name $row $f
2408 }
2409 }
2410 if {$markingmatches} {
2411 markrowmatches $row $id
2412 }
2413 }
2414 set nhighlights($row) $isbold
2415}
2416
2417proc markrowmatches {row id} {
2418 global canv canv2 linehtag linentag commitinfo findloc
2419
2420 set headline [lindex $commitinfo($id) 0]
2421 set author [lindex $commitinfo($id) 1]
2422 $canv delete match$row
2423 $canv2 delete match$row
2424 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2425 set m [findmatches $headline]
2426 if {$m ne {}} {
2427 markmatches $canv $row $headline $linehtag($row) $m \
2428 [$canv itemcget $linehtag($row) -font] $row
2429 }
2430 }
2431 if {$findloc eq "All fields" || $findloc eq "Author"} {
2432 set m [findmatches $author]
2433 if {$m ne {}} {
2434 markmatches $canv2 $row $author $linentag($row) $m \
2435 [$canv2 itemcget $linentag($row) -font] $row
2436 }
2437 }
2438}
2439
2440proc vrel_change {name ix op} {
2441 global highlight_related
2442
2443 rhighlight_none
2444 if {$highlight_related ne "None"} {
2445 run drawvisible
2446 }
2447}
2448
2449# prepare for testing whether commits are descendents or ancestors of a
2450proc rhighlight_sel {a} {
2451 global descendent desc_todo ancestor anc_todo
2452 global highlight_related rhighlights
2453
2454 catch {unset descendent}
2455 set desc_todo [list $a]
2456 catch {unset ancestor}
2457 set anc_todo [list $a]
2458 if {$highlight_related ne "None"} {
2459 rhighlight_none
2460 run drawvisible
2461 }
2462}
2463
2464proc rhighlight_none {} {
2465 global rhighlights
2466
2467 catch {unset rhighlights}
2468 unbolden
2469}
2470
2471proc is_descendent {a} {
2472 global curview children commitrow descendent desc_todo
2473
2474 set v $curview
2475 set la $commitrow($v,$a)
2476 set todo $desc_todo
2477 set leftover {}
2478 set done 0
2479 for {set i 0} {$i < [llength $todo]} {incr i} {
2480 set do [lindex $todo $i]
2481 if {$commitrow($v,$do) < $la} {
2482 lappend leftover $do
2483 continue
2484 }
2485 foreach nk $children($v,$do) {
2486 if {![info exists descendent($nk)]} {
2487 set descendent($nk) 1
2488 lappend todo $nk
2489 if {$nk eq $a} {
2490 set done 1
2491 }
2492 }
2493 }
2494 if {$done} {
2495 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2496 return
2497 }
2498 }
2499 set descendent($a) 0
2500 set desc_todo $leftover
2501}
2502
2503proc is_ancestor {a} {
2504 global curview parentlist commitrow ancestor anc_todo
2505
2506 set v $curview
2507 set la $commitrow($v,$a)
2508 set todo $anc_todo
2509 set leftover {}
2510 set done 0
2511 for {set i 0} {$i < [llength $todo]} {incr i} {
2512 set do [lindex $todo $i]
2513 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2514 lappend leftover $do
2515 continue
2516 }
2517 foreach np [lindex $parentlist $commitrow($v,$do)] {
2518 if {![info exists ancestor($np)]} {
2519 set ancestor($np) 1
2520 lappend todo $np
2521 if {$np eq $a} {
2522 set done 1
2523 }
2524 }
2525 }
2526 if {$done} {
2527 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2528 return
2529 }
2530 }
2531 set ancestor($a) 0
2532 set anc_todo $leftover
2533}
2534
2535proc askrelhighlight {row id} {
2536 global descendent highlight_related iddrawn mainfont rhighlights
2537 global selectedline ancestor
2538
2539 if {![info exists selectedline]} return
2540 set isbold 0
2541 if {$highlight_related eq "Descendent" ||
2542 $highlight_related eq "Not descendent"} {
2543 if {![info exists descendent($id)]} {
2544 is_descendent $id
2545 }
2546 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2547 set isbold 1
2548 }
2549 } elseif {$highlight_related eq "Ancestor" ||
2550 $highlight_related eq "Not ancestor"} {
2551 if {![info exists ancestor($id)]} {
2552 is_ancestor $id
2553 }
2554 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2555 set isbold 1
2556 }
2557 }
2558 if {[info exists iddrawn($id)]} {
2559 if {$isbold && ![ishighlighted $row]} {
2560 bolden $row [concat $mainfont bold]
2561 }
2562 }
2563 set rhighlights($row) $isbold
2564}
2565
2566# Graph layout functions
2567
2568proc shortids {ids} {
2569 set res {}
2570 foreach id $ids {
2571 if {[llength $id] > 1} {
2572 lappend res [shortids $id]
2573 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2574 lappend res [string range $id 0 7]
2575 } else {
2576 lappend res $id
2577 }
2578 }
2579 return $res
2580}
2581
2582proc ntimes {n o} {
2583 set ret {}
2584 set o [list $o]
2585 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2586 if {($n & $mask) != 0} {
2587 set ret [concat $ret $o]
2588 }
2589 set o [concat $o $o]
2590 }
2591 return $ret
2592}
2593
2594# Work out where id should go in idlist so that order-token
2595# values increase from left to right
2596proc idcol {idlist id {i 0}} {
2597 global ordertok curview
2598
2599 set t $ordertok($curview,$id)
2600 if {$i >= [llength $idlist] ||
2601 $t < $ordertok($curview,[lindex $idlist $i])} {
2602 if {$i > [llength $idlist]} {
2603 set i [llength $idlist]
2604 }
2605 while {[incr i -1] >= 0 &&
2606 $t < $ordertok($curview,[lindex $idlist $i])} {}
2607 incr i
2608 } else {
2609 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2610 while {[incr i] < [llength $idlist] &&
2611 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2612 }
2613 }
2614 return $i
2615}
2616
2617proc initlayout {} {
2618 global rowidlist rowisopt rowfinal displayorder commitlisted
2619 global numcommits canvxmax canv
2620 global nextcolor
2621 global parentlist
2622 global colormap rowtextx
2623 global selectfirst
2624
2625 set numcommits 0
2626 set displayorder {}
2627 set commitlisted {}
2628 set parentlist {}
2629 set nextcolor 0
2630 set rowidlist {}
2631 set rowisopt {}
2632 set rowfinal {}
2633 set canvxmax [$canv cget -width]
2634 catch {unset colormap}
2635 catch {unset rowtextx}
2636 set selectfirst 1
2637}
2638
2639proc setcanvscroll {} {
2640 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2641
2642 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2643 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2644 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2645 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2646}
2647
2648proc visiblerows {} {
2649 global canv numcommits linespc
2650
2651 set ymax [lindex [$canv cget -scrollregion] 3]
2652 if {$ymax eq {} || $ymax == 0} return
2653 set f [$canv yview]
2654 set y0 [expr {int([lindex $f 0] * $ymax)}]
2655 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2656 if {$r0 < 0} {
2657 set r0 0
2658 }
2659 set y1 [expr {int([lindex $f 1] * $ymax)}]
2660 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2661 if {$r1 >= $numcommits} {
2662 set r1 [expr {$numcommits - 1}]
2663 }
2664 return [list $r0 $r1]
2665}
2666
2667proc layoutmore {} {
2668 global commitidx viewcomplete numcommits
2669 global uparrowlen downarrowlen mingaplen curview
2670
2671 set show $commitidx($curview)
2672 if {$show > $numcommits} {
2673 showstuff $show $viewcomplete($curview)
2674 }
2675}
2676
2677proc showstuff {canshow last} {
2678 global numcommits commitrow pending_select selectedline curview
2679 global mainheadid displayorder selectfirst
2680 global lastscrollset commitinterest
2681
2682 if {$numcommits == 0} {
2683 global phase
2684 set phase "incrdraw"
2685 allcanvs delete all
2686 }
2687 set r0 $numcommits
2688 set prev $numcommits
2689 set numcommits $canshow
2690 set t [clock clicks -milliseconds]
2691 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2692 set lastscrollset $t
2693 setcanvscroll
2694 }
2695 set rows [visiblerows]
2696 set r1 [lindex $rows 1]
2697 if {$r1 >= $canshow} {
2698 set r1 [expr {$canshow - 1}]
2699 }
2700 if {$r0 <= $r1} {
2701 drawcommits $r0 $r1
2702 }
2703 if {[info exists pending_select] &&
2704 [info exists commitrow($curview,$pending_select)] &&
2705 $commitrow($curview,$pending_select) < $numcommits} {
2706 selectline $commitrow($curview,$pending_select) 1
2707 }
2708 if {$selectfirst} {
2709 if {[info exists selectedline] || [info exists pending_select]} {
2710 set selectfirst 0
2711 } else {
2712 set l [first_real_row]
2713 selectline $l 1
2714 set selectfirst 0
2715 }
2716 }
2717}
2718
2719proc doshowlocalchanges {} {
2720 global curview mainheadid phase commitrow
2721
2722 if {[info exists commitrow($curview,$mainheadid)] &&
2723 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2724 dodiffindex
2725 } elseif {$phase ne {}} {
2726 lappend commitinterest($mainheadid) {}
2727 }
2728}
2729
2730proc dohidelocalchanges {} {
2731 global localfrow localirow lserial
2732
2733 if {$localfrow >= 0} {
2734 removerow $localfrow
2735 set localfrow -1
2736 if {$localirow > 0} {
2737 incr localirow -1
2738 }
2739 }
2740 if {$localirow >= 0} {
2741 removerow $localirow
2742 set localirow -1
2743 }
2744 incr lserial
2745}
2746
2747# spawn off a process to do git diff-index --cached HEAD
2748proc dodiffindex {} {
2749 global localirow localfrow lserial showlocalchanges
2750
2751 if {!$showlocalchanges} return
2752 incr lserial
2753 set localfrow -1
2754 set localirow -1
2755 set fd [open "|git diff-index --cached HEAD" r]
2756 fconfigure $fd -blocking 0
2757 filerun $fd [list readdiffindex $fd $lserial]
2758}
2759
2760proc readdiffindex {fd serial} {
2761 global localirow commitrow mainheadid nullid2 curview
2762 global commitinfo commitdata lserial
2763
2764 set isdiff 1
2765 if {[gets $fd line] < 0} {
2766 if {![eof $fd]} {
2767 return 1
2768 }
2769 set isdiff 0
2770 }
2771 # we only need to see one line and we don't really care what it says...
2772 close $fd
2773
2774 # now see if there are any local changes not checked in to the index
2775 if {$serial == $lserial} {
2776 set fd [open "|git diff-files" r]
2777 fconfigure $fd -blocking 0
2778 filerun $fd [list readdifffiles $fd $serial]
2779 }
2780
2781 if {$isdiff && $serial == $lserial && $localirow == -1} {
2782 # add the line for the changes in the index to the graph
2783 set localirow $commitrow($curview,$mainheadid)
2784 set hl "Local changes checked in to index but not committed"
2785 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2786 set commitdata($nullid2) "\n $hl\n"
2787 insertrow $localirow $nullid2
2788 }
2789 return 0
2790}
2791
2792proc readdifffiles {fd serial} {
2793 global localirow localfrow commitrow mainheadid nullid curview
2794 global commitinfo commitdata lserial
2795
2796 set isdiff 1
2797 if {[gets $fd line] < 0} {
2798 if {![eof $fd]} {
2799 return 1
2800 }
2801 set isdiff 0
2802 }
2803 # we only need to see one line and we don't really care what it says...
2804 close $fd
2805
2806 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2807 # add the line for the local diff to the graph
2808 if {$localirow >= 0} {
2809 set localfrow $localirow
2810 incr localirow
2811 } else {
2812 set localfrow $commitrow($curview,$mainheadid)
2813 }
2814 set hl "Local uncommitted changes, not checked in to index"
2815 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2816 set commitdata($nullid) "\n $hl\n"
2817 insertrow $localfrow $nullid
2818 }
2819 return 0
2820}
2821
2822proc nextuse {id row} {
2823 global commitrow curview children
2824
2825 if {[info exists children($curview,$id)]} {
2826 foreach kid $children($curview,$id) {
2827 if {![info exists commitrow($curview,$kid)]} {
2828 return -1
2829 }
2830 if {$commitrow($curview,$kid) > $row} {
2831 return $commitrow($curview,$kid)
2832 }
2833 }
2834 }
2835 if {[info exists commitrow($curview,$id)]} {
2836 return $commitrow($curview,$id)
2837 }
2838 return -1
2839}
2840
2841proc prevuse {id row} {
2842 global commitrow curview children
2843
2844 set ret -1
2845 if {[info exists children($curview,$id)]} {
2846 foreach kid $children($curview,$id) {
2847 if {![info exists commitrow($curview,$kid)]} break
2848 if {$commitrow($curview,$kid) < $row} {
2849 set ret $commitrow($curview,$kid)
2850 }
2851 }
2852 }
2853 return $ret
2854}
2855
2856proc make_idlist {row} {
2857 global displayorder parentlist uparrowlen downarrowlen mingaplen
2858 global commitidx curview ordertok children commitrow
2859
2860 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2861 if {$r < 0} {
2862 set r 0
2863 }
2864 set ra [expr {$row - $downarrowlen}]
2865 if {$ra < 0} {
2866 set ra 0
2867 }
2868 set rb [expr {$row + $uparrowlen}]
2869 if {$rb > $commitidx($curview)} {
2870 set rb $commitidx($curview)
2871 }
2872 set ids {}
2873 for {} {$r < $ra} {incr r} {
2874 set nextid [lindex $displayorder [expr {$r + 1}]]
2875 foreach p [lindex $parentlist $r] {
2876 if {$p eq $nextid} continue
2877 set rn [nextuse $p $r]
2878 if {$rn >= $row &&
2879 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2880 lappend ids [list $ordertok($curview,$p) $p]
2881 }
2882 }
2883 }
2884 for {} {$r < $row} {incr r} {
2885 set nextid [lindex $displayorder [expr {$r + 1}]]
2886 foreach p [lindex $parentlist $r] {
2887 if {$p eq $nextid} continue
2888 set rn [nextuse $p $r]
2889 if {$rn < 0 || $rn >= $row} {
2890 lappend ids [list $ordertok($curview,$p) $p]
2891 }
2892 }
2893 }
2894 set id [lindex $displayorder $row]
2895 lappend ids [list $ordertok($curview,$id) $id]
2896 while {$r < $rb} {
2897 foreach p [lindex $parentlist $r] {
2898 set firstkid [lindex $children($curview,$p) 0]
2899 if {$commitrow($curview,$firstkid) < $row} {
2900 lappend ids [list $ordertok($curview,$p) $p]
2901 }
2902 }
2903 incr r
2904 set id [lindex $displayorder $r]
2905 if {$id ne {}} {
2906 set firstkid [lindex $children($curview,$id) 0]
2907 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
2908 lappend ids [list $ordertok($curview,$id) $id]
2909 }
2910 }
2911 }
2912 set idlist {}
2913 foreach idx [lsort -unique $ids] {
2914 lappend idlist [lindex $idx 1]
2915 }
2916 return $idlist
2917}
2918
2919proc rowsequal {a b} {
2920 while {[set i [lsearch -exact $a {}]] >= 0} {
2921 set a [lreplace $a $i $i]
2922 }
2923 while {[set i [lsearch -exact $b {}]] >= 0} {
2924 set b [lreplace $b $i $i]
2925 }
2926 return [expr {$a eq $b}]
2927}
2928
2929proc makeupline {id row rend col} {
2930 global rowidlist uparrowlen downarrowlen mingaplen
2931
2932 for {set r $rend} {1} {set r $rstart} {
2933 set rstart [prevuse $id $r]
2934 if {$rstart < 0} return
2935 if {$rstart < $row} break
2936 }
2937 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
2938 set rstart [expr {$rend - $uparrowlen - 1}]
2939 }
2940 for {set r $rstart} {[incr r] <= $row} {} {
2941 set idlist [lindex $rowidlist $r]
2942 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
2943 set col [idcol $idlist $id $col]
2944 lset rowidlist $r [linsert $idlist $col $id]
2945 changedrow $r
2946 }
2947 }
2948}
2949
2950proc layoutrows {row endrow} {
2951 global rowidlist rowisopt rowfinal displayorder
2952 global uparrowlen downarrowlen maxwidth mingaplen
2953 global children parentlist
2954 global commitidx viewcomplete curview commitrow
2955
2956 set idlist {}
2957 if {$row > 0} {
2958 set rm1 [expr {$row - 1}]
2959 foreach id [lindex $rowidlist $rm1] {
2960 if {$id ne {}} {
2961 lappend idlist $id
2962 }
2963 }
2964 set final [lindex $rowfinal $rm1]
2965 }
2966 for {} {$row < $endrow} {incr row} {
2967 set rm1 [expr {$row - 1}]
2968 if {$rm1 < 0 || $idlist eq {}} {
2969 set idlist [make_idlist $row]
2970 set final 1
2971 } else {
2972 set id [lindex $displayorder $rm1]
2973 set col [lsearch -exact $idlist $id]
2974 set idlist [lreplace $idlist $col $col]
2975 foreach p [lindex $parentlist $rm1] {
2976 if {[lsearch -exact $idlist $p] < 0} {
2977 set col [idcol $idlist $p $col]
2978 set idlist [linsert $idlist $col $p]
2979 # if not the first child, we have to insert a line going up
2980 if {$id ne [lindex $children($curview,$p) 0]} {
2981 makeupline $p $rm1 $row $col
2982 }
2983 }
2984 }
2985 set id [lindex $displayorder $row]
2986 if {$row > $downarrowlen} {
2987 set termrow [expr {$row - $downarrowlen - 1}]
2988 foreach p [lindex $parentlist $termrow] {
2989 set i [lsearch -exact $idlist $p]
2990 if {$i < 0} continue
2991 set nr [nextuse $p $termrow]
2992 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
2993 set idlist [lreplace $idlist $i $i]
2994 }
2995 }
2996 }
2997 set col [lsearch -exact $idlist $id]
2998 if {$col < 0} {
2999 set col [idcol $idlist $id]
3000 set idlist [linsert $idlist $col $id]
3001 if {$children($curview,$id) ne {}} {
3002 makeupline $id $rm1 $row $col
3003 }
3004 }
3005 set r [expr {$row + $uparrowlen - 1}]
3006 if {$r < $commitidx($curview)} {
3007 set x $col
3008 foreach p [lindex $parentlist $r] {
3009 if {[lsearch -exact $idlist $p] >= 0} continue
3010 set fk [lindex $children($curview,$p) 0]
3011 if {$commitrow($curview,$fk) < $row} {
3012 set x [idcol $idlist $p $x]
3013 set idlist [linsert $idlist $x $p]
3014 }
3015 }
3016 if {[incr r] < $commitidx($curview)} {
3017 set p [lindex $displayorder $r]
3018 if {[lsearch -exact $idlist $p] < 0} {
3019 set fk [lindex $children($curview,$p) 0]
3020 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3021 set x [idcol $idlist $p $x]
3022 set idlist [linsert $idlist $x $p]
3023 }
3024 }
3025 }
3026 }
3027 }
3028 if {$final && !$viewcomplete($curview) &&
3029 $row + $uparrowlen + $mingaplen + $downarrowlen
3030 >= $commitidx($curview)} {
3031 set final 0
3032 }
3033 set l [llength $rowidlist]
3034 if {$row == $l} {
3035 lappend rowidlist $idlist
3036 lappend rowisopt 0
3037 lappend rowfinal $final
3038 } elseif {$row < $l} {
3039 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3040 lset rowidlist $row $idlist
3041 changedrow $row
3042 }
3043 lset rowfinal $row $final
3044 } else {
3045 set pad [ntimes [expr {$row - $l}] {}]
3046 set rowidlist [concat $rowidlist $pad]
3047 lappend rowidlist $idlist
3048 set rowfinal [concat $rowfinal $pad]
3049 lappend rowfinal $final
3050 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3051 }
3052 }
3053 return $row
3054}
3055
3056proc changedrow {row} {
3057 global displayorder iddrawn rowisopt need_redisplay
3058
3059 set l [llength $rowisopt]
3060 if {$row < $l} {
3061 lset rowisopt $row 0
3062 if {$row + 1 < $l} {
3063 lset rowisopt [expr {$row + 1}] 0
3064 if {$row + 2 < $l} {
3065 lset rowisopt [expr {$row + 2}] 0
3066 }
3067 }
3068 }
3069 set id [lindex $displayorder $row]
3070 if {[info exists iddrawn($id)]} {
3071 set need_redisplay 1
3072 }
3073}
3074
3075proc insert_pad {row col npad} {
3076 global rowidlist
3077
3078 set pad [ntimes $npad {}]
3079 set idlist [lindex $rowidlist $row]
3080 set bef [lrange $idlist 0 [expr {$col - 1}]]
3081 set aft [lrange $idlist $col end]
3082 set i [lsearch -exact $aft {}]
3083 if {$i > 0} {
3084 set aft [lreplace $aft $i $i]
3085 }
3086 lset rowidlist $row [concat $bef $pad $aft]
3087 changedrow $row
3088}
3089
3090proc optimize_rows {row col endrow} {
3091 global rowidlist rowisopt displayorder curview children
3092
3093 if {$row < 1} {
3094 set row 1
3095 }
3096 for {} {$row < $endrow} {incr row; set col 0} {
3097 if {[lindex $rowisopt $row]} continue
3098 set haspad 0
3099 set y0 [expr {$row - 1}]
3100 set ym [expr {$row - 2}]
3101 set idlist [lindex $rowidlist $row]
3102 set previdlist [lindex $rowidlist $y0]
3103 if {$idlist eq {} || $previdlist eq {}} continue
3104 if {$ym >= 0} {
3105 set pprevidlist [lindex $rowidlist $ym]
3106 if {$pprevidlist eq {}} continue
3107 } else {
3108 set pprevidlist {}
3109 }
3110 set x0 -1
3111 set xm -1
3112 for {} {$col < [llength $idlist]} {incr col} {
3113 set id [lindex $idlist $col]
3114 if {[lindex $previdlist $col] eq $id} continue
3115 if {$id eq {}} {
3116 set haspad 1
3117 continue
3118 }
3119 set x0 [lsearch -exact $previdlist $id]
3120 if {$x0 < 0} continue
3121 set z [expr {$x0 - $col}]
3122 set isarrow 0
3123 set z0 {}
3124 if {$ym >= 0} {
3125 set xm [lsearch -exact $pprevidlist $id]
3126 if {$xm >= 0} {
3127 set z0 [expr {$xm - $x0}]
3128 }
3129 }
3130 if {$z0 eq {}} {
3131 # if row y0 is the first child of $id then it's not an arrow
3132 if {[lindex $children($curview,$id) 0] ne
3133 [lindex $displayorder $y0]} {
3134 set isarrow 1
3135 }
3136 }
3137 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3138 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3139 set isarrow 1
3140 }
3141 # Looking at lines from this row to the previous row,
3142 # make them go straight up if they end in an arrow on
3143 # the previous row; otherwise make them go straight up
3144 # or at 45 degrees.
3145 if {$z < -1 || ($z < 0 && $isarrow)} {
3146 # Line currently goes left too much;
3147 # insert pads in the previous row, then optimize it
3148 set npad [expr {-1 - $z + $isarrow}]
3149 insert_pad $y0 $x0 $npad
3150 if {$y0 > 0} {
3151 optimize_rows $y0 $x0 $row
3152 }
3153 set previdlist [lindex $rowidlist $y0]
3154 set x0 [lsearch -exact $previdlist $id]
3155 set z [expr {$x0 - $col}]
3156 if {$z0 ne {}} {
3157 set pprevidlist [lindex $rowidlist $ym]
3158 set xm [lsearch -exact $pprevidlist $id]
3159 set z0 [expr {$xm - $x0}]
3160 }
3161 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3162 # Line currently goes right too much;
3163 # insert pads in this line
3164 set npad [expr {$z - 1 + $isarrow}]
3165 insert_pad $row $col $npad
3166 set idlist [lindex $rowidlist $row]
3167 incr col $npad
3168 set z [expr {$x0 - $col}]
3169 set haspad 1
3170 }
3171 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3172 # this line links to its first child on row $row-2
3173 set id [lindex $displayorder $ym]
3174 set xc [lsearch -exact $pprevidlist $id]
3175 if {$xc >= 0} {
3176 set z0 [expr {$xc - $x0}]
3177 }
3178 }
3179 # avoid lines jigging left then immediately right
3180 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3181 insert_pad $y0 $x0 1
3182 incr x0
3183 optimize_rows $y0 $x0 $row
3184 set previdlist [lindex $rowidlist $y0]
3185 }
3186 }
3187 if {!$haspad} {
3188 # Find the first column that doesn't have a line going right
3189 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3190 set id [lindex $idlist $col]
3191 if {$id eq {}} break
3192 set x0 [lsearch -exact $previdlist $id]
3193 if {$x0 < 0} {
3194 # check if this is the link to the first child
3195 set kid [lindex $displayorder $y0]
3196 if {[lindex $children($curview,$id) 0] eq $kid} {
3197 # it is, work out offset to child
3198 set x0 [lsearch -exact $previdlist $kid]
3199 }
3200 }
3201 if {$x0 <= $col} break
3202 }
3203 # Insert a pad at that column as long as it has a line and
3204 # isn't the last column
3205 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3206 set idlist [linsert $idlist $col {}]
3207 lset rowidlist $row $idlist
3208 changedrow $row
3209 }
3210 }
3211 }
3212}
3213
3214proc xc {row col} {
3215 global canvx0 linespc
3216 return [expr {$canvx0 + $col * $linespc}]
3217}
3218
3219proc yc {row} {
3220 global canvy0 linespc
3221 return [expr {$canvy0 + $row * $linespc}]
3222}
3223
3224proc linewidth {id} {
3225 global thickerline lthickness
3226
3227 set wid $lthickness
3228 if {[info exists thickerline] && $id eq $thickerline} {
3229 set wid [expr {2 * $lthickness}]
3230 }
3231 return $wid
3232}
3233
3234proc rowranges {id} {
3235 global commitrow curview children uparrowlen downarrowlen
3236 global rowidlist
3237
3238 set kids $children($curview,$id)
3239 if {$kids eq {}} {
3240 return {}
3241 }
3242 set ret {}
3243 lappend kids $id
3244 foreach child $kids {
3245 if {![info exists commitrow($curview,$child)]} break
3246 set row $commitrow($curview,$child)
3247 if {![info exists prev]} {
3248 lappend ret [expr {$row + 1}]
3249 } else {
3250 if {$row <= $prevrow} {
3251 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3252 }
3253 # see if the line extends the whole way from prevrow to row
3254 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3255 [lsearch -exact [lindex $rowidlist \
3256 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3257 # it doesn't, see where it ends
3258 set r [expr {$prevrow + $downarrowlen}]
3259 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3260 while {[incr r -1] > $prevrow &&
3261 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3262 } else {
3263 while {[incr r] <= $row &&
3264 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3265 incr r -1
3266 }
3267 lappend ret $r
3268 # see where it starts up again
3269 set r [expr {$row - $uparrowlen}]
3270 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3271 while {[incr r] < $row &&
3272 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3273 } else {
3274 while {[incr r -1] >= $prevrow &&
3275 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3276 incr r
3277 }
3278 lappend ret $r
3279 }
3280 }
3281 if {$child eq $id} {
3282 lappend ret $row
3283 }
3284 set prev $id
3285 set prevrow $row
3286 }
3287 return $ret
3288}
3289
3290proc drawlineseg {id row endrow arrowlow} {
3291 global rowidlist displayorder iddrawn linesegs
3292 global canv colormap linespc curview maxlinelen parentlist
3293
3294 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3295 set le [expr {$row + 1}]
3296 set arrowhigh 1
3297 while {1} {
3298 set c [lsearch -exact [lindex $rowidlist $le] $id]
3299 if {$c < 0} {
3300 incr le -1
3301 break
3302 }
3303 lappend cols $c
3304 set x [lindex $displayorder $le]
3305 if {$x eq $id} {
3306 set arrowhigh 0
3307 break
3308 }
3309 if {[info exists iddrawn($x)] || $le == $endrow} {
3310 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3311 if {$c >= 0} {
3312 lappend cols $c
3313 set arrowhigh 0
3314 }
3315 break
3316 }
3317 incr le
3318 }
3319 if {$le <= $row} {
3320 return $row
3321 }
3322
3323 set lines {}
3324 set i 0
3325 set joinhigh 0
3326 if {[info exists linesegs($id)]} {
3327 set lines $linesegs($id)
3328 foreach li $lines {
3329 set r0 [lindex $li 0]
3330 if {$r0 > $row} {
3331 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3332 set joinhigh 1
3333 }
3334 break
3335 }
3336 incr i
3337 }
3338 }
3339 set joinlow 0
3340 if {$i > 0} {
3341 set li [lindex $lines [expr {$i-1}]]
3342 set r1 [lindex $li 1]
3343 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3344 set joinlow 1
3345 }
3346 }
3347
3348 set x [lindex $cols [expr {$le - $row}]]
3349 set xp [lindex $cols [expr {$le - 1 - $row}]]
3350 set dir [expr {$xp - $x}]
3351 if {$joinhigh} {
3352 set ith [lindex $lines $i 2]
3353 set coords [$canv coords $ith]
3354 set ah [$canv itemcget $ith -arrow]
3355 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3356 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3357 if {$x2 ne {} && $x - $x2 == $dir} {
3358 set coords [lrange $coords 0 end-2]
3359 }
3360 } else {
3361 set coords [list [xc $le $x] [yc $le]]
3362 }
3363 if {$joinlow} {
3364 set itl [lindex $lines [expr {$i-1}] 2]
3365 set al [$canv itemcget $itl -arrow]
3366 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3367 } elseif {$arrowlow} {
3368 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3369 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3370 set arrowlow 0
3371 }
3372 }
3373 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3374 for {set y $le} {[incr y -1] > $row} {} {
3375 set x $xp
3376 set xp [lindex $cols [expr {$y - 1 - $row}]]
3377 set ndir [expr {$xp - $x}]
3378 if {$dir != $ndir || $xp < 0} {
3379 lappend coords [xc $y $x] [yc $y]
3380 }
3381 set dir $ndir
3382 }
3383 if {!$joinlow} {
3384 if {$xp < 0} {
3385 # join parent line to first child
3386 set ch [lindex $displayorder $row]
3387 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3388 if {$xc < 0} {
3389 puts "oops: drawlineseg: child $ch not on row $row"
3390 } elseif {$xc != $x} {
3391 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3392 set d [expr {int(0.5 * $linespc)}]
3393 set x1 [xc $row $x]
3394 if {$xc < $x} {
3395 set x2 [expr {$x1 - $d}]
3396 } else {
3397 set x2 [expr {$x1 + $d}]
3398 }
3399 set y2 [yc $row]
3400 set y1 [expr {$y2 + $d}]
3401 lappend coords $x1 $y1 $x2 $y2
3402 } elseif {$xc < $x - 1} {
3403 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3404 } elseif {$xc > $x + 1} {
3405 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3406 }
3407 set x $xc
3408 }
3409 lappend coords [xc $row $x] [yc $row]
3410 } else {
3411 set xn [xc $row $xp]
3412 set yn [yc $row]
3413 lappend coords $xn $yn
3414 }
3415 if {!$joinhigh} {
3416 assigncolor $id
3417 set t [$canv create line $coords -width [linewidth $id] \
3418 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3419 $canv lower $t
3420 bindline $t $id
3421 set lines [linsert $lines $i [list $row $le $t]]
3422 } else {
3423 $canv coords $ith $coords
3424 if {$arrow ne $ah} {
3425 $canv itemconf $ith -arrow $arrow
3426 }
3427 lset lines $i 0 $row
3428 }
3429 } else {
3430 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3431 set ndir [expr {$xo - $xp}]
3432 set clow [$canv coords $itl]
3433 if {$dir == $ndir} {
3434 set clow [lrange $clow 2 end]
3435 }
3436 set coords [concat $coords $clow]
3437 if {!$joinhigh} {
3438 lset lines [expr {$i-1}] 1 $le
3439 } else {
3440 # coalesce two pieces
3441 $canv delete $ith
3442 set b [lindex $lines [expr {$i-1}] 0]
3443 set e [lindex $lines $i 1]
3444 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3445 }
3446 $canv coords $itl $coords
3447 if {$arrow ne $al} {
3448 $canv itemconf $itl -arrow $arrow
3449 }
3450 }
3451
3452 set linesegs($id) $lines
3453 return $le
3454}
3455
3456proc drawparentlinks {id row} {
3457 global rowidlist canv colormap curview parentlist
3458 global idpos linespc
3459
3460 set rowids [lindex $rowidlist $row]
3461 set col [lsearch -exact $rowids $id]
3462 if {$col < 0} return
3463 set olds [lindex $parentlist $row]
3464 set row2 [expr {$row + 1}]
3465 set x [xc $row $col]
3466 set y [yc $row]
3467 set y2 [yc $row2]
3468 set d [expr {int(0.5 * $linespc)}]
3469 set ymid [expr {$y + $d}]
3470 set ids [lindex $rowidlist $row2]
3471 # rmx = right-most X coord used
3472 set rmx 0
3473 foreach p $olds {
3474 set i [lsearch -exact $ids $p]
3475 if {$i < 0} {
3476 puts "oops, parent $p of $id not in list"
3477 continue
3478 }
3479 set x2 [xc $row2 $i]
3480 if {$x2 > $rmx} {
3481 set rmx $x2
3482 }
3483 set j [lsearch -exact $rowids $p]
3484 if {$j < 0} {
3485 # drawlineseg will do this one for us
3486 continue
3487 }
3488 assigncolor $p
3489 # should handle duplicated parents here...
3490 set coords [list $x $y]
3491 if {$i != $col} {
3492 # if attaching to a vertical segment, draw a smaller
3493 # slant for visual distinctness
3494 if {$i == $j} {
3495 if {$i < $col} {
3496 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3497 } else {
3498 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3499 }
3500 } elseif {$i < $col && $i < $j} {
3501 # segment slants towards us already
3502 lappend coords [xc $row $j] $y
3503 } else {
3504 if {$i < $col - 1} {
3505 lappend coords [expr {$x2 + $linespc}] $y
3506 } elseif {$i > $col + 1} {
3507 lappend coords [expr {$x2 - $linespc}] $y
3508 }
3509 lappend coords $x2 $y2
3510 }
3511 } else {
3512 lappend coords $x2 $y2
3513 }
3514 set t [$canv create line $coords -width [linewidth $p] \
3515 -fill $colormap($p) -tags lines.$p]
3516 $canv lower $t
3517 bindline $t $p
3518 }
3519 if {$rmx > [lindex $idpos($id) 1]} {
3520 lset idpos($id) 1 $rmx
3521 redrawtags $id
3522 }
3523}
3524
3525proc drawlines {id} {
3526 global canv
3527
3528 $canv itemconf lines.$id -width [linewidth $id]
3529}
3530
3531proc drawcmittext {id row col} {
3532 global linespc canv canv2 canv3 canvy0 fgcolor curview
3533 global commitlisted commitinfo rowidlist parentlist
3534 global rowtextx idpos idtags idheads idotherrefs
3535 global linehtag linentag linedtag selectedline
3536 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3537
3538 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3539 set listed [lindex $commitlisted $row]
3540 if {$id eq $nullid} {
3541 set ofill red
3542 } elseif {$id eq $nullid2} {
3543 set ofill green
3544 } else {
3545 set ofill [expr {$listed != 0? "blue": "white"}]
3546 }
3547 set x [xc $row $col]
3548 set y [yc $row]
3549 set orad [expr {$linespc / 3}]
3550 if {$listed <= 1} {
3551 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3552 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3553 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3554 } elseif {$listed == 2} {
3555 # triangle pointing left for left-side commits
3556 set t [$canv create polygon \
3557 [expr {$x - $orad}] $y \
3558 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3559 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3560 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3561 } else {
3562 # triangle pointing right for right-side commits
3563 set t [$canv create polygon \
3564 [expr {$x + $orad - 1}] $y \
3565 [expr {$x - $orad}] [expr {$y - $orad}] \
3566 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3567 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3568 }
3569 $canv raise $t
3570 $canv bind $t <1> {selcanvline {} %x %y}
3571 set rmx [llength [lindex $rowidlist $row]]
3572 set olds [lindex $parentlist $row]
3573 if {$olds ne {}} {
3574 set nextids [lindex $rowidlist [expr {$row + 1}]]
3575 foreach p $olds {
3576 set i [lsearch -exact $nextids $p]
3577 if {$i > $rmx} {
3578 set rmx $i
3579 }
3580 }
3581 }
3582 set xt [xc $row $rmx]
3583 set rowtextx($row) $xt
3584 set idpos($id) [list $x $xt $y]
3585 if {[info exists idtags($id)] || [info exists idheads($id)]
3586 || [info exists idotherrefs($id)]} {
3587 set xt [drawtags $id $x $xt $y]
3588 }
3589 set headline [lindex $commitinfo($id) 0]
3590 set name [lindex $commitinfo($id) 1]
3591 set date [lindex $commitinfo($id) 2]
3592 set date [formatdate $date]
3593 set font $mainfont
3594 set nfont $mainfont
3595 set isbold [ishighlighted $row]
3596 if {$isbold > 0} {
3597 lappend boldrows $row
3598 lappend font bold
3599 if {$isbold > 1} {
3600 lappend boldnamerows $row
3601 lappend nfont bold
3602 }
3603 }
3604 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3605 -text $headline -font $font -tags text]
3606 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3607 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3608 -text $name -font $nfont -tags text]
3609 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3610 -text $date -font $mainfont -tags text]
3611 if {[info exists selectedline] && $selectedline == $row} {
3612 make_secsel $row
3613 }
3614 set xr [expr {$xt + [font measure $mainfont $headline]}]
3615 if {$xr > $canvxmax} {
3616 set canvxmax $xr
3617 setcanvscroll
3618 }
3619}
3620
3621proc drawcmitrow {row} {
3622 global displayorder rowidlist nrows_drawn
3623 global iddrawn markingmatches
3624 global commitinfo parentlist numcommits
3625 global filehighlight fhighlights findpattern nhighlights
3626 global hlview vhighlights
3627 global highlight_related rhighlights
3628
3629 if {$row >= $numcommits} return
3630
3631 set id [lindex $displayorder $row]
3632 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3633 askvhighlight $row $id
3634 }
3635 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3636 askfilehighlight $row $id
3637 }
3638 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3639 askfindhighlight $row $id
3640 }
3641 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3642 askrelhighlight $row $id
3643 }
3644 if {![info exists iddrawn($id)]} {
3645 set col [lsearch -exact [lindex $rowidlist $row] $id]
3646 if {$col < 0} {
3647 puts "oops, row $row id $id not in list"
3648 return
3649 }
3650 if {![info exists commitinfo($id)]} {
3651 getcommit $id
3652 }
3653 assigncolor $id
3654 drawcmittext $id $row $col
3655 set iddrawn($id) 1
3656 incr nrows_drawn
3657 }
3658 if {$markingmatches} {
3659 markrowmatches $row $id
3660 }
3661}
3662
3663proc drawcommits {row {endrow {}}} {
3664 global numcommits iddrawn displayorder curview need_redisplay
3665 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3666
3667 if {$row < 0} {
3668 set row 0
3669 }
3670 if {$endrow eq {}} {
3671 set endrow $row
3672 }
3673 if {$endrow >= $numcommits} {
3674 set endrow [expr {$numcommits - 1}]
3675 }
3676
3677 set rl1 [expr {$row - $downarrowlen - 3}]
3678 if {$rl1 < 0} {
3679 set rl1 0
3680 }
3681 set ro1 [expr {$row - 3}]
3682 if {$ro1 < 0} {
3683 set ro1 0
3684 }
3685 set r2 [expr {$endrow + $uparrowlen + 3}]
3686 if {$r2 > $numcommits} {
3687 set r2 $numcommits
3688 }
3689 for {set r $rl1} {$r < $r2} {incr r} {
3690 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3691 if {$rl1 < $r} {
3692 layoutrows $rl1 $r
3693 }
3694 set rl1 [expr {$r + 1}]
3695 }
3696 }
3697 if {$rl1 < $r} {
3698 layoutrows $rl1 $r
3699 }
3700 optimize_rows $ro1 0 $r2
3701 if {$need_redisplay || $nrows_drawn > 2000} {
3702 clear_display
3703 drawvisible
3704 }
3705
3706 # make the lines join to already-drawn rows either side
3707 set r [expr {$row - 1}]
3708 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3709 set r $row
3710 }
3711 set er [expr {$endrow + 1}]
3712 if {$er >= $numcommits ||
3713 ![info exists iddrawn([lindex $displayorder $er])]} {
3714 set er $endrow
3715 }
3716 for {} {$r <= $er} {incr r} {
3717 set id [lindex $displayorder $r]
3718 set wasdrawn [info exists iddrawn($id)]
3719 drawcmitrow $r
3720 if {$r == $er} break
3721 set nextid [lindex $displayorder [expr {$r + 1}]]
3722 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3723 catch {unset prevlines}
3724 continue
3725 }
3726 drawparentlinks $id $r
3727
3728 if {[info exists lineends($r)]} {
3729 foreach lid $lineends($r) {
3730 unset prevlines($lid)
3731 }
3732 }
3733 set rowids [lindex $rowidlist $r]
3734 foreach lid $rowids {
3735 if {$lid eq {}} continue
3736 if {$lid eq $id} {
3737 # see if this is the first child of any of its parents
3738 foreach p [lindex $parentlist $r] {
3739 if {[lsearch -exact $rowids $p] < 0} {
3740 # make this line extend up to the child
3741 set le [drawlineseg $p $r $er 0]
3742 lappend lineends($le) $p
3743 set prevlines($p) 1
3744 }
3745 }
3746 } elseif {![info exists prevlines($lid)]} {
3747 set le [drawlineseg $lid $r $er 1]
3748 lappend lineends($le) $lid
3749 set prevlines($lid) 1
3750 }
3751 }
3752 }
3753}
3754
3755proc drawfrac {f0 f1} {
3756 global canv linespc
3757
3758 set ymax [lindex [$canv cget -scrollregion] 3]
3759 if {$ymax eq {} || $ymax == 0} return
3760 set y0 [expr {int($f0 * $ymax)}]
3761 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3762 set y1 [expr {int($f1 * $ymax)}]
3763 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3764 drawcommits $row $endrow
3765}
3766
3767proc drawvisible {} {
3768 global canv
3769 eval drawfrac [$canv yview]
3770}
3771
3772proc clear_display {} {
3773 global iddrawn linesegs need_redisplay nrows_drawn
3774 global vhighlights fhighlights nhighlights rhighlights
3775
3776 allcanvs delete all
3777 catch {unset iddrawn}
3778 catch {unset linesegs}
3779 catch {unset vhighlights}
3780 catch {unset fhighlights}
3781 catch {unset nhighlights}
3782 catch {unset rhighlights}
3783 set need_redisplay 0
3784 set nrows_drawn 0
3785}
3786
3787proc findcrossings {id} {
3788 global rowidlist parentlist numcommits displayorder
3789
3790 set cross {}
3791 set ccross {}
3792 foreach {s e} [rowranges $id] {
3793 if {$e >= $numcommits} {
3794 set e [expr {$numcommits - 1}]
3795 }
3796 if {$e <= $s} continue
3797 for {set row $e} {[incr row -1] >= $s} {} {
3798 set x [lsearch -exact [lindex $rowidlist $row] $id]
3799 if {$x < 0} break
3800 set olds [lindex $parentlist $row]
3801 set kid [lindex $displayorder $row]
3802 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3803 if {$kidx < 0} continue
3804 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3805 foreach p $olds {
3806 set px [lsearch -exact $nextrow $p]
3807 if {$px < 0} continue
3808 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3809 if {[lsearch -exact $ccross $p] >= 0} continue
3810 if {$x == $px + ($kidx < $px? -1: 1)} {
3811 lappend ccross $p
3812 } elseif {[lsearch -exact $cross $p] < 0} {
3813 lappend cross $p
3814 }
3815 }
3816 }
3817 }
3818 }
3819 return [concat $ccross {{}} $cross]
3820}
3821
3822proc assigncolor {id} {
3823 global colormap colors nextcolor
3824 global commitrow parentlist children children curview
3825
3826 if {[info exists colormap($id)]} return
3827 set ncolors [llength $colors]
3828 if {[info exists children($curview,$id)]} {
3829 set kids $children($curview,$id)
3830 } else {
3831 set kids {}
3832 }
3833 if {[llength $kids] == 1} {
3834 set child [lindex $kids 0]
3835 if {[info exists colormap($child)]
3836 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3837 set colormap($id) $colormap($child)
3838 return
3839 }
3840 }
3841 set badcolors {}
3842 set origbad {}
3843 foreach x [findcrossings $id] {
3844 if {$x eq {}} {
3845 # delimiter between corner crossings and other crossings
3846 if {[llength $badcolors] >= $ncolors - 1} break
3847 set origbad $badcolors
3848 }
3849 if {[info exists colormap($x)]
3850 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3851 lappend badcolors $colormap($x)
3852 }
3853 }
3854 if {[llength $badcolors] >= $ncolors} {
3855 set badcolors $origbad
3856 }
3857 set origbad $badcolors
3858 if {[llength $badcolors] < $ncolors - 1} {
3859 foreach child $kids {
3860 if {[info exists colormap($child)]
3861 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3862 lappend badcolors $colormap($child)
3863 }
3864 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3865 if {[info exists colormap($p)]
3866 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3867 lappend badcolors $colormap($p)
3868 }
3869 }
3870 }
3871 if {[llength $badcolors] >= $ncolors} {
3872 set badcolors $origbad
3873 }
3874 }
3875 for {set i 0} {$i <= $ncolors} {incr i} {
3876 set c [lindex $colors $nextcolor]
3877 if {[incr nextcolor] >= $ncolors} {
3878 set nextcolor 0
3879 }
3880 if {[lsearch -exact $badcolors $c]} break
3881 }
3882 set colormap($id) $c
3883}
3884
3885proc bindline {t id} {
3886 global canv
3887
3888 $canv bind $t <Enter> "lineenter %x %y $id"
3889 $canv bind $t <Motion> "linemotion %x %y $id"
3890 $canv bind $t <Leave> "lineleave $id"
3891 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3892}
3893
3894proc drawtags {id x xt y1} {
3895 global idtags idheads idotherrefs mainhead
3896 global linespc lthickness
3897 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3898
3899 set marks {}
3900 set ntags 0
3901 set nheads 0
3902 if {[info exists idtags($id)]} {
3903 set marks $idtags($id)
3904 set ntags [llength $marks]
3905 }
3906 if {[info exists idheads($id)]} {
3907 set marks [concat $marks $idheads($id)]
3908 set nheads [llength $idheads($id)]
3909 }
3910 if {[info exists idotherrefs($id)]} {
3911 set marks [concat $marks $idotherrefs($id)]
3912 }
3913 if {$marks eq {}} {
3914 return $xt
3915 }
3916
3917 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3918 set yt [expr {$y1 - 0.5 * $linespc}]
3919 set yb [expr {$yt + $linespc - 1}]
3920 set xvals {}
3921 set wvals {}
3922 set i -1
3923 foreach tag $marks {
3924 incr i
3925 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3926 set wid [font measure [concat $mainfont bold] $tag]
3927 } else {
3928 set wid [font measure $mainfont $tag]
3929 }
3930 lappend xvals $xt
3931 lappend wvals $wid
3932 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3933 }
3934 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3935 -width $lthickness -fill black -tags tag.$id]
3936 $canv lower $t
3937 foreach tag $marks x $xvals wid $wvals {
3938 set xl [expr {$x + $delta}]
3939 set xr [expr {$x + $delta + $wid + $lthickness}]
3940 set font $mainfont
3941 if {[incr ntags -1] >= 0} {
3942 # draw a tag
3943 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3944 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3945 -width 1 -outline black -fill yellow -tags tag.$id]
3946 $canv bind $t <1> [list showtag $tag 1]
3947 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3948 } else {
3949 # draw a head or other ref
3950 if {[incr nheads -1] >= 0} {
3951 set col green
3952 if {$tag eq $mainhead} {
3953 lappend font bold
3954 }
3955 } else {
3956 set col "#ddddff"
3957 }
3958 set xl [expr {$xl - $delta/2}]
3959 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3960 -width 1 -outline black -fill $col -tags tag.$id
3961 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3962 set rwid [font measure $mainfont $remoteprefix]
3963 set xi [expr {$x + 1}]
3964 set yti [expr {$yt + 1}]
3965 set xri [expr {$x + $rwid}]
3966 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3967 -width 0 -fill "#ffddaa" -tags tag.$id
3968 }
3969 }
3970 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3971 -font $font -tags [list tag.$id text]]
3972 if {$ntags >= 0} {
3973 $canv bind $t <1> [list showtag $tag 1]
3974 } elseif {$nheads >= 0} {
3975 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3976 }
3977 }
3978 return $xt
3979}
3980
3981proc xcoord {i level ln} {
3982 global canvx0 xspc1 xspc2
3983
3984 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3985 if {$i > 0 && $i == $level} {
3986 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3987 } elseif {$i > $level} {
3988 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3989 }
3990 return $x
3991}
3992
3993proc show_status {msg} {
3994 global canv mainfont fgcolor
3995
3996 clear_display
3997 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3998 -tags text -fill $fgcolor
3999}
4000
4001# Insert a new commit as the child of the commit on row $row.
4002# The new commit will be displayed on row $row and the commits
4003# on that row and below will move down one row.
4004proc insertrow {row newcmit} {
4005 global displayorder parentlist commitlisted children
4006 global commitrow curview rowidlist rowisopt rowfinal numcommits
4007 global numcommits
4008 global selectedline commitidx ordertok
4009
4010 if {$row >= $numcommits} {
4011 puts "oops, inserting new row $row but only have $numcommits rows"
4012 return
4013 }
4014 set p [lindex $displayorder $row]
4015 set displayorder [linsert $displayorder $row $newcmit]
4016 set parentlist [linsert $parentlist $row $p]
4017 set kids $children($curview,$p)
4018 lappend kids $newcmit
4019 set children($curview,$p) $kids
4020 set children($curview,$newcmit) {}
4021 set commitlisted [linsert $commitlisted $row 1]
4022 set l [llength $displayorder]
4023 for {set r $row} {$r < $l} {incr r} {
4024 set id [lindex $displayorder $r]
4025 set commitrow($curview,$id) $r
4026 }
4027 incr commitidx($curview)
4028 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4029
4030 set idlist [lindex $rowidlist $row]
4031 if {[llength $kids] == 1} {
4032 set col [lsearch -exact $idlist $p]
4033 lset idlist $col $newcmit
4034 } else {
4035 set col [llength $idlist]
4036 lappend idlist $newcmit
4037 }
4038 set rowidlist [linsert $rowidlist $row $idlist]
4039 set rowisopt [linsert $rowisopt $row 0]
4040 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4041
4042 incr numcommits
4043
4044 if {[info exists selectedline] && $selectedline >= $row} {
4045 incr selectedline
4046 }
4047 redisplay
4048}
4049
4050# Remove a commit that was inserted with insertrow on row $row.
4051proc removerow {row} {
4052 global displayorder parentlist commitlisted children
4053 global commitrow curview rowidlist rowisopt rowfinal numcommits
4054 global numcommits
4055 global linesegends selectedline commitidx
4056
4057 if {$row >= $numcommits} {
4058 puts "oops, removing row $row but only have $numcommits rows"
4059 return
4060 }
4061 set rp1 [expr {$row + 1}]
4062 set id [lindex $displayorder $row]
4063 set p [lindex $parentlist $row]
4064 set displayorder [lreplace $displayorder $row $row]
4065 set parentlist [lreplace $parentlist $row $row]
4066 set commitlisted [lreplace $commitlisted $row $row]
4067 set kids $children($curview,$p)
4068 set i [lsearch -exact $kids $id]
4069 if {$i >= 0} {
4070 set kids [lreplace $kids $i $i]
4071 set children($curview,$p) $kids
4072 }
4073 set l [llength $displayorder]
4074 for {set r $row} {$r < $l} {incr r} {
4075 set id [lindex $displayorder $r]
4076 set commitrow($curview,$id) $r
4077 }
4078 incr commitidx($curview) -1
4079
4080 set rowidlist [lreplace $rowidlist $row $row]
4081 set rowisopt [lreplace $rowisopt $row $row]
4082 set rowfinal [lreplace $rowfinal $row $row]
4083
4084 incr numcommits -1
4085
4086 if {[info exists selectedline] && $selectedline > $row} {
4087 incr selectedline -1
4088 }
4089 redisplay
4090}
4091
4092# Don't change the text pane cursor if it is currently the hand cursor,
4093# showing that we are over a sha1 ID link.
4094proc settextcursor {c} {
4095 global ctext curtextcursor
4096
4097 if {[$ctext cget -cursor] == $curtextcursor} {
4098 $ctext config -cursor $c
4099 }
4100 set curtextcursor $c
4101}
4102
4103proc nowbusy {what} {
4104 global isbusy
4105
4106 if {[array names isbusy] eq {}} {
4107 . config -cursor watch
4108 settextcursor watch
4109 }
4110 set isbusy($what) 1
4111}
4112
4113proc notbusy {what} {
4114 global isbusy maincursor textcursor
4115
4116 catch {unset isbusy($what)}
4117 if {[array names isbusy] eq {}} {
4118 . config -cursor $maincursor
4119 settextcursor $textcursor
4120 }
4121}
4122
4123proc findmatches {f} {
4124 global findtype findstring
4125 if {$findtype == "Regexp"} {
4126 set matches [regexp -indices -all -inline $findstring $f]
4127 } else {
4128 set fs $findstring
4129 if {$findtype == "IgnCase"} {
4130 set f [string tolower $f]
4131 set fs [string tolower $fs]
4132 }
4133 set matches {}
4134 set i 0
4135 set l [string length $fs]
4136 while {[set j [string first $fs $f $i]] >= 0} {
4137 lappend matches [list $j [expr {$j+$l-1}]]
4138 set i [expr {$j + $l}]
4139 }
4140 }
4141 return $matches
4142}
4143
4144proc dofind {{rev 0}} {
4145 global findstring findstartline findcurline selectedline numcommits
4146 global gdttype filehighlight fh_serial find_dirn
4147
4148 unmarkmatches
4149 focus .
4150 if {$findstring eq {} || $numcommits == 0} return
4151 if {![info exists selectedline]} {
4152 set findstartline [lindex [visiblerows] $rev]
4153 } else {
4154 set findstartline $selectedline
4155 }
4156 set findcurline $findstartline
4157 nowbusy finding
4158 if {$gdttype ne "containing:" && ![info exists filehighlight]} {
4159 after cancel do_file_hl $fh_serial
4160 do_file_hl $fh_serial
4161 }
4162 if {!$rev} {
4163 set find_dirn 1
4164 run findmore
4165 } else {
4166 set find_dirn -1
4167 run findmorerev
4168 }
4169}
4170
4171proc findnext {restart} {
4172 global findcurline find_dirn
4173
4174 if {[info exists find_dirn]} return
4175 set find_dirn 1
4176 if {![info exists findcurline]} {
4177 if {$restart} {
4178 dofind
4179 } else {
4180 bell
4181 }
4182 } else {
4183 run findmore
4184 nowbusy finding
4185 }
4186}
4187
4188proc findprev {} {
4189 global findcurline find_dirn
4190
4191 if {[info exists find_dirn]} return
4192 set find_dirn -1
4193 if {![info exists findcurline]} {
4194 dofind 1
4195 } else {
4196 run findmorerev
4197 nowbusy finding
4198 }
4199}
4200
4201proc findmore {} {
4202 global commitdata commitinfo numcommits findpattern findloc
4203 global findstartline findcurline displayorder
4204 global find_dirn gdttype fhighlights
4205
4206 set fldtypes {Headline Author Date Committer CDate Comments}
4207 set l [expr {$findcurline + 1}]
4208 if {$l >= $numcommits} {
4209 set l 0
4210 }
4211 if {$l <= $findstartline} {
4212 set lim [expr {$findstartline + 1}]
4213 } else {
4214 set lim $numcommits
4215 }
4216 if {$lim - $l > 500} {
4217 set lim [expr {$l + 500}]
4218 }
4219 set found 0
4220 set domore 1
4221 if {$gdttype eq "containing:"} {
4222 for {} {$l < $lim} {incr l} {
4223 set id [lindex $displayorder $l]
4224 # shouldn't happen unless git log doesn't give all the commits...
4225 if {![info exists commitdata($id)]} continue
4226 if {![doesmatch $commitdata($id)]} continue
4227 if {![info exists commitinfo($id)]} {
4228 getcommit $id
4229 }
4230 set info $commitinfo($id)
4231 foreach f $info ty $fldtypes {
4232 if {($findloc eq "All fields" || $findloc eq $ty) &&
4233 [doesmatch $f]} {
4234 set found 1
4235 break
4236 }
4237 }
4238 if {$found} break
4239 }
4240 } else {
4241 for {} {$l < $lim} {incr l} {
4242 set id [lindex $displayorder $l]
4243 if {![info exists fhighlights($l)]} {
4244 askfilehighlight $l $id
4245 if {$domore} {
4246 set domore 0
4247 set findcurline [expr {$l - 1}]
4248 }
4249 } elseif {$fhighlights($l)} {
4250 set found $domore
4251 break
4252 }
4253 }
4254 }
4255 if {$found} {
4256 unset find_dirn
4257 findselectline $l
4258 notbusy finding
4259 return 0
4260 }
4261 if {!$domore} {
4262 flushhighlights
4263 return 0
4264 }
4265 if {$l == $findstartline + 1} {
4266 bell
4267 unset findcurline
4268 unset find_dirn
4269 notbusy finding
4270 return 0
4271 }
4272 set findcurline [expr {$l - 1}]
4273 return 1
4274}
4275
4276proc findmorerev {} {
4277 global commitdata commitinfo numcommits findpattern findloc
4278 global findstartline findcurline displayorder
4279 global find_dirn gdttype fhighlights
4280
4281 set fldtypes {Headline Author Date Committer CDate Comments}
4282 set l $findcurline
4283 if {$l == 0} {
4284 set l $numcommits
4285 }
4286 incr l -1
4287 if {$l >= $findstartline} {
4288 set lim [expr {$findstartline - 1}]
4289 } else {
4290 set lim -1
4291 }
4292 if {$l - $lim > 500} {
4293 set lim [expr {$l - 500}]
4294 }
4295 set found 0
4296 set domore 1
4297 if {$gdttype eq "containing:"} {
4298 for {} {$l > $lim} {incr l -1} {
4299 set id [lindex $displayorder $l]
4300 if {![info exists commitdata($id)]} continue
4301 if {![doesmatch $commitdata($id)]} continue
4302 if {![info exists commitinfo($id)]} {
4303 getcommit $id
4304 }
4305 set info $commitinfo($id)
4306 foreach f $info ty $fldtypes {
4307 if {($findloc eq "All fields" || $findloc eq $ty) &&
4308 [doesmatch $f]} {
4309 set found 1
4310 break
4311 }
4312 }
4313 if {$found} break
4314 }
4315 } else {
4316 for {} {$l > $lim} {incr l -1} {
4317 set id [lindex $displayorder $l]
4318 if {![info exists fhighlights($l)]} {
4319 askfilehighlight $l $id
4320 if {$domore} {
4321 set domore 0
4322 set findcurline [expr {$l + 1}]
4323 }
4324 } elseif {$fhighlights($l)} {
4325 set found $domore
4326 break
4327 }
4328 }
4329 }
4330 if {$found} {
4331 unset find_dirn
4332 findselectline $l
4333 notbusy finding
4334 return 0
4335 }
4336 if {!$domore} {
4337 flushhighlights
4338 return 0
4339 }
4340 if {$l == -1} {
4341 bell
4342 unset findcurline
4343 unset find_dirn
4344 notbusy finding
4345 return 0
4346 }
4347 set findcurline [expr {$l + 1}]
4348 return 1
4349}
4350
4351proc findselectline {l} {
4352 global findloc commentend ctext findcurline markingmatches gdttype
4353
4354 set markingmatches 1
4355 set findcurline $l
4356 selectline $l 1
4357 if {$findloc == "All fields" || $findloc == "Comments"} {
4358 # highlight the matches in the comments
4359 set f [$ctext get 1.0 $commentend]
4360 set matches [findmatches $f]
4361 foreach match $matches {
4362 set start [lindex $match 0]
4363 set end [expr {[lindex $match 1] + 1}]
4364 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4365 }
4366 }
4367 drawvisible
4368}
4369
4370# mark the bits of a headline or author that match a find string
4371proc markmatches {canv l str tag matches font row} {
4372 global selectedline
4373
4374 set bbox [$canv bbox $tag]
4375 set x0 [lindex $bbox 0]
4376 set y0 [lindex $bbox 1]
4377 set y1 [lindex $bbox 3]
4378 foreach match $matches {
4379 set start [lindex $match 0]
4380 set end [lindex $match 1]
4381 if {$start > $end} continue
4382 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4383 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4384 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4385 [expr {$x0+$xlen+2}] $y1 \
4386 -outline {} -tags [list match$l matches] -fill yellow]
4387 $canv lower $t
4388 if {[info exists selectedline] && $row == $selectedline} {
4389 $canv raise $t secsel
4390 }
4391 }
4392}
4393
4394proc unmarkmatches {} {
4395 global findids markingmatches findcurline
4396
4397 allcanvs delete matches
4398 catch {unset findids}
4399 set markingmatches 0
4400 catch {unset findcurline}
4401}
4402
4403proc selcanvline {w x y} {
4404 global canv canvy0 ctext linespc
4405 global rowtextx
4406 set ymax [lindex [$canv cget -scrollregion] 3]
4407 if {$ymax == {}} return
4408 set yfrac [lindex [$canv yview] 0]
4409 set y [expr {$y + $yfrac * $ymax}]
4410 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4411 if {$l < 0} {
4412 set l 0
4413 }
4414 if {$w eq $canv} {
4415 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4416 }
4417 unmarkmatches
4418 selectline $l 1
4419}
4420
4421proc commit_descriptor {p} {
4422 global commitinfo
4423 if {![info exists commitinfo($p)]} {
4424 getcommit $p
4425 }
4426 set l "..."
4427 if {[llength $commitinfo($p)] > 1} {
4428 set l [lindex $commitinfo($p) 0]
4429 }
4430 return "$p ($l)\n"
4431}
4432
4433# append some text to the ctext widget, and make any SHA1 ID
4434# that we know about be a clickable link.
4435proc appendwithlinks {text tags} {
4436 global ctext commitrow linknum curview pendinglinks
4437
4438 set start [$ctext index "end - 1c"]
4439 $ctext insert end $text $tags
4440 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4441 foreach l $links {
4442 set s [lindex $l 0]
4443 set e [lindex $l 1]
4444 set linkid [string range $text $s $e]
4445 incr e
4446 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4447 setlink $linkid link$linknum
4448 incr linknum
4449 }
4450}
4451
4452proc setlink {id lk} {
4453 global curview commitrow ctext pendinglinks commitinterest
4454
4455 if {[info exists commitrow($curview,$id)]} {
4456 $ctext tag conf $lk -foreground blue -underline 1
4457 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4458 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4459 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4460 } else {
4461 lappend pendinglinks($id) $lk
4462 lappend commitinterest($id) {makelink %I}
4463 }
4464}
4465
4466proc makelink {id} {
4467 global pendinglinks
4468
4469 if {![info exists pendinglinks($id)]} return
4470 foreach lk $pendinglinks($id) {
4471 setlink $id $lk
4472 }
4473 unset pendinglinks($id)
4474}
4475
4476proc linkcursor {w inc} {
4477 global linkentercount curtextcursor
4478
4479 if {[incr linkentercount $inc] > 0} {
4480 $w configure -cursor hand2
4481 } else {
4482 $w configure -cursor $curtextcursor
4483 if {$linkentercount < 0} {
4484 set linkentercount 0
4485 }
4486 }
4487}
4488
4489proc viewnextline {dir} {
4490 global canv linespc
4491
4492 $canv delete hover
4493 set ymax [lindex [$canv cget -scrollregion] 3]
4494 set wnow [$canv yview]
4495 set wtop [expr {[lindex $wnow 0] * $ymax}]
4496 set newtop [expr {$wtop + $dir * $linespc}]
4497 if {$newtop < 0} {
4498 set newtop 0
4499 } elseif {$newtop > $ymax} {
4500 set newtop $ymax
4501 }
4502 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4503}
4504
4505# add a list of tag or branch names at position pos
4506# returns the number of names inserted
4507proc appendrefs {pos ids var} {
4508 global ctext commitrow linknum curview $var maxrefs
4509
4510 if {[catch {$ctext index $pos}]} {
4511 return 0
4512 }
4513 $ctext conf -state normal
4514 $ctext delete $pos "$pos lineend"
4515 set tags {}
4516 foreach id $ids {
4517 foreach tag [set $var\($id\)] {
4518 lappend tags [list $tag $id]
4519 }
4520 }
4521 if {[llength $tags] > $maxrefs} {
4522 $ctext insert $pos "many ([llength $tags])"
4523 } else {
4524 set tags [lsort -index 0 -decreasing $tags]
4525 set sep {}
4526 foreach ti $tags {
4527 set id [lindex $ti 1]
4528 set lk link$linknum
4529 incr linknum
4530 $ctext tag delete $lk
4531 $ctext insert $pos $sep
4532 $ctext insert $pos [lindex $ti 0] $lk
4533 setlink $id $lk
4534 set sep ", "
4535 }
4536 }
4537 $ctext conf -state disabled
4538 return [llength $tags]
4539}
4540
4541# called when we have finished computing the nearby tags
4542proc dispneartags {delay} {
4543 global selectedline currentid showneartags tagphase
4544
4545 if {![info exists selectedline] || !$showneartags} return
4546 after cancel dispnexttag
4547 if {$delay} {
4548 after 200 dispnexttag
4549 set tagphase -1
4550 } else {
4551 after idle dispnexttag
4552 set tagphase 0
4553 }
4554}
4555
4556proc dispnexttag {} {
4557 global selectedline currentid showneartags tagphase ctext
4558
4559 if {![info exists selectedline] || !$showneartags} return
4560 switch -- $tagphase {
4561 0 {
4562 set dtags [desctags $currentid]
4563 if {$dtags ne {}} {
4564 appendrefs precedes $dtags idtags
4565 }
4566 }
4567 1 {
4568 set atags [anctags $currentid]
4569 if {$atags ne {}} {
4570 appendrefs follows $atags idtags
4571 }
4572 }
4573 2 {
4574 set dheads [descheads $currentid]
4575 if {$dheads ne {}} {
4576 if {[appendrefs branch $dheads idheads] > 1
4577 && [$ctext get "branch -3c"] eq "h"} {
4578 # turn "Branch" into "Branches"
4579 $ctext conf -state normal
4580 $ctext insert "branch -2c" "es"
4581 $ctext conf -state disabled
4582 }
4583 }
4584 }
4585 }
4586 if {[incr tagphase] <= 2} {
4587 after idle dispnexttag
4588 }
4589}
4590
4591proc make_secsel {l} {
4592 global linehtag linentag linedtag canv canv2 canv3
4593
4594 if {![info exists linehtag($l)]} return
4595 $canv delete secsel
4596 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4597 -tags secsel -fill [$canv cget -selectbackground]]
4598 $canv lower $t
4599 $canv2 delete secsel
4600 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4601 -tags secsel -fill [$canv2 cget -selectbackground]]
4602 $canv2 lower $t
4603 $canv3 delete secsel
4604 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4605 -tags secsel -fill [$canv3 cget -selectbackground]]
4606 $canv3 lower $t
4607}
4608
4609proc selectline {l isnew} {
4610 global canv ctext commitinfo selectedline
4611 global displayorder
4612 global canvy0 linespc parentlist children curview
4613 global currentid sha1entry
4614 global commentend idtags linknum
4615 global mergemax numcommits pending_select
4616 global cmitmode showneartags allcommits
4617
4618 catch {unset pending_select}
4619 $canv delete hover
4620 normalline
4621 unsel_reflist
4622 if {$l < 0 || $l >= $numcommits} return
4623 set y [expr {$canvy0 + $l * $linespc}]
4624 set ymax [lindex [$canv cget -scrollregion] 3]
4625 set ytop [expr {$y - $linespc - 1}]
4626 set ybot [expr {$y + $linespc + 1}]
4627 set wnow [$canv yview]
4628 set wtop [expr {[lindex $wnow 0] * $ymax}]
4629 set wbot [expr {[lindex $wnow 1] * $ymax}]
4630 set wh [expr {$wbot - $wtop}]
4631 set newtop $wtop
4632 if {$ytop < $wtop} {
4633 if {$ybot < $wtop} {
4634 set newtop [expr {$y - $wh / 2.0}]
4635 } else {
4636 set newtop $ytop
4637 if {$newtop > $wtop - $linespc} {
4638 set newtop [expr {$wtop - $linespc}]
4639 }
4640 }
4641 } elseif {$ybot > $wbot} {
4642 if {$ytop > $wbot} {
4643 set newtop [expr {$y - $wh / 2.0}]
4644 } else {
4645 set newtop [expr {$ybot - $wh}]
4646 if {$newtop < $wtop + $linespc} {
4647 set newtop [expr {$wtop + $linespc}]
4648 }
4649 }
4650 }
4651 if {$newtop != $wtop} {
4652 if {$newtop < 0} {
4653 set newtop 0
4654 }
4655 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4656 drawvisible
4657 }
4658
4659 make_secsel $l
4660
4661 if {$isnew} {
4662 addtohistory [list selectline $l 0]
4663 }
4664
4665 set selectedline $l
4666
4667 set id [lindex $displayorder $l]
4668 set currentid $id
4669 $sha1entry delete 0 end
4670 $sha1entry insert 0 $id
4671 $sha1entry selection from 0
4672 $sha1entry selection to end
4673 rhighlight_sel $id
4674
4675 $ctext conf -state normal
4676 clear_ctext
4677 set linknum 0
4678 set info $commitinfo($id)
4679 set date [formatdate [lindex $info 2]]
4680 $ctext insert end "Author: [lindex $info 1] $date\n"
4681 set date [formatdate [lindex $info 4]]
4682 $ctext insert end "Committer: [lindex $info 3] $date\n"
4683 if {[info exists idtags($id)]} {
4684 $ctext insert end "Tags:"
4685 foreach tag $idtags($id) {
4686 $ctext insert end " $tag"
4687 }
4688 $ctext insert end "\n"
4689 }
4690
4691 set headers {}
4692 set olds [lindex $parentlist $l]
4693 if {[llength $olds] > 1} {
4694 set np 0
4695 foreach p $olds {
4696 if {$np >= $mergemax} {
4697 set tag mmax
4698 } else {
4699 set tag m$np
4700 }
4701 $ctext insert end "Parent: " $tag
4702 appendwithlinks [commit_descriptor $p] {}
4703 incr np
4704 }
4705 } else {
4706 foreach p $olds {
4707 append headers "Parent: [commit_descriptor $p]"
4708 }
4709 }
4710
4711 foreach c $children($curview,$id) {
4712 append headers "Child: [commit_descriptor $c]"
4713 }
4714
4715 # make anything that looks like a SHA1 ID be a clickable link
4716 appendwithlinks $headers {}
4717 if {$showneartags} {
4718 if {![info exists allcommits]} {
4719 getallcommits
4720 }
4721 $ctext insert end "Branch: "
4722 $ctext mark set branch "end -1c"
4723 $ctext mark gravity branch left
4724 $ctext insert end "\nFollows: "
4725 $ctext mark set follows "end -1c"
4726 $ctext mark gravity follows left
4727 $ctext insert end "\nPrecedes: "
4728 $ctext mark set precedes "end -1c"
4729 $ctext mark gravity precedes left
4730 $ctext insert end "\n"
4731 dispneartags 1
4732 }
4733 $ctext insert end "\n"
4734 set comment [lindex $info 5]
4735 if {[string first "\r" $comment] >= 0} {
4736 set comment [string map {"\r" "\n "} $comment]
4737 }
4738 appendwithlinks $comment {comment}
4739
4740 $ctext tag remove found 1.0 end
4741 $ctext conf -state disabled
4742 set commentend [$ctext index "end - 1c"]
4743
4744 init_flist "Comments"
4745 if {$cmitmode eq "tree"} {
4746 gettree $id
4747 } elseif {[llength $olds] <= 1} {
4748 startdiff $id
4749 } else {
4750 mergediff $id $l
4751 }
4752}
4753
4754proc selfirstline {} {
4755 unmarkmatches
4756 selectline 0 1
4757}
4758
4759proc sellastline {} {
4760 global numcommits
4761 unmarkmatches
4762 set l [expr {$numcommits - 1}]
4763 selectline $l 1
4764}
4765
4766proc selnextline {dir} {
4767 global selectedline
4768 focus .
4769 if {![info exists selectedline]} return
4770 set l [expr {$selectedline + $dir}]
4771 unmarkmatches
4772 selectline $l 1
4773}
4774
4775proc selnextpage {dir} {
4776 global canv linespc selectedline numcommits
4777
4778 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4779 if {$lpp < 1} {
4780 set lpp 1
4781 }
4782 allcanvs yview scroll [expr {$dir * $lpp}] units
4783 drawvisible
4784 if {![info exists selectedline]} return
4785 set l [expr {$selectedline + $dir * $lpp}]
4786 if {$l < 0} {
4787 set l 0
4788 } elseif {$l >= $numcommits} {
4789 set l [expr $numcommits - 1]
4790 }
4791 unmarkmatches
4792 selectline $l 1
4793}
4794
4795proc unselectline {} {
4796 global selectedline currentid
4797
4798 catch {unset selectedline}
4799 catch {unset currentid}
4800 allcanvs delete secsel
4801 rhighlight_none
4802}
4803
4804proc reselectline {} {
4805 global selectedline
4806
4807 if {[info exists selectedline]} {
4808 selectline $selectedline 0
4809 }
4810}
4811
4812proc addtohistory {cmd} {
4813 global history historyindex curview
4814
4815 set elt [list $curview $cmd]
4816 if {$historyindex > 0
4817 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4818 return
4819 }
4820
4821 if {$historyindex < [llength $history]} {
4822 set history [lreplace $history $historyindex end $elt]
4823 } else {
4824 lappend history $elt
4825 }
4826 incr historyindex
4827 if {$historyindex > 1} {
4828 .tf.bar.leftbut conf -state normal
4829 } else {
4830 .tf.bar.leftbut conf -state disabled
4831 }
4832 .tf.bar.rightbut conf -state disabled
4833}
4834
4835proc godo {elt} {
4836 global curview
4837
4838 set view [lindex $elt 0]
4839 set cmd [lindex $elt 1]
4840 if {$curview != $view} {
4841 showview $view
4842 }
4843 eval $cmd
4844}
4845
4846proc goback {} {
4847 global history historyindex
4848 focus .
4849
4850 if {$historyindex > 1} {
4851 incr historyindex -1
4852 godo [lindex $history [expr {$historyindex - 1}]]
4853 .tf.bar.rightbut conf -state normal
4854 }
4855 if {$historyindex <= 1} {
4856 .tf.bar.leftbut conf -state disabled
4857 }
4858}
4859
4860proc goforw {} {
4861 global history historyindex
4862 focus .
4863
4864 if {$historyindex < [llength $history]} {
4865 set cmd [lindex $history $historyindex]
4866 incr historyindex
4867 godo $cmd
4868 .tf.bar.leftbut conf -state normal
4869 }
4870 if {$historyindex >= [llength $history]} {
4871 .tf.bar.rightbut conf -state disabled
4872 }
4873}
4874
4875proc gettree {id} {
4876 global treefilelist treeidlist diffids diffmergeid treepending
4877 global nullid nullid2
4878
4879 set diffids $id
4880 catch {unset diffmergeid}
4881 if {![info exists treefilelist($id)]} {
4882 if {![info exists treepending]} {
4883 if {$id eq $nullid} {
4884 set cmd [list | git ls-files]
4885 } elseif {$id eq $nullid2} {
4886 set cmd [list | git ls-files --stage -t]
4887 } else {
4888 set cmd [list | git ls-tree -r $id]
4889 }
4890 if {[catch {set gtf [open $cmd r]}]} {
4891 return
4892 }
4893 set treepending $id
4894 set treefilelist($id) {}
4895 set treeidlist($id) {}
4896 fconfigure $gtf -blocking 0
4897 filerun $gtf [list gettreeline $gtf $id]
4898 }
4899 } else {
4900 setfilelist $id
4901 }
4902}
4903
4904proc gettreeline {gtf id} {
4905 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4906
4907 set nl 0
4908 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4909 if {$diffids eq $nullid} {
4910 set fname $line
4911 } else {
4912 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4913 set i [string first "\t" $line]
4914 if {$i < 0} continue
4915 set sha1 [lindex $line 2]
4916 set fname [string range $line [expr {$i+1}] end]
4917 if {[string index $fname 0] eq "\""} {
4918 set fname [lindex $fname 0]
4919 }
4920 lappend treeidlist($id) $sha1
4921 }
4922 lappend treefilelist($id) $fname
4923 }
4924 if {![eof $gtf]} {
4925 return [expr {$nl >= 1000? 2: 1}]
4926 }
4927 close $gtf
4928 unset treepending
4929 if {$cmitmode ne "tree"} {
4930 if {![info exists diffmergeid]} {
4931 gettreediffs $diffids
4932 }
4933 } elseif {$id ne $diffids} {
4934 gettree $diffids
4935 } else {
4936 setfilelist $id
4937 }
4938 return 0
4939}
4940
4941proc showfile {f} {
4942 global treefilelist treeidlist diffids nullid nullid2
4943 global ctext commentend
4944
4945 set i [lsearch -exact $treefilelist($diffids) $f]
4946 if {$i < 0} {
4947 puts "oops, $f not in list for id $diffids"
4948 return
4949 }
4950 if {$diffids eq $nullid} {
4951 if {[catch {set bf [open $f r]} err]} {
4952 puts "oops, can't read $f: $err"
4953 return
4954 }
4955 } else {
4956 set blob [lindex $treeidlist($diffids) $i]
4957 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4958 puts "oops, error reading blob $blob: $err"
4959 return
4960 }
4961 }
4962 fconfigure $bf -blocking 0
4963 filerun $bf [list getblobline $bf $diffids]
4964 $ctext config -state normal
4965 clear_ctext $commentend
4966 $ctext insert end "\n"
4967 $ctext insert end "$f\n" filesep
4968 $ctext config -state disabled
4969 $ctext yview $commentend
4970}
4971
4972proc getblobline {bf id} {
4973 global diffids cmitmode ctext
4974
4975 if {$id ne $diffids || $cmitmode ne "tree"} {
4976 catch {close $bf}
4977 return 0
4978 }
4979 $ctext config -state normal
4980 set nl 0
4981 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4982 $ctext insert end "$line\n"
4983 }
4984 if {[eof $bf]} {
4985 # delete last newline
4986 $ctext delete "end - 2c" "end - 1c"
4987 close $bf
4988 return 0
4989 }
4990 $ctext config -state disabled
4991 return [expr {$nl >= 1000? 2: 1}]
4992}
4993
4994proc mergediff {id l} {
4995 global diffmergeid diffopts mdifffd
4996 global diffids
4997 global parentlist
4998
4999 set diffmergeid $id
5000 set diffids $id
5001 # this doesn't seem to actually affect anything...
5002 set env(GIT_DIFF_OPTS) $diffopts
5003 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5004 if {[catch {set mdf [open $cmd r]} err]} {
5005 error_popup "Error getting merge diffs: $err"
5006 return
5007 }
5008 fconfigure $mdf -blocking 0
5009 set mdifffd($id) $mdf
5010 set np [llength [lindex $parentlist $l]]
5011 filerun $mdf [list getmergediffline $mdf $id $np]
5012}
5013
5014proc getmergediffline {mdf id np} {
5015 global diffmergeid ctext cflist mergemax
5016 global difffilestart mdifffd
5017
5018 $ctext conf -state normal
5019 set nr 0
5020 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5021 if {![info exists diffmergeid] || $id != $diffmergeid
5022 || $mdf != $mdifffd($id)} {
5023 close $mdf
5024 return 0
5025 }
5026 if {[regexp {^diff --cc (.*)} $line match fname]} {
5027 # start of a new file
5028 $ctext insert end "\n"
5029 set here [$ctext index "end - 1c"]
5030 lappend difffilestart $here
5031 add_flist [list $fname]
5032 set l [expr {(78 - [string length $fname]) / 2}]
5033 set pad [string range "----------------------------------------" 1 $l]
5034 $ctext insert end "$pad $fname $pad\n" filesep
5035 } elseif {[regexp {^@@} $line]} {
5036 $ctext insert end "$line\n" hunksep
5037 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5038 # do nothing
5039 } else {
5040 # parse the prefix - one ' ', '-' or '+' for each parent
5041 set spaces {}
5042 set minuses {}
5043 set pluses {}
5044 set isbad 0
5045 for {set j 0} {$j < $np} {incr j} {
5046 set c [string range $line $j $j]
5047 if {$c == " "} {
5048 lappend spaces $j
5049 } elseif {$c == "-"} {
5050 lappend minuses $j
5051 } elseif {$c == "+"} {
5052 lappend pluses $j
5053 } else {
5054 set isbad 1
5055 break
5056 }
5057 }
5058 set tags {}
5059 set num {}
5060 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5061 # line doesn't appear in result, parents in $minuses have the line
5062 set num [lindex $minuses 0]
5063 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5064 # line appears in result, parents in $pluses don't have the line
5065 lappend tags mresult
5066 set num [lindex $spaces 0]
5067 }
5068 if {$num ne {}} {
5069 if {$num >= $mergemax} {
5070 set num "max"
5071 }
5072 lappend tags m$num
5073 }
5074 $ctext insert end "$line\n" $tags
5075 }
5076 }
5077 $ctext conf -state disabled
5078 if {[eof $mdf]} {
5079 close $mdf
5080 return 0
5081 }
5082 return [expr {$nr >= 1000? 2: 1}]
5083}
5084
5085proc startdiff {ids} {
5086 global treediffs diffids treepending diffmergeid nullid nullid2
5087
5088 set diffids $ids
5089 catch {unset diffmergeid}
5090 if {![info exists treediffs($ids)] ||
5091 [lsearch -exact $ids $nullid] >= 0 ||
5092 [lsearch -exact $ids $nullid2] >= 0} {
5093 if {![info exists treepending]} {
5094 gettreediffs $ids
5095 }
5096 } else {
5097 addtocflist $ids
5098 }
5099}
5100
5101proc addtocflist {ids} {
5102 global treediffs cflist
5103 add_flist $treediffs($ids)
5104 getblobdiffs $ids
5105}
5106
5107proc diffcmd {ids flags} {
5108 global nullid nullid2
5109
5110 set i [lsearch -exact $ids $nullid]
5111 set j [lsearch -exact $ids $nullid2]
5112 if {$i >= 0} {
5113 if {[llength $ids] > 1 && $j < 0} {
5114 # comparing working directory with some specific revision
5115 set cmd [concat | git diff-index $flags]
5116 if {$i == 0} {
5117 lappend cmd -R [lindex $ids 1]
5118 } else {
5119 lappend cmd [lindex $ids 0]
5120 }
5121 } else {
5122 # comparing working directory with index
5123 set cmd [concat | git diff-files $flags]
5124 if {$j == 1} {
5125 lappend cmd -R
5126 }
5127 }
5128 } elseif {$j >= 0} {
5129 set cmd [concat | git diff-index --cached $flags]
5130 if {[llength $ids] > 1} {
5131 # comparing index with specific revision
5132 if {$i == 0} {
5133 lappend cmd -R [lindex $ids 1]
5134 } else {
5135 lappend cmd [lindex $ids 0]
5136 }
5137 } else {
5138 # comparing index with HEAD
5139 lappend cmd HEAD
5140 }
5141 } else {
5142 set cmd [concat | git diff-tree -r $flags $ids]
5143 }
5144 return $cmd
5145}
5146
5147proc gettreediffs {ids} {
5148 global treediff treepending
5149
5150 set treepending $ids
5151 set treediff {}
5152 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5153 fconfigure $gdtf -blocking 0
5154 filerun $gdtf [list gettreediffline $gdtf $ids]
5155}
5156
5157proc gettreediffline {gdtf ids} {
5158 global treediff treediffs treepending diffids diffmergeid
5159 global cmitmode
5160
5161 set nr 0
5162 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5163 set i [string first "\t" $line]
5164 if {$i >= 0} {
5165 set file [string range $line [expr {$i+1}] end]
5166 if {[string index $file 0] eq "\""} {
5167 set file [lindex $file 0]
5168 }
5169 lappend treediff $file
5170 }
5171 }
5172 if {![eof $gdtf]} {
5173 return [expr {$nr >= 1000? 2: 1}]
5174 }
5175 close $gdtf
5176 set treediffs($ids) $treediff
5177 unset treepending
5178 if {$cmitmode eq "tree"} {
5179 gettree $diffids
5180 } elseif {$ids != $diffids} {
5181 if {![info exists diffmergeid]} {
5182 gettreediffs $diffids
5183 }
5184 } else {
5185 addtocflist $ids
5186 }
5187 return 0
5188}
5189
5190# empty string or positive integer
5191proc diffcontextvalidate {v} {
5192 return [regexp {^(|[1-9][0-9]*)$} $v]
5193}
5194
5195proc diffcontextchange {n1 n2 op} {
5196 global diffcontextstring diffcontext
5197
5198 if {[string is integer -strict $diffcontextstring]} {
5199 if {$diffcontextstring > 0} {
5200 set diffcontext $diffcontextstring
5201 reselectline
5202 }
5203 }
5204}
5205
5206proc getblobdiffs {ids} {
5207 global diffopts blobdifffd diffids env
5208 global diffinhdr treediffs
5209 global diffcontext
5210
5211 set env(GIT_DIFF_OPTS) $diffopts
5212 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5213 puts "error getting diffs: $err"
5214 return
5215 }
5216 set diffinhdr 0
5217 fconfigure $bdf -blocking 0
5218 set blobdifffd($ids) $bdf
5219 filerun $bdf [list getblobdiffline $bdf $diffids]
5220}
5221
5222proc setinlist {var i val} {
5223 global $var
5224
5225 while {[llength [set $var]] < $i} {
5226 lappend $var {}
5227 }
5228 if {[llength [set $var]] == $i} {
5229 lappend $var $val
5230 } else {
5231 lset $var $i $val
5232 }
5233}
5234
5235proc makediffhdr {fname ids} {
5236 global ctext curdiffstart treediffs
5237
5238 set i [lsearch -exact $treediffs($ids) $fname]
5239 if {$i >= 0} {
5240 setinlist difffilestart $i $curdiffstart
5241 }
5242 set l [expr {(78 - [string length $fname]) / 2}]
5243 set pad [string range "----------------------------------------" 1 $l]
5244 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5245}
5246
5247proc getblobdiffline {bdf ids} {
5248 global diffids blobdifffd ctext curdiffstart
5249 global diffnexthead diffnextnote difffilestart
5250 global diffinhdr treediffs
5251
5252 set nr 0
5253 $ctext conf -state normal
5254 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5255 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5256 close $bdf
5257 return 0
5258 }
5259 if {![string compare -length 11 "diff --git " $line]} {
5260 # trim off "diff --git "
5261 set line [string range $line 11 end]
5262 set diffinhdr 1
5263 # start of a new file
5264 $ctext insert end "\n"
5265 set curdiffstart [$ctext index "end - 1c"]
5266 $ctext insert end "\n" filesep
5267 # If the name hasn't changed the length will be odd,
5268 # the middle char will be a space, and the two bits either
5269 # side will be a/name and b/name, or "a/name" and "b/name".
5270 # If the name has changed we'll get "rename from" and
5271 # "rename to" or "copy from" and "copy to" lines following this,
5272 # and we'll use them to get the filenames.
5273 # This complexity is necessary because spaces in the filename(s)
5274 # don't get escaped.
5275 set l [string length $line]
5276 set i [expr {$l / 2}]
5277 if {!(($l & 1) && [string index $line $i] eq " " &&
5278 [string range $line 2 [expr {$i - 1}]] eq \
5279 [string range $line [expr {$i + 3}] end])} {
5280 continue
5281 }
5282 # unescape if quoted and chop off the a/ from the front
5283 if {[string index $line 0] eq "\""} {
5284 set fname [string range [lindex $line 0] 2 end]
5285 } else {
5286 set fname [string range $line 2 [expr {$i - 1}]]
5287 }
5288 makediffhdr $fname $ids
5289
5290 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5291 $line match f1l f1c f2l f2c rest]} {
5292 $ctext insert end "$line\n" hunksep
5293 set diffinhdr 0
5294
5295 } elseif {$diffinhdr} {
5296 if {![string compare -length 12 "rename from " $line] ||
5297 ![string compare -length 10 "copy from " $line]} {
5298 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5299 if {[string index $fname 0] eq "\""} {
5300 set fname [lindex $fname 0]
5301 }
5302 set i [lsearch -exact $treediffs($ids) $fname]
5303 if {$i >= 0} {
5304 setinlist difffilestart $i $curdiffstart
5305 }
5306 } elseif {![string compare -length 10 $line "rename to "] ||
5307 ![string compare -length 8 $line "copy to "]} {
5308 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5309 if {[string index $fname 0] eq "\""} {
5310 set fname [lindex $fname 0]
5311 }
5312 makediffhdr $fname $ids
5313 } elseif {[string compare -length 3 $line "---"] == 0} {
5314 # do nothing
5315 continue
5316 } elseif {[string compare -length 3 $line "+++"] == 0} {
5317 set diffinhdr 0
5318 continue
5319 }
5320 $ctext insert end "$line\n" filesep
5321
5322 } else {
5323 set x [string range $line 0 0]
5324 if {$x == "-" || $x == "+"} {
5325 set tag [expr {$x == "+"}]
5326 $ctext insert end "$line\n" d$tag
5327 } elseif {$x == " "} {
5328 $ctext insert end "$line\n"
5329 } else {
5330 # "\ No newline at end of file",
5331 # or something else we don't recognize
5332 $ctext insert end "$line\n" hunksep
5333 }
5334 }
5335 }
5336 $ctext conf -state disabled
5337 if {[eof $bdf]} {
5338 close $bdf
5339 return 0
5340 }
5341 return [expr {$nr >= 1000? 2: 1}]
5342}
5343
5344proc changediffdisp {} {
5345 global ctext diffelide
5346
5347 $ctext tag conf d0 -elide [lindex $diffelide 0]
5348 $ctext tag conf d1 -elide [lindex $diffelide 1]
5349}
5350
5351proc prevfile {} {
5352 global difffilestart ctext
5353 set prev [lindex $difffilestart 0]
5354 set here [$ctext index @0,0]
5355 foreach loc $difffilestart {
5356 if {[$ctext compare $loc >= $here]} {
5357 $ctext yview $prev
5358 return
5359 }
5360 set prev $loc
5361 }
5362 $ctext yview $prev
5363}
5364
5365proc nextfile {} {
5366 global difffilestart ctext
5367 set here [$ctext index @0,0]
5368 foreach loc $difffilestart {
5369 if {[$ctext compare $loc > $here]} {
5370 $ctext yview $loc
5371 return
5372 }
5373 }
5374}
5375
5376proc clear_ctext {{first 1.0}} {
5377 global ctext smarktop smarkbot
5378 global pendinglinks
5379
5380 set l [lindex [split $first .] 0]
5381 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5382 set smarktop $l
5383 }
5384 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5385 set smarkbot $l
5386 }
5387 $ctext delete $first end
5388 if {$first eq "1.0"} {
5389 catch {unset pendinglinks}
5390 }
5391}
5392
5393proc incrsearch {name ix op} {
5394 global ctext searchstring searchdirn
5395
5396 $ctext tag remove found 1.0 end
5397 if {[catch {$ctext index anchor}]} {
5398 # no anchor set, use start of selection, or of visible area
5399 set sel [$ctext tag ranges sel]
5400 if {$sel ne {}} {
5401 $ctext mark set anchor [lindex $sel 0]
5402 } elseif {$searchdirn eq "-forwards"} {
5403 $ctext mark set anchor @0,0
5404 } else {
5405 $ctext mark set anchor @0,[winfo height $ctext]
5406 }
5407 }
5408 if {$searchstring ne {}} {
5409 set here [$ctext search $searchdirn -- $searchstring anchor]
5410 if {$here ne {}} {
5411 $ctext see $here
5412 }
5413 searchmarkvisible 1
5414 }
5415}
5416
5417proc dosearch {} {
5418 global sstring ctext searchstring searchdirn
5419
5420 focus $sstring
5421 $sstring icursor end
5422 set searchdirn -forwards
5423 if {$searchstring ne {}} {
5424 set sel [$ctext tag ranges sel]
5425 if {$sel ne {}} {
5426 set start "[lindex $sel 0] + 1c"
5427 } elseif {[catch {set start [$ctext index anchor]}]} {
5428 set start "@0,0"
5429 }
5430 set match [$ctext search -count mlen -- $searchstring $start]
5431 $ctext tag remove sel 1.0 end
5432 if {$match eq {}} {
5433 bell
5434 return
5435 }
5436 $ctext see $match
5437 set mend "$match + $mlen c"
5438 $ctext tag add sel $match $mend
5439 $ctext mark unset anchor
5440 }
5441}
5442
5443proc dosearchback {} {
5444 global sstring ctext searchstring searchdirn
5445
5446 focus $sstring
5447 $sstring icursor end
5448 set searchdirn -backwards
5449 if {$searchstring ne {}} {
5450 set sel [$ctext tag ranges sel]
5451 if {$sel ne {}} {
5452 set start [lindex $sel 0]
5453 } elseif {[catch {set start [$ctext index anchor]}]} {
5454 set start @0,[winfo height $ctext]
5455 }
5456 set match [$ctext search -backwards -count ml -- $searchstring $start]
5457 $ctext tag remove sel 1.0 end
5458 if {$match eq {}} {
5459 bell
5460 return
5461 }
5462 $ctext see $match
5463 set mend "$match + $ml c"
5464 $ctext tag add sel $match $mend
5465 $ctext mark unset anchor
5466 }
5467}
5468
5469proc searchmark {first last} {
5470 global ctext searchstring
5471
5472 set mend $first.0
5473 while {1} {
5474 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5475 if {$match eq {}} break
5476 set mend "$match + $mlen c"
5477 $ctext tag add found $match $mend
5478 }
5479}
5480
5481proc searchmarkvisible {doall} {
5482 global ctext smarktop smarkbot
5483
5484 set topline [lindex [split [$ctext index @0,0] .] 0]
5485 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5486 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5487 # no overlap with previous
5488 searchmark $topline $botline
5489 set smarktop $topline
5490 set smarkbot $botline
5491 } else {
5492 if {$topline < $smarktop} {
5493 searchmark $topline [expr {$smarktop-1}]
5494 set smarktop $topline
5495 }
5496 if {$botline > $smarkbot} {
5497 searchmark [expr {$smarkbot+1}] $botline
5498 set smarkbot $botline
5499 }
5500 }
5501}
5502
5503proc scrolltext {f0 f1} {
5504 global searchstring
5505
5506 .bleft.sb set $f0 $f1
5507 if {$searchstring ne {}} {
5508 searchmarkvisible 0
5509 }
5510}
5511
5512proc setcoords {} {
5513 global linespc charspc canvx0 canvy0 mainfont
5514 global xspc1 xspc2 lthickness
5515
5516 set linespc [font metrics $mainfont -linespace]
5517 set charspc [font measure $mainfont "m"]
5518 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5519 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5520 set lthickness [expr {int($linespc / 9) + 1}]
5521 set xspc1(0) $linespc
5522 set xspc2 $linespc
5523}
5524
5525proc redisplay {} {
5526 global canv
5527 global selectedline
5528
5529 set ymax [lindex [$canv cget -scrollregion] 3]
5530 if {$ymax eq {} || $ymax == 0} return
5531 set span [$canv yview]
5532 clear_display
5533 setcanvscroll
5534 allcanvs yview moveto [lindex $span 0]
5535 drawvisible
5536 if {[info exists selectedline]} {
5537 selectline $selectedline 0
5538 allcanvs yview moveto [lindex $span 0]
5539 }
5540}
5541
5542proc incrfont {inc} {
5543 global mainfont textfont ctext canv phase cflist showrefstop
5544 global charspc tabstop
5545 global stopped entries
5546 unmarkmatches
5547 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5548 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5549 setcoords
5550 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5551 $cflist conf -font $textfont
5552 $ctext tag conf filesep -font [concat $textfont bold]
5553 foreach e $entries {
5554 $e conf -font $mainfont
5555 }
5556 if {$phase eq "getcommits"} {
5557 $canv itemconf textitems -font $mainfont
5558 }
5559 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5560 $showrefstop.list conf -font $mainfont
5561 }
5562 redisplay
5563}
5564
5565proc clearsha1 {} {
5566 global sha1entry sha1string
5567 if {[string length $sha1string] == 40} {
5568 $sha1entry delete 0 end
5569 }
5570}
5571
5572proc sha1change {n1 n2 op} {
5573 global sha1string currentid sha1but
5574 if {$sha1string == {}
5575 || ([info exists currentid] && $sha1string == $currentid)} {
5576 set state disabled
5577 } else {
5578 set state normal
5579 }
5580 if {[$sha1but cget -state] == $state} return
5581 if {$state == "normal"} {
5582 $sha1but conf -state normal -relief raised -text "Goto: "
5583 } else {
5584 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5585 }
5586}
5587
5588proc gotocommit {} {
5589 global sha1string currentid commitrow tagids headids
5590 global displayorder numcommits curview
5591
5592 if {$sha1string == {}
5593 || ([info exists currentid] && $sha1string == $currentid)} return
5594 if {[info exists tagids($sha1string)]} {
5595 set id $tagids($sha1string)
5596 } elseif {[info exists headids($sha1string)]} {
5597 set id $headids($sha1string)
5598 } else {
5599 set id [string tolower $sha1string]
5600 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5601 set matches {}
5602 foreach i $displayorder {
5603 if {[string match $id* $i]} {
5604 lappend matches $i
5605 }
5606 }
5607 if {$matches ne {}} {
5608 if {[llength $matches] > 1} {
5609 error_popup "Short SHA1 id $id is ambiguous"
5610 return
5611 }
5612 set id [lindex $matches 0]
5613 }
5614 }
5615 }
5616 if {[info exists commitrow($curview,$id)]} {
5617 selectline $commitrow($curview,$id) 1
5618 return
5619 }
5620 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5621 set type "SHA1 id"
5622 } else {
5623 set type "Tag/Head"
5624 }
5625 error_popup "$type $sha1string is not known"
5626}
5627
5628proc lineenter {x y id} {
5629 global hoverx hovery hoverid hovertimer
5630 global commitinfo canv
5631
5632 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5633 set hoverx $x
5634 set hovery $y
5635 set hoverid $id
5636 if {[info exists hovertimer]} {
5637 after cancel $hovertimer
5638 }
5639 set hovertimer [after 500 linehover]
5640 $canv delete hover
5641}
5642
5643proc linemotion {x y id} {
5644 global hoverx hovery hoverid hovertimer
5645
5646 if {[info exists hoverid] && $id == $hoverid} {
5647 set hoverx $x
5648 set hovery $y
5649 if {[info exists hovertimer]} {
5650 after cancel $hovertimer
5651 }
5652 set hovertimer [after 500 linehover]
5653 }
5654}
5655
5656proc lineleave {id} {
5657 global hoverid hovertimer canv
5658
5659 if {[info exists hoverid] && $id == $hoverid} {
5660 $canv delete hover
5661 if {[info exists hovertimer]} {
5662 after cancel $hovertimer
5663 unset hovertimer
5664 }
5665 unset hoverid
5666 }
5667}
5668
5669proc linehover {} {
5670 global hoverx hovery hoverid hovertimer
5671 global canv linespc lthickness
5672 global commitinfo mainfont
5673
5674 set text [lindex $commitinfo($hoverid) 0]
5675 set ymax [lindex [$canv cget -scrollregion] 3]
5676 if {$ymax == {}} return
5677 set yfrac [lindex [$canv yview] 0]
5678 set x [expr {$hoverx + 2 * $linespc}]
5679 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5680 set x0 [expr {$x - 2 * $lthickness}]
5681 set y0 [expr {$y - 2 * $lthickness}]
5682 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5683 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5684 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5685 -fill \#ffff80 -outline black -width 1 -tags hover]
5686 $canv raise $t
5687 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5688 -font $mainfont]
5689 $canv raise $t
5690}
5691
5692proc clickisonarrow {id y} {
5693 global lthickness
5694
5695 set ranges [rowranges $id]
5696 set thresh [expr {2 * $lthickness + 6}]
5697 set n [expr {[llength $ranges] - 1}]
5698 for {set i 1} {$i < $n} {incr i} {
5699 set row [lindex $ranges $i]
5700 if {abs([yc $row] - $y) < $thresh} {
5701 return $i
5702 }
5703 }
5704 return {}
5705}
5706
5707proc arrowjump {id n y} {
5708 global canv
5709
5710 # 1 <-> 2, 3 <-> 4, etc...
5711 set n [expr {(($n - 1) ^ 1) + 1}]
5712 set row [lindex [rowranges $id] $n]
5713 set yt [yc $row]
5714 set ymax [lindex [$canv cget -scrollregion] 3]
5715 if {$ymax eq {} || $ymax <= 0} return
5716 set view [$canv yview]
5717 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5718 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5719 if {$yfrac < 0} {
5720 set yfrac 0
5721 }
5722 allcanvs yview moveto $yfrac
5723}
5724
5725proc lineclick {x y id isnew} {
5726 global ctext commitinfo children canv thickerline curview commitrow
5727
5728 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5729 unmarkmatches
5730 unselectline
5731 normalline
5732 $canv delete hover
5733 # draw this line thicker than normal
5734 set thickerline $id
5735 drawlines $id
5736 if {$isnew} {
5737 set ymax [lindex [$canv cget -scrollregion] 3]
5738 if {$ymax eq {}} return
5739 set yfrac [lindex [$canv yview] 0]
5740 set y [expr {$y + $yfrac * $ymax}]
5741 }
5742 set dirn [clickisonarrow $id $y]
5743 if {$dirn ne {}} {
5744 arrowjump $id $dirn $y
5745 return
5746 }
5747
5748 if {$isnew} {
5749 addtohistory [list lineclick $x $y $id 0]
5750 }
5751 # fill the details pane with info about this line
5752 $ctext conf -state normal
5753 clear_ctext
5754 $ctext insert end "Parent:\t"
5755 $ctext insert end $id link0
5756 setlink $id link0
5757 set info $commitinfo($id)
5758 $ctext insert end "\n\t[lindex $info 0]\n"
5759 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5760 set date [formatdate [lindex $info 2]]
5761 $ctext insert end "\tDate:\t$date\n"
5762 set kids $children($curview,$id)
5763 if {$kids ne {}} {
5764 $ctext insert end "\nChildren:"
5765 set i 0
5766 foreach child $kids {
5767 incr i
5768 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5769 set info $commitinfo($child)
5770 $ctext insert end "\n\t"
5771 $ctext insert end $child link$i
5772 setlink $child link$i
5773 $ctext insert end "\n\t[lindex $info 0]"
5774 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5775 set date [formatdate [lindex $info 2]]
5776 $ctext insert end "\n\tDate:\t$date\n"
5777 }
5778 }
5779 $ctext conf -state disabled
5780 init_flist {}
5781}
5782
5783proc normalline {} {
5784 global thickerline
5785 if {[info exists thickerline]} {
5786 set id $thickerline
5787 unset thickerline
5788 drawlines $id
5789 }
5790}
5791
5792proc selbyid {id} {
5793 global commitrow curview
5794 if {[info exists commitrow($curview,$id)]} {
5795 selectline $commitrow($curview,$id) 1
5796 }
5797}
5798
5799proc mstime {} {
5800 global startmstime
5801 if {![info exists startmstime]} {
5802 set startmstime [clock clicks -milliseconds]
5803 }
5804 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5805}
5806
5807proc rowmenu {x y id} {
5808 global rowctxmenu commitrow selectedline rowmenuid curview
5809 global nullid nullid2 fakerowmenu mainhead
5810
5811 set rowmenuid $id
5812 if {![info exists selectedline]
5813 || $commitrow($curview,$id) eq $selectedline} {
5814 set state disabled
5815 } else {
5816 set state normal
5817 }
5818 if {$id ne $nullid && $id ne $nullid2} {
5819 set menu $rowctxmenu
5820 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5821 } else {
5822 set menu $fakerowmenu
5823 }
5824 $menu entryconfigure "Diff this*" -state $state
5825 $menu entryconfigure "Diff selected*" -state $state
5826 $menu entryconfigure "Make patch" -state $state
5827 tk_popup $menu $x $y
5828}
5829
5830proc diffvssel {dirn} {
5831 global rowmenuid selectedline displayorder
5832
5833 if {![info exists selectedline]} return
5834 if {$dirn} {
5835 set oldid [lindex $displayorder $selectedline]
5836 set newid $rowmenuid
5837 } else {
5838 set oldid $rowmenuid
5839 set newid [lindex $displayorder $selectedline]
5840 }
5841 addtohistory [list doseldiff $oldid $newid]
5842 doseldiff $oldid $newid
5843}
5844
5845proc doseldiff {oldid newid} {
5846 global ctext
5847 global commitinfo
5848
5849 $ctext conf -state normal
5850 clear_ctext
5851 init_flist "Top"
5852 $ctext insert end "From "
5853 $ctext insert end $oldid link0
5854 setlink $oldid link0
5855 $ctext insert end "\n "
5856 $ctext insert end [lindex $commitinfo($oldid) 0]
5857 $ctext insert end "\n\nTo "
5858 $ctext insert end $newid link1
5859 setlink $newid link1
5860 $ctext insert end "\n "
5861 $ctext insert end [lindex $commitinfo($newid) 0]
5862 $ctext insert end "\n"
5863 $ctext conf -state disabled
5864 $ctext tag remove found 1.0 end
5865 startdiff [list $oldid $newid]
5866}
5867
5868proc mkpatch {} {
5869 global rowmenuid currentid commitinfo patchtop patchnum
5870
5871 if {![info exists currentid]} return
5872 set oldid $currentid
5873 set oldhead [lindex $commitinfo($oldid) 0]
5874 set newid $rowmenuid
5875 set newhead [lindex $commitinfo($newid) 0]
5876 set top .patch
5877 set patchtop $top
5878 catch {destroy $top}
5879 toplevel $top
5880 label $top.title -text "Generate patch"
5881 grid $top.title - -pady 10
5882 label $top.from -text "From:"
5883 entry $top.fromsha1 -width 40 -relief flat
5884 $top.fromsha1 insert 0 $oldid
5885 $top.fromsha1 conf -state readonly
5886 grid $top.from $top.fromsha1 -sticky w
5887 entry $top.fromhead -width 60 -relief flat
5888 $top.fromhead insert 0 $oldhead
5889 $top.fromhead conf -state readonly
5890 grid x $top.fromhead -sticky w
5891 label $top.to -text "To:"
5892 entry $top.tosha1 -width 40 -relief flat
5893 $top.tosha1 insert 0 $newid
5894 $top.tosha1 conf -state readonly
5895 grid $top.to $top.tosha1 -sticky w
5896 entry $top.tohead -width 60 -relief flat
5897 $top.tohead insert 0 $newhead
5898 $top.tohead conf -state readonly
5899 grid x $top.tohead -sticky w
5900 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5901 grid $top.rev x -pady 10
5902 label $top.flab -text "Output file:"
5903 entry $top.fname -width 60
5904 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5905 incr patchnum
5906 grid $top.flab $top.fname -sticky w
5907 frame $top.buts
5908 button $top.buts.gen -text "Generate" -command mkpatchgo
5909 button $top.buts.can -text "Cancel" -command mkpatchcan
5910 grid $top.buts.gen $top.buts.can
5911 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5912 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5913 grid $top.buts - -pady 10 -sticky ew
5914 focus $top.fname
5915}
5916
5917proc mkpatchrev {} {
5918 global patchtop
5919
5920 set oldid [$patchtop.fromsha1 get]
5921 set oldhead [$patchtop.fromhead get]
5922 set newid [$patchtop.tosha1 get]
5923 set newhead [$patchtop.tohead get]
5924 foreach e [list fromsha1 fromhead tosha1 tohead] \
5925 v [list $newid $newhead $oldid $oldhead] {
5926 $patchtop.$e conf -state normal
5927 $patchtop.$e delete 0 end
5928 $patchtop.$e insert 0 $v
5929 $patchtop.$e conf -state readonly
5930 }
5931}
5932
5933proc mkpatchgo {} {
5934 global patchtop nullid nullid2
5935
5936 set oldid [$patchtop.fromsha1 get]
5937 set newid [$patchtop.tosha1 get]
5938 set fname [$patchtop.fname get]
5939 set cmd [diffcmd [list $oldid $newid] -p]
5940 # trim off the initial "|"
5941 set cmd [lrange $cmd 1 end]
5942 lappend cmd >$fname &
5943 if {[catch {eval exec $cmd} err]} {
5944 error_popup "Error creating patch: $err"
5945 }
5946 catch {destroy $patchtop}
5947 unset patchtop
5948}
5949
5950proc mkpatchcan {} {
5951 global patchtop
5952
5953 catch {destroy $patchtop}
5954 unset patchtop
5955}
5956
5957proc mktag {} {
5958 global rowmenuid mktagtop commitinfo
5959
5960 set top .maketag
5961 set mktagtop $top
5962 catch {destroy $top}
5963 toplevel $top
5964 label $top.title -text "Create tag"
5965 grid $top.title - -pady 10
5966 label $top.id -text "ID:"
5967 entry $top.sha1 -width 40 -relief flat
5968 $top.sha1 insert 0 $rowmenuid
5969 $top.sha1 conf -state readonly
5970 grid $top.id $top.sha1 -sticky w
5971 entry $top.head -width 60 -relief flat
5972 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5973 $top.head conf -state readonly
5974 grid x $top.head -sticky w
5975 label $top.tlab -text "Tag name:"
5976 entry $top.tag -width 60
5977 grid $top.tlab $top.tag -sticky w
5978 frame $top.buts
5979 button $top.buts.gen -text "Create" -command mktaggo
5980 button $top.buts.can -text "Cancel" -command mktagcan
5981 grid $top.buts.gen $top.buts.can
5982 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5983 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5984 grid $top.buts - -pady 10 -sticky ew
5985 focus $top.tag
5986}
5987
5988proc domktag {} {
5989 global mktagtop env tagids idtags
5990
5991 set id [$mktagtop.sha1 get]
5992 set tag [$mktagtop.tag get]
5993 if {$tag == {}} {
5994 error_popup "No tag name specified"
5995 return
5996 }
5997 if {[info exists tagids($tag)]} {
5998 error_popup "Tag \"$tag\" already exists"
5999 return
6000 }
6001 if {[catch {
6002 set dir [gitdir]
6003 set fname [file join $dir "refs/tags" $tag]
6004 set f [open $fname w]
6005 puts $f $id
6006 close $f
6007 } err]} {
6008 error_popup "Error creating tag: $err"
6009 return
6010 }
6011
6012 set tagids($tag) $id
6013 lappend idtags($id) $tag
6014 redrawtags $id
6015 addedtag $id
6016 dispneartags 0
6017 run refill_reflist
6018}
6019
6020proc redrawtags {id} {
6021 global canv linehtag commitrow idpos selectedline curview
6022 global mainfont canvxmax iddrawn
6023
6024 if {![info exists commitrow($curview,$id)]} return
6025 if {![info exists iddrawn($id)]} return
6026 drawcommits $commitrow($curview,$id)
6027 $canv delete tag.$id
6028 set xt [eval drawtags $id $idpos($id)]
6029 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6030 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6031 set xr [expr {$xt + [font measure $mainfont $text]}]
6032 if {$xr > $canvxmax} {
6033 set canvxmax $xr
6034 setcanvscroll
6035 }
6036 if {[info exists selectedline]
6037 && $selectedline == $commitrow($curview,$id)} {
6038 selectline $selectedline 0
6039 }
6040}
6041
6042proc mktagcan {} {
6043 global mktagtop
6044
6045 catch {destroy $mktagtop}
6046 unset mktagtop
6047}
6048
6049proc mktaggo {} {
6050 domktag
6051 mktagcan
6052}
6053
6054proc writecommit {} {
6055 global rowmenuid wrcomtop commitinfo wrcomcmd
6056
6057 set top .writecommit
6058 set wrcomtop $top
6059 catch {destroy $top}
6060 toplevel $top
6061 label $top.title -text "Write commit to file"
6062 grid $top.title - -pady 10
6063 label $top.id -text "ID:"
6064 entry $top.sha1 -width 40 -relief flat
6065 $top.sha1 insert 0 $rowmenuid
6066 $top.sha1 conf -state readonly
6067 grid $top.id $top.sha1 -sticky w
6068 entry $top.head -width 60 -relief flat
6069 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6070 $top.head conf -state readonly
6071 grid x $top.head -sticky w
6072 label $top.clab -text "Command:"
6073 entry $top.cmd -width 60 -textvariable wrcomcmd
6074 grid $top.clab $top.cmd -sticky w -pady 10
6075 label $top.flab -text "Output file:"
6076 entry $top.fname -width 60
6077 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6078 grid $top.flab $top.fname -sticky w
6079 frame $top.buts
6080 button $top.buts.gen -text "Write" -command wrcomgo
6081 button $top.buts.can -text "Cancel" -command wrcomcan
6082 grid $top.buts.gen $top.buts.can
6083 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6084 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6085 grid $top.buts - -pady 10 -sticky ew
6086 focus $top.fname
6087}
6088
6089proc wrcomgo {} {
6090 global wrcomtop
6091
6092 set id [$wrcomtop.sha1 get]
6093 set cmd "echo $id | [$wrcomtop.cmd get]"
6094 set fname [$wrcomtop.fname get]
6095 if {[catch {exec sh -c $cmd >$fname &} err]} {
6096 error_popup "Error writing commit: $err"
6097 }
6098 catch {destroy $wrcomtop}
6099 unset wrcomtop
6100}
6101
6102proc wrcomcan {} {
6103 global wrcomtop
6104
6105 catch {destroy $wrcomtop}
6106 unset wrcomtop
6107}
6108
6109proc mkbranch {} {
6110 global rowmenuid mkbrtop
6111
6112 set top .makebranch
6113 catch {destroy $top}
6114 toplevel $top
6115 label $top.title -text "Create new branch"
6116 grid $top.title - -pady 10
6117 label $top.id -text "ID:"
6118 entry $top.sha1 -width 40 -relief flat
6119 $top.sha1 insert 0 $rowmenuid
6120 $top.sha1 conf -state readonly
6121 grid $top.id $top.sha1 -sticky w
6122 label $top.nlab -text "Name:"
6123 entry $top.name -width 40
6124 grid $top.nlab $top.name -sticky w
6125 frame $top.buts
6126 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6127 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6128 grid $top.buts.go $top.buts.can
6129 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6130 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6131 grid $top.buts - -pady 10 -sticky ew
6132 focus $top.name
6133}
6134
6135proc mkbrgo {top} {
6136 global headids idheads
6137
6138 set name [$top.name get]
6139 set id [$top.sha1 get]
6140 if {$name eq {}} {
6141 error_popup "Please specify a name for the new branch"
6142 return
6143 }
6144 catch {destroy $top}
6145 nowbusy newbranch
6146 update
6147 if {[catch {
6148 exec git branch $name $id
6149 } err]} {
6150 notbusy newbranch
6151 error_popup $err
6152 } else {
6153 set headids($name) $id
6154 lappend idheads($id) $name
6155 addedhead $id $name
6156 notbusy newbranch
6157 redrawtags $id
6158 dispneartags 0
6159 run refill_reflist
6160 }
6161}
6162
6163proc cherrypick {} {
6164 global rowmenuid curview commitrow
6165 global mainhead
6166
6167 set oldhead [exec git rev-parse HEAD]
6168 set dheads [descheads $rowmenuid]
6169 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6170 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6171 included in branch $mainhead -- really re-apply it?"]
6172 if {!$ok} return
6173 }
6174 nowbusy cherrypick
6175 update
6176 # Unfortunately git-cherry-pick writes stuff to stderr even when
6177 # no error occurs, and exec takes that as an indication of error...
6178 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6179 notbusy cherrypick
6180 error_popup $err
6181 return
6182 }
6183 set newhead [exec git rev-parse HEAD]
6184 if {$newhead eq $oldhead} {
6185 notbusy cherrypick
6186 error_popup "No changes committed"
6187 return
6188 }
6189 addnewchild $newhead $oldhead
6190 if {[info exists commitrow($curview,$oldhead)]} {
6191 insertrow $commitrow($curview,$oldhead) $newhead
6192 if {$mainhead ne {}} {
6193 movehead $newhead $mainhead
6194 movedhead $newhead $mainhead
6195 }
6196 redrawtags $oldhead
6197 redrawtags $newhead
6198 }
6199 notbusy cherrypick
6200}
6201
6202proc resethead {} {
6203 global mainheadid mainhead rowmenuid confirm_ok resettype
6204
6205 set confirm_ok 0
6206 set w ".confirmreset"
6207 toplevel $w
6208 wm transient $w .
6209 wm title $w "Confirm reset"
6210 message $w.m -text \
6211 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6212 -justify center -aspect 1000
6213 pack $w.m -side top -fill x -padx 20 -pady 20
6214 frame $w.f -relief sunken -border 2
6215 message $w.f.rt -text "Reset type:" -aspect 1000
6216 grid $w.f.rt -sticky w
6217 set resettype mixed
6218 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6219 -text "Soft: Leave working tree and index untouched"
6220 grid $w.f.soft -sticky w
6221 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6222 -text "Mixed: Leave working tree untouched, reset index"
6223 grid $w.f.mixed -sticky w
6224 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6225 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6226 grid $w.f.hard -sticky w
6227 pack $w.f -side top -fill x
6228 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6229 pack $w.ok -side left -fill x -padx 20 -pady 20
6230 button $w.cancel -text Cancel -command "destroy $w"
6231 pack $w.cancel -side right -fill x -padx 20 -pady 20
6232 bind $w <Visibility> "grab $w; focus $w"
6233 tkwait window $w
6234 if {!$confirm_ok} return
6235 if {[catch {set fd [open \
6236 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6237 error_popup $err
6238 } else {
6239 dohidelocalchanges
6240 set w ".resetprogress"
6241 filerun $fd [list readresetstat $fd $w]
6242 toplevel $w
6243 wm transient $w
6244 wm title $w "Reset progress"
6245 message $w.m -text "Reset in progress, please wait..." \
6246 -justify center -aspect 1000
6247 pack $w.m -side top -fill x -padx 20 -pady 5
6248 canvas $w.c -width 150 -height 20 -bg white
6249 $w.c create rect 0 0 0 20 -fill green -tags rect
6250 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6251 nowbusy reset
6252 }
6253}
6254
6255proc readresetstat {fd w} {
6256 global mainhead mainheadid showlocalchanges
6257
6258 if {[gets $fd line] >= 0} {
6259 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6260 set x [expr {($m * 150) / $n}]
6261 $w.c coords rect 0 0 $x 20
6262 }
6263 return 1
6264 }
6265 destroy $w
6266 notbusy reset
6267 if {[catch {close $fd} err]} {
6268 error_popup $err
6269 }
6270 set oldhead $mainheadid
6271 set newhead [exec git rev-parse HEAD]
6272 if {$newhead ne $oldhead} {
6273 movehead $newhead $mainhead
6274 movedhead $newhead $mainhead
6275 set mainheadid $newhead
6276 redrawtags $oldhead
6277 redrawtags $newhead
6278 }
6279 if {$showlocalchanges} {
6280 doshowlocalchanges
6281 }
6282 return 0
6283}
6284
6285# context menu for a head
6286proc headmenu {x y id head} {
6287 global headmenuid headmenuhead headctxmenu mainhead
6288
6289 set headmenuid $id
6290 set headmenuhead $head
6291 set state normal
6292 if {$head eq $mainhead} {
6293 set state disabled
6294 }
6295 $headctxmenu entryconfigure 0 -state $state
6296 $headctxmenu entryconfigure 1 -state $state
6297 tk_popup $headctxmenu $x $y
6298}
6299
6300proc cobranch {} {
6301 global headmenuid headmenuhead mainhead headids
6302 global showlocalchanges mainheadid
6303
6304 # check the tree is clean first??
6305 set oldmainhead $mainhead
6306 nowbusy checkout
6307 update
6308 dohidelocalchanges
6309 if {[catch {
6310 exec git checkout -q $headmenuhead
6311 } err]} {
6312 notbusy checkout
6313 error_popup $err
6314 } else {
6315 notbusy checkout
6316 set mainhead $headmenuhead
6317 set mainheadid $headmenuid
6318 if {[info exists headids($oldmainhead)]} {
6319 redrawtags $headids($oldmainhead)
6320 }
6321 redrawtags $headmenuid
6322 }
6323 if {$showlocalchanges} {
6324 dodiffindex
6325 }
6326}
6327
6328proc rmbranch {} {
6329 global headmenuid headmenuhead mainhead
6330 global idheads
6331
6332 set head $headmenuhead
6333 set id $headmenuid
6334 # this check shouldn't be needed any more...
6335 if {$head eq $mainhead} {
6336 error_popup "Cannot delete the currently checked-out branch"
6337 return
6338 }
6339 set dheads [descheads $id]
6340 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6341 # the stuff on this branch isn't on any other branch
6342 if {![confirm_popup "The commits on branch $head aren't on any other\
6343 branch.\nReally delete branch $head?"]} return
6344 }
6345 nowbusy rmbranch
6346 update
6347 if {[catch {exec git branch -D $head} err]} {
6348 notbusy rmbranch
6349 error_popup $err
6350 return
6351 }
6352 removehead $id $head
6353 removedhead $id $head
6354 redrawtags $id
6355 notbusy rmbranch
6356 dispneartags 0
6357 run refill_reflist
6358}
6359
6360# Display a list of tags and heads
6361proc showrefs {} {
6362 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6363 global bglist fglist uifont reflistfilter reflist maincursor
6364
6365 set top .showrefs
6366 set showrefstop $top
6367 if {[winfo exists $top]} {
6368 raise $top
6369 refill_reflist
6370 return
6371 }
6372 toplevel $top
6373 wm title $top "Tags and heads: [file tail [pwd]]"
6374 text $top.list -background $bgcolor -foreground $fgcolor \
6375 -selectbackground $selectbgcolor -font $mainfont \
6376 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6377 -width 30 -height 20 -cursor $maincursor \
6378 -spacing1 1 -spacing3 1 -state disabled
6379 $top.list tag configure highlight -background $selectbgcolor
6380 lappend bglist $top.list
6381 lappend fglist $top.list
6382 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6383 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6384 grid $top.list $top.ysb -sticky nsew
6385 grid $top.xsb x -sticky ew
6386 frame $top.f
6387 label $top.f.l -text "Filter: " -font $uifont
6388 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6389 set reflistfilter "*"
6390 trace add variable reflistfilter write reflistfilter_change
6391 pack $top.f.e -side right -fill x -expand 1
6392 pack $top.f.l -side left
6393 grid $top.f - -sticky ew -pady 2
6394 button $top.close -command [list destroy $top] -text "Close" \
6395 -font $uifont
6396 grid $top.close -
6397 grid columnconfigure $top 0 -weight 1
6398 grid rowconfigure $top 0 -weight 1
6399 bind $top.list <1> {break}
6400 bind $top.list <B1-Motion> {break}
6401 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6402 set reflist {}
6403 refill_reflist
6404}
6405
6406proc sel_reflist {w x y} {
6407 global showrefstop reflist headids tagids otherrefids
6408
6409 if {![winfo exists $showrefstop]} return
6410 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6411 set ref [lindex $reflist [expr {$l-1}]]
6412 set n [lindex $ref 0]
6413 switch -- [lindex $ref 1] {
6414 "H" {selbyid $headids($n)}
6415 "T" {selbyid $tagids($n)}
6416 "o" {selbyid $otherrefids($n)}
6417 }
6418 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6419}
6420
6421proc unsel_reflist {} {
6422 global showrefstop
6423
6424 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6425 $showrefstop.list tag remove highlight 0.0 end
6426}
6427
6428proc reflistfilter_change {n1 n2 op} {
6429 global reflistfilter
6430
6431 after cancel refill_reflist
6432 after 200 refill_reflist
6433}
6434
6435proc refill_reflist {} {
6436 global reflist reflistfilter showrefstop headids tagids otherrefids
6437 global commitrow curview commitinterest
6438
6439 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6440 set refs {}
6441 foreach n [array names headids] {
6442 if {[string match $reflistfilter $n]} {
6443 if {[info exists commitrow($curview,$headids($n))]} {
6444 lappend refs [list $n H]
6445 } else {
6446 set commitinterest($headids($n)) {run refill_reflist}
6447 }
6448 }
6449 }
6450 foreach n [array names tagids] {
6451 if {[string match $reflistfilter $n]} {
6452 if {[info exists commitrow($curview,$tagids($n))]} {
6453 lappend refs [list $n T]
6454 } else {
6455 set commitinterest($tagids($n)) {run refill_reflist}
6456 }
6457 }
6458 }
6459 foreach n [array names otherrefids] {
6460 if {[string match $reflistfilter $n]} {
6461 if {[info exists commitrow($curview,$otherrefids($n))]} {
6462 lappend refs [list $n o]
6463 } else {
6464 set commitinterest($otherrefids($n)) {run refill_reflist}
6465 }
6466 }
6467 }
6468 set refs [lsort -index 0 $refs]
6469 if {$refs eq $reflist} return
6470
6471 # Update the contents of $showrefstop.list according to the
6472 # differences between $reflist (old) and $refs (new)
6473 $showrefstop.list conf -state normal
6474 $showrefstop.list insert end "\n"
6475 set i 0
6476 set j 0
6477 while {$i < [llength $reflist] || $j < [llength $refs]} {
6478 if {$i < [llength $reflist]} {
6479 if {$j < [llength $refs]} {
6480 set cmp [string compare [lindex $reflist $i 0] \
6481 [lindex $refs $j 0]]
6482 if {$cmp == 0} {
6483 set cmp [string compare [lindex $reflist $i 1] \
6484 [lindex $refs $j 1]]
6485 }
6486 } else {
6487 set cmp -1
6488 }
6489 } else {
6490 set cmp 1
6491 }
6492 switch -- $cmp {
6493 -1 {
6494 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6495 incr i
6496 }
6497 0 {
6498 incr i
6499 incr j
6500 }
6501 1 {
6502 set l [expr {$j + 1}]
6503 $showrefstop.list image create $l.0 -align baseline \
6504 -image reficon-[lindex $refs $j 1] -padx 2
6505 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6506 incr j
6507 }
6508 }
6509 }
6510 set reflist $refs
6511 # delete last newline
6512 $showrefstop.list delete end-2c end-1c
6513 $showrefstop.list conf -state disabled
6514}
6515
6516# Stuff for finding nearby tags
6517proc getallcommits {} {
6518 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6519 global idheads idtags idotherrefs allparents tagobjid
6520
6521 if {![info exists allcommits]} {
6522 set nextarc 0
6523 set allcommits 0
6524 set seeds {}
6525 set allcwait 0
6526 set cachedarcs 0
6527 set allccache [file join [gitdir] "gitk.cache"]
6528 if {![catch {
6529 set f [open $allccache r]
6530 set allcwait 1
6531 getcache $f
6532 }]} return
6533 }
6534
6535 if {$allcwait} {
6536 return
6537 }
6538 set cmd [list | git rev-list --parents]
6539 set allcupdate [expr {$seeds ne {}}]
6540 if {!$allcupdate} {
6541 set ids "--all"
6542 } else {
6543 set refs [concat [array names idheads] [array names idtags] \
6544 [array names idotherrefs]]
6545 set ids {}
6546 set tagobjs {}
6547 foreach name [array names tagobjid] {
6548 lappend tagobjs $tagobjid($name)
6549 }
6550 foreach id [lsort -unique $refs] {
6551 if {![info exists allparents($id)] &&
6552 [lsearch -exact $tagobjs $id] < 0} {
6553 lappend ids $id
6554 }
6555 }
6556 if {$ids ne {}} {
6557 foreach id $seeds {
6558 lappend ids "^$id"
6559 }
6560 }
6561 }
6562 if {$ids ne {}} {
6563 set fd [open [concat $cmd $ids] r]
6564 fconfigure $fd -blocking 0
6565 incr allcommits
6566 nowbusy allcommits
6567 filerun $fd [list getallclines $fd]
6568 } else {
6569 dispneartags 0
6570 }
6571}
6572
6573# Since most commits have 1 parent and 1 child, we group strings of
6574# such commits into "arcs" joining branch/merge points (BMPs), which
6575# are commits that either don't have 1 parent or don't have 1 child.
6576#
6577# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6578# arcout(id) - outgoing arcs for BMP
6579# arcids(a) - list of IDs on arc including end but not start
6580# arcstart(a) - BMP ID at start of arc
6581# arcend(a) - BMP ID at end of arc
6582# growing(a) - arc a is still growing
6583# arctags(a) - IDs out of arcids (excluding end) that have tags
6584# archeads(a) - IDs out of arcids (excluding end) that have heads
6585# The start of an arc is at the descendent end, so "incoming" means
6586# coming from descendents, and "outgoing" means going towards ancestors.
6587
6588proc getallclines {fd} {
6589 global allparents allchildren idtags idheads nextarc
6590 global arcnos arcids arctags arcout arcend arcstart archeads growing
6591 global seeds allcommits cachedarcs allcupdate
6592
6593 set nid 0
6594 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6595 set id [lindex $line 0]
6596 if {[info exists allparents($id)]} {
6597 # seen it already
6598 continue
6599 }
6600 set cachedarcs 0
6601 set olds [lrange $line 1 end]
6602 set allparents($id) $olds
6603 if {![info exists allchildren($id)]} {
6604 set allchildren($id) {}
6605 set arcnos($id) {}
6606 lappend seeds $id
6607 } else {
6608 set a $arcnos($id)
6609 if {[llength $olds] == 1 && [llength $a] == 1} {
6610 lappend arcids($a) $id
6611 if {[info exists idtags($id)]} {
6612 lappend arctags($a) $id
6613 }
6614 if {[info exists idheads($id)]} {
6615 lappend archeads($a) $id
6616 }
6617 if {[info exists allparents($olds)]} {
6618 # seen parent already
6619 if {![info exists arcout($olds)]} {
6620 splitarc $olds
6621 }
6622 lappend arcids($a) $olds
6623 set arcend($a) $olds
6624 unset growing($a)
6625 }
6626 lappend allchildren($olds) $id
6627 lappend arcnos($olds) $a
6628 continue
6629 }
6630 }
6631 foreach a $arcnos($id) {
6632 lappend arcids($a) $id
6633 set arcend($a) $id
6634 unset growing($a)
6635 }
6636
6637 set ao {}
6638 foreach p $olds {
6639 lappend allchildren($p) $id
6640 set a [incr nextarc]
6641 set arcstart($a) $id
6642 set archeads($a) {}
6643 set arctags($a) {}
6644 set archeads($a) {}
6645 set arcids($a) {}
6646 lappend ao $a
6647 set growing($a) 1
6648 if {[info exists allparents($p)]} {
6649 # seen it already, may need to make a new branch
6650 if {![info exists arcout($p)]} {
6651 splitarc $p
6652 }
6653 lappend arcids($a) $p
6654 set arcend($a) $p
6655 unset growing($a)
6656 }
6657 lappend arcnos($p) $a
6658 }
6659 set arcout($id) $ao
6660 }
6661 if {$nid > 0} {
6662 global cached_dheads cached_dtags cached_atags
6663 catch {unset cached_dheads}
6664 catch {unset cached_dtags}
6665 catch {unset cached_atags}
6666 }
6667 if {![eof $fd]} {
6668 return [expr {$nid >= 1000? 2: 1}]
6669 }
6670 set cacheok 1
6671 if {[catch {
6672 fconfigure $fd -blocking 1
6673 close $fd
6674 } err]} {
6675 # got an error reading the list of commits
6676 # if we were updating, try rereading the whole thing again
6677 if {$allcupdate} {
6678 incr allcommits -1
6679 dropcache $err
6680 return
6681 }
6682 error_popup "Error reading commit topology information;\
6683 branch and preceding/following tag information\
6684 will be incomplete.\n($err)"
6685 set cacheok 0
6686 }
6687 if {[incr allcommits -1] == 0} {
6688 notbusy allcommits
6689 if {$cacheok} {
6690 run savecache
6691 }
6692 }
6693 dispneartags 0
6694 return 0
6695}
6696
6697proc recalcarc {a} {
6698 global arctags archeads arcids idtags idheads
6699
6700 set at {}
6701 set ah {}
6702 foreach id [lrange $arcids($a) 0 end-1] {
6703 if {[info exists idtags($id)]} {
6704 lappend at $id
6705 }
6706 if {[info exists idheads($id)]} {
6707 lappend ah $id
6708 }
6709 }
6710 set arctags($a) $at
6711 set archeads($a) $ah
6712}
6713
6714proc splitarc {p} {
6715 global arcnos arcids nextarc arctags archeads idtags idheads
6716 global arcstart arcend arcout allparents growing
6717
6718 set a $arcnos($p)
6719 if {[llength $a] != 1} {
6720 puts "oops splitarc called but [llength $a] arcs already"
6721 return
6722 }
6723 set a [lindex $a 0]
6724 set i [lsearch -exact $arcids($a) $p]
6725 if {$i < 0} {
6726 puts "oops splitarc $p not in arc $a"
6727 return
6728 }
6729 set na [incr nextarc]
6730 if {[info exists arcend($a)]} {
6731 set arcend($na) $arcend($a)
6732 } else {
6733 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6734 set j [lsearch -exact $arcnos($l) $a]
6735 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6736 }
6737 set tail [lrange $arcids($a) [expr {$i+1}] end]
6738 set arcids($a) [lrange $arcids($a) 0 $i]
6739 set arcend($a) $p
6740 set arcstart($na) $p
6741 set arcout($p) $na
6742 set arcids($na) $tail
6743 if {[info exists growing($a)]} {
6744 set growing($na) 1
6745 unset growing($a)
6746 }
6747
6748 foreach id $tail {
6749 if {[llength $arcnos($id)] == 1} {
6750 set arcnos($id) $na
6751 } else {
6752 set j [lsearch -exact $arcnos($id) $a]
6753 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6754 }
6755 }
6756
6757 # reconstruct tags and heads lists
6758 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6759 recalcarc $a
6760 recalcarc $na
6761 } else {
6762 set arctags($na) {}
6763 set archeads($na) {}
6764 }
6765}
6766
6767# Update things for a new commit added that is a child of one
6768# existing commit. Used when cherry-picking.
6769proc addnewchild {id p} {
6770 global allparents allchildren idtags nextarc
6771 global arcnos arcids arctags arcout arcend arcstart archeads growing
6772 global seeds allcommits
6773
6774 if {![info exists allcommits]} return
6775 set allparents($id) [list $p]
6776 set allchildren($id) {}
6777 set arcnos($id) {}
6778 lappend seeds $id
6779 lappend allchildren($p) $id
6780 set a [incr nextarc]
6781 set arcstart($a) $id
6782 set archeads($a) {}
6783 set arctags($a) {}
6784 set arcids($a) [list $p]
6785 set arcend($a) $p
6786 if {![info exists arcout($p)]} {
6787 splitarc $p
6788 }
6789 lappend arcnos($p) $a
6790 set arcout($id) [list $a]
6791}
6792
6793# This implements a cache for the topology information.
6794# The cache saves, for each arc, the start and end of the arc,
6795# the ids on the arc, and the outgoing arcs from the end.
6796proc readcache {f} {
6797 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6798 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6799 global allcwait
6800
6801 set a $nextarc
6802 set lim $cachedarcs
6803 if {$lim - $a > 500} {
6804 set lim [expr {$a + 500}]
6805 }
6806 if {[catch {
6807 if {$a == $lim} {
6808 # finish reading the cache and setting up arctags, etc.
6809 set line [gets $f]
6810 if {$line ne "1"} {error "bad final version"}
6811 close $f
6812 foreach id [array names idtags] {
6813 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6814 [llength $allparents($id)] == 1} {
6815 set a [lindex $arcnos($id) 0]
6816 if {$arctags($a) eq {}} {
6817 recalcarc $a
6818 }
6819 }
6820 }
6821 foreach id [array names idheads] {
6822 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6823 [llength $allparents($id)] == 1} {
6824 set a [lindex $arcnos($id) 0]
6825 if {$archeads($a) eq {}} {
6826 recalcarc $a
6827 }
6828 }
6829 }
6830 foreach id [lsort -unique $possible_seeds] {
6831 if {$arcnos($id) eq {}} {
6832 lappend seeds $id
6833 }
6834 }
6835 set allcwait 0
6836 } else {
6837 while {[incr a] <= $lim} {
6838 set line [gets $f]
6839 if {[llength $line] != 3} {error "bad line"}
6840 set s [lindex $line 0]
6841 set arcstart($a) $s
6842 lappend arcout($s) $a
6843 if {![info exists arcnos($s)]} {
6844 lappend possible_seeds $s
6845 set arcnos($s) {}
6846 }
6847 set e [lindex $line 1]
6848 if {$e eq {}} {
6849 set growing($a) 1
6850 } else {
6851 set arcend($a) $e
6852 if {![info exists arcout($e)]} {
6853 set arcout($e) {}
6854 }
6855 }
6856 set arcids($a) [lindex $line 2]
6857 foreach id $arcids($a) {
6858 lappend allparents($s) $id
6859 set s $id
6860 lappend arcnos($id) $a
6861 }
6862 if {![info exists allparents($s)]} {
6863 set allparents($s) {}
6864 }
6865 set arctags($a) {}
6866 set archeads($a) {}
6867 }
6868 set nextarc [expr {$a - 1}]
6869 }
6870 } err]} {
6871 dropcache $err
6872 return 0
6873 }
6874 if {!$allcwait} {
6875 getallcommits
6876 }
6877 return $allcwait
6878}
6879
6880proc getcache {f} {
6881 global nextarc cachedarcs possible_seeds
6882
6883 if {[catch {
6884 set line [gets $f]
6885 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
6886 # make sure it's an integer
6887 set cachedarcs [expr {int([lindex $line 1])}]
6888 if {$cachedarcs < 0} {error "bad number of arcs"}
6889 set nextarc 0
6890 set possible_seeds {}
6891 run readcache $f
6892 } err]} {
6893 dropcache $err
6894 }
6895 return 0
6896}
6897
6898proc dropcache {err} {
6899 global allcwait nextarc cachedarcs seeds
6900
6901 #puts "dropping cache ($err)"
6902 foreach v {arcnos arcout arcids arcstart arcend growing \
6903 arctags archeads allparents allchildren} {
6904 global $v
6905 catch {unset $v}
6906 }
6907 set allcwait 0
6908 set nextarc 0
6909 set cachedarcs 0
6910 set seeds {}
6911 getallcommits
6912}
6913
6914proc writecache {f} {
6915 global cachearc cachedarcs allccache
6916 global arcstart arcend arcnos arcids arcout
6917
6918 set a $cachearc
6919 set lim $cachedarcs
6920 if {$lim - $a > 1000} {
6921 set lim [expr {$a + 1000}]
6922 }
6923 if {[catch {
6924 while {[incr a] <= $lim} {
6925 if {[info exists arcend($a)]} {
6926 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
6927 } else {
6928 puts $f [list $arcstart($a) {} $arcids($a)]
6929 }
6930 }
6931 } err]} {
6932 catch {close $f}
6933 catch {file delete $allccache}
6934 #puts "writing cache failed ($err)"
6935 return 0
6936 }
6937 set cachearc [expr {$a - 1}]
6938 if {$a > $cachedarcs} {
6939 puts $f "1"
6940 close $f
6941 return 0
6942 }
6943 return 1
6944}
6945
6946proc savecache {} {
6947 global nextarc cachedarcs cachearc allccache
6948
6949 if {$nextarc == $cachedarcs} return
6950 set cachearc 0
6951 set cachedarcs $nextarc
6952 catch {
6953 set f [open $allccache w]
6954 puts $f [list 1 $cachedarcs]
6955 run writecache $f
6956 }
6957}
6958
6959# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6960# or 0 if neither is true.
6961proc anc_or_desc {a b} {
6962 global arcout arcstart arcend arcnos cached_isanc
6963
6964 if {$arcnos($a) eq $arcnos($b)} {
6965 # Both are on the same arc(s); either both are the same BMP,
6966 # or if one is not a BMP, the other is also not a BMP or is
6967 # the BMP at end of the arc (and it only has 1 incoming arc).
6968 # Or both can be BMPs with no incoming arcs.
6969 if {$a eq $b || $arcnos($a) eq {}} {
6970 return 0
6971 }
6972 # assert {[llength $arcnos($a)] == 1}
6973 set arc [lindex $arcnos($a) 0]
6974 set i [lsearch -exact $arcids($arc) $a]
6975 set j [lsearch -exact $arcids($arc) $b]
6976 if {$i < 0 || $i > $j} {
6977 return 1
6978 } else {
6979 return -1
6980 }
6981 }
6982
6983 if {![info exists arcout($a)]} {
6984 set arc [lindex $arcnos($a) 0]
6985 if {[info exists arcend($arc)]} {
6986 set aend $arcend($arc)
6987 } else {
6988 set aend {}
6989 }
6990 set a $arcstart($arc)
6991 } else {
6992 set aend $a
6993 }
6994 if {![info exists arcout($b)]} {
6995 set arc [lindex $arcnos($b) 0]
6996 if {[info exists arcend($arc)]} {
6997 set bend $arcend($arc)
6998 } else {
6999 set bend {}
7000 }
7001 set b $arcstart($arc)
7002 } else {
7003 set bend $b
7004 }
7005 if {$a eq $bend} {
7006 return 1
7007 }
7008 if {$b eq $aend} {
7009 return -1
7010 }
7011 if {[info exists cached_isanc($a,$bend)]} {
7012 if {$cached_isanc($a,$bend)} {
7013 return 1
7014 }
7015 }
7016 if {[info exists cached_isanc($b,$aend)]} {
7017 if {$cached_isanc($b,$aend)} {
7018 return -1
7019 }
7020 if {[info exists cached_isanc($a,$bend)]} {
7021 return 0
7022 }
7023 }
7024
7025 set todo [list $a $b]
7026 set anc($a) a
7027 set anc($b) b
7028 for {set i 0} {$i < [llength $todo]} {incr i} {
7029 set x [lindex $todo $i]
7030 if {$anc($x) eq {}} {
7031 continue
7032 }
7033 foreach arc $arcnos($x) {
7034 set xd $arcstart($arc)
7035 if {$xd eq $bend} {
7036 set cached_isanc($a,$bend) 1
7037 set cached_isanc($b,$aend) 0
7038 return 1
7039 } elseif {$xd eq $aend} {
7040 set cached_isanc($b,$aend) 1
7041 set cached_isanc($a,$bend) 0
7042 return -1
7043 }
7044 if {![info exists anc($xd)]} {
7045 set anc($xd) $anc($x)
7046 lappend todo $xd
7047 } elseif {$anc($xd) ne $anc($x)} {
7048 set anc($xd) {}
7049 }
7050 }
7051 }
7052 set cached_isanc($a,$bend) 0
7053 set cached_isanc($b,$aend) 0
7054 return 0
7055}
7056
7057# This identifies whether $desc has an ancestor that is
7058# a growing tip of the graph and which is not an ancestor of $anc
7059# and returns 0 if so and 1 if not.
7060# If we subsequently discover a tag on such a growing tip, and that
7061# turns out to be a descendent of $anc (which it could, since we
7062# don't necessarily see children before parents), then $desc
7063# isn't a good choice to display as a descendent tag of
7064# $anc (since it is the descendent of another tag which is
7065# a descendent of $anc). Similarly, $anc isn't a good choice to
7066# display as a ancestor tag of $desc.
7067#
7068proc is_certain {desc anc} {
7069 global arcnos arcout arcstart arcend growing problems
7070
7071 set certain {}
7072 if {[llength $arcnos($anc)] == 1} {
7073 # tags on the same arc are certain
7074 if {$arcnos($desc) eq $arcnos($anc)} {
7075 return 1
7076 }
7077 if {![info exists arcout($anc)]} {
7078 # if $anc is partway along an arc, use the start of the arc instead
7079 set a [lindex $arcnos($anc) 0]
7080 set anc $arcstart($a)
7081 }
7082 }
7083 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7084 set x $desc
7085 } else {
7086 set a [lindex $arcnos($desc) 0]
7087 set x $arcend($a)
7088 }
7089 if {$x == $anc} {
7090 return 1
7091 }
7092 set anclist [list $x]
7093 set dl($x) 1
7094 set nnh 1
7095 set ngrowanc 0
7096 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7097 set x [lindex $anclist $i]
7098 if {$dl($x)} {
7099 incr nnh -1
7100 }
7101 set done($x) 1
7102 foreach a $arcout($x) {
7103 if {[info exists growing($a)]} {
7104 if {![info exists growanc($x)] && $dl($x)} {
7105 set growanc($x) 1
7106 incr ngrowanc
7107 }
7108 } else {
7109 set y $arcend($a)
7110 if {[info exists dl($y)]} {
7111 if {$dl($y)} {
7112 if {!$dl($x)} {
7113 set dl($y) 0
7114 if {![info exists done($y)]} {
7115 incr nnh -1
7116 }
7117 if {[info exists growanc($x)]} {
7118 incr ngrowanc -1
7119 }
7120 set xl [list $y]
7121 for {set k 0} {$k < [llength $xl]} {incr k} {
7122 set z [lindex $xl $k]
7123 foreach c $arcout($z) {
7124 if {[info exists arcend($c)]} {
7125 set v $arcend($c)
7126 if {[info exists dl($v)] && $dl($v)} {
7127 set dl($v) 0
7128 if {![info exists done($v)]} {
7129 incr nnh -1
7130 }
7131 if {[info exists growanc($v)]} {
7132 incr ngrowanc -1
7133 }
7134 lappend xl $v
7135 }
7136 }
7137 }
7138 }
7139 }
7140 }
7141 } elseif {$y eq $anc || !$dl($x)} {
7142 set dl($y) 0
7143 lappend anclist $y
7144 } else {
7145 set dl($y) 1
7146 lappend anclist $y
7147 incr nnh
7148 }
7149 }
7150 }
7151 }
7152 foreach x [array names growanc] {
7153 if {$dl($x)} {
7154 return 0
7155 }
7156 return 0
7157 }
7158 return 1
7159}
7160
7161proc validate_arctags {a} {
7162 global arctags idtags
7163
7164 set i -1
7165 set na $arctags($a)
7166 foreach id $arctags($a) {
7167 incr i
7168 if {![info exists idtags($id)]} {
7169 set na [lreplace $na $i $i]
7170 incr i -1
7171 }
7172 }
7173 set arctags($a) $na
7174}
7175
7176proc validate_archeads {a} {
7177 global archeads idheads
7178
7179 set i -1
7180 set na $archeads($a)
7181 foreach id $archeads($a) {
7182 incr i
7183 if {![info exists idheads($id)]} {
7184 set na [lreplace $na $i $i]
7185 incr i -1
7186 }
7187 }
7188 set archeads($a) $na
7189}
7190
7191# Return the list of IDs that have tags that are descendents of id,
7192# ignoring IDs that are descendents of IDs already reported.
7193proc desctags {id} {
7194 global arcnos arcstart arcids arctags idtags allparents
7195 global growing cached_dtags
7196
7197 if {![info exists allparents($id)]} {
7198 return {}
7199 }
7200 set t1 [clock clicks -milliseconds]
7201 set argid $id
7202 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7203 # part-way along an arc; check that arc first
7204 set a [lindex $arcnos($id) 0]
7205 if {$arctags($a) ne {}} {
7206 validate_arctags $a
7207 set i [lsearch -exact $arcids($a) $id]
7208 set tid {}
7209 foreach t $arctags($a) {
7210 set j [lsearch -exact $arcids($a) $t]
7211 if {$j >= $i} break
7212 set tid $t
7213 }
7214 if {$tid ne {}} {
7215 return $tid
7216 }
7217 }
7218 set id $arcstart($a)
7219 if {[info exists idtags($id)]} {
7220 return $id
7221 }
7222 }
7223 if {[info exists cached_dtags($id)]} {
7224 return $cached_dtags($id)
7225 }
7226
7227 set origid $id
7228 set todo [list $id]
7229 set queued($id) 1
7230 set nc 1
7231 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7232 set id [lindex $todo $i]
7233 set done($id) 1
7234 set ta [info exists hastaggedancestor($id)]
7235 if {!$ta} {
7236 incr nc -1
7237 }
7238 # ignore tags on starting node
7239 if {!$ta && $i > 0} {
7240 if {[info exists idtags($id)]} {
7241 set tagloc($id) $id
7242 set ta 1
7243 } elseif {[info exists cached_dtags($id)]} {
7244 set tagloc($id) $cached_dtags($id)
7245 set ta 1
7246 }
7247 }
7248 foreach a $arcnos($id) {
7249 set d $arcstart($a)
7250 if {!$ta && $arctags($a) ne {}} {
7251 validate_arctags $a
7252 if {$arctags($a) ne {}} {
7253 lappend tagloc($id) [lindex $arctags($a) end]
7254 }
7255 }
7256 if {$ta || $arctags($a) ne {}} {
7257 set tomark [list $d]
7258 for {set j 0} {$j < [llength $tomark]} {incr j} {
7259 set dd [lindex $tomark $j]
7260 if {![info exists hastaggedancestor($dd)]} {
7261 if {[info exists done($dd)]} {
7262 foreach b $arcnos($dd) {
7263 lappend tomark $arcstart($b)
7264 }
7265 if {[info exists tagloc($dd)]} {
7266 unset tagloc($dd)
7267 }
7268 } elseif {[info exists queued($dd)]} {
7269 incr nc -1
7270 }
7271 set hastaggedancestor($dd) 1
7272 }
7273 }
7274 }
7275 if {![info exists queued($d)]} {
7276 lappend todo $d
7277 set queued($d) 1
7278 if {![info exists hastaggedancestor($d)]} {
7279 incr nc
7280 }
7281 }
7282 }
7283 }
7284 set tags {}
7285 foreach id [array names tagloc] {
7286 if {![info exists hastaggedancestor($id)]} {
7287 foreach t $tagloc($id) {
7288 if {[lsearch -exact $tags $t] < 0} {
7289 lappend tags $t
7290 }
7291 }
7292 }
7293 }
7294 set t2 [clock clicks -milliseconds]
7295 set loopix $i
7296
7297 # remove tags that are descendents of other tags
7298 for {set i 0} {$i < [llength $tags]} {incr i} {
7299 set a [lindex $tags $i]
7300 for {set j 0} {$j < $i} {incr j} {
7301 set b [lindex $tags $j]
7302 set r [anc_or_desc $a $b]
7303 if {$r == 1} {
7304 set tags [lreplace $tags $j $j]
7305 incr j -1
7306 incr i -1
7307 } elseif {$r == -1} {
7308 set tags [lreplace $tags $i $i]
7309 incr i -1
7310 break
7311 }
7312 }
7313 }
7314
7315 if {[array names growing] ne {}} {
7316 # graph isn't finished, need to check if any tag could get
7317 # eclipsed by another tag coming later. Simply ignore any
7318 # tags that could later get eclipsed.
7319 set ctags {}
7320 foreach t $tags {
7321 if {[is_certain $t $origid]} {
7322 lappend ctags $t
7323 }
7324 }
7325 if {$tags eq $ctags} {
7326 set cached_dtags($origid) $tags
7327 } else {
7328 set tags $ctags
7329 }
7330 } else {
7331 set cached_dtags($origid) $tags
7332 }
7333 set t3 [clock clicks -milliseconds]
7334 if {0 && $t3 - $t1 >= 100} {
7335 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7336 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7337 }
7338 return $tags
7339}
7340
7341proc anctags {id} {
7342 global arcnos arcids arcout arcend arctags idtags allparents
7343 global growing cached_atags
7344
7345 if {![info exists allparents($id)]} {
7346 return {}
7347 }
7348 set t1 [clock clicks -milliseconds]
7349 set argid $id
7350 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7351 # part-way along an arc; check that arc first
7352 set a [lindex $arcnos($id) 0]
7353 if {$arctags($a) ne {}} {
7354 validate_arctags $a
7355 set i [lsearch -exact $arcids($a) $id]
7356 foreach t $arctags($a) {
7357 set j [lsearch -exact $arcids($a) $t]
7358 if {$j > $i} {
7359 return $t
7360 }
7361 }
7362 }
7363 if {![info exists arcend($a)]} {
7364 return {}
7365 }
7366 set id $arcend($a)
7367 if {[info exists idtags($id)]} {
7368 return $id
7369 }
7370 }
7371 if {[info exists cached_atags($id)]} {
7372 return $cached_atags($id)
7373 }
7374
7375 set origid $id
7376 set todo [list $id]
7377 set queued($id) 1
7378 set taglist {}
7379 set nc 1
7380 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7381 set id [lindex $todo $i]
7382 set done($id) 1
7383 set td [info exists hastaggeddescendent($id)]
7384 if {!$td} {
7385 incr nc -1
7386 }
7387 # ignore tags on starting node
7388 if {!$td && $i > 0} {
7389 if {[info exists idtags($id)]} {
7390 set tagloc($id) $id
7391 set td 1
7392 } elseif {[info exists cached_atags($id)]} {
7393 set tagloc($id) $cached_atags($id)
7394 set td 1
7395 }
7396 }
7397 foreach a $arcout($id) {
7398 if {!$td && $arctags($a) ne {}} {
7399 validate_arctags $a
7400 if {$arctags($a) ne {}} {
7401 lappend tagloc($id) [lindex $arctags($a) 0]
7402 }
7403 }
7404 if {![info exists arcend($a)]} continue
7405 set d $arcend($a)
7406 if {$td || $arctags($a) ne {}} {
7407 set tomark [list $d]
7408 for {set j 0} {$j < [llength $tomark]} {incr j} {
7409 set dd [lindex $tomark $j]
7410 if {![info exists hastaggeddescendent($dd)]} {
7411 if {[info exists done($dd)]} {
7412 foreach b $arcout($dd) {
7413 if {[info exists arcend($b)]} {
7414 lappend tomark $arcend($b)
7415 }
7416 }
7417 if {[info exists tagloc($dd)]} {
7418 unset tagloc($dd)
7419 }
7420 } elseif {[info exists queued($dd)]} {
7421 incr nc -1
7422 }
7423 set hastaggeddescendent($dd) 1
7424 }
7425 }
7426 }
7427 if {![info exists queued($d)]} {
7428 lappend todo $d
7429 set queued($d) 1
7430 if {![info exists hastaggeddescendent($d)]} {
7431 incr nc
7432 }
7433 }
7434 }
7435 }
7436 set t2 [clock clicks -milliseconds]
7437 set loopix $i
7438 set tags {}
7439 foreach id [array names tagloc] {
7440 if {![info exists hastaggeddescendent($id)]} {
7441 foreach t $tagloc($id) {
7442 if {[lsearch -exact $tags $t] < 0} {
7443 lappend tags $t
7444 }
7445 }
7446 }
7447 }
7448
7449 # remove tags that are ancestors of other tags
7450 for {set i 0} {$i < [llength $tags]} {incr i} {
7451 set a [lindex $tags $i]
7452 for {set j 0} {$j < $i} {incr j} {
7453 set b [lindex $tags $j]
7454 set r [anc_or_desc $a $b]
7455 if {$r == -1} {
7456 set tags [lreplace $tags $j $j]
7457 incr j -1
7458 incr i -1
7459 } elseif {$r == 1} {
7460 set tags [lreplace $tags $i $i]
7461 incr i -1
7462 break
7463 }
7464 }
7465 }
7466
7467 if {[array names growing] ne {}} {
7468 # graph isn't finished, need to check if any tag could get
7469 # eclipsed by another tag coming later. Simply ignore any
7470 # tags that could later get eclipsed.
7471 set ctags {}
7472 foreach t $tags {
7473 if {[is_certain $origid $t]} {
7474 lappend ctags $t
7475 }
7476 }
7477 if {$tags eq $ctags} {
7478 set cached_atags($origid) $tags
7479 } else {
7480 set tags $ctags
7481 }
7482 } else {
7483 set cached_atags($origid) $tags
7484 }
7485 set t3 [clock clicks -milliseconds]
7486 if {0 && $t3 - $t1 >= 100} {
7487 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7488 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7489 }
7490 return $tags
7491}
7492
7493# Return the list of IDs that have heads that are descendents of id,
7494# including id itself if it has a head.
7495proc descheads {id} {
7496 global arcnos arcstart arcids archeads idheads cached_dheads
7497 global allparents
7498
7499 if {![info exists allparents($id)]} {
7500 return {}
7501 }
7502 set aret {}
7503 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7504 # part-way along an arc; check it first
7505 set a [lindex $arcnos($id) 0]
7506 if {$archeads($a) ne {}} {
7507 validate_archeads $a
7508 set i [lsearch -exact $arcids($a) $id]
7509 foreach t $archeads($a) {
7510 set j [lsearch -exact $arcids($a) $t]
7511 if {$j > $i} break
7512 lappend aret $t
7513 }
7514 }
7515 set id $arcstart($a)
7516 }
7517 set origid $id
7518 set todo [list $id]
7519 set seen($id) 1
7520 set ret {}
7521 for {set i 0} {$i < [llength $todo]} {incr i} {
7522 set id [lindex $todo $i]
7523 if {[info exists cached_dheads($id)]} {
7524 set ret [concat $ret $cached_dheads($id)]
7525 } else {
7526 if {[info exists idheads($id)]} {
7527 lappend ret $id
7528 }
7529 foreach a $arcnos($id) {
7530 if {$archeads($a) ne {}} {
7531 validate_archeads $a
7532 if {$archeads($a) ne {}} {
7533 set ret [concat $ret $archeads($a)]
7534 }
7535 }
7536 set d $arcstart($a)
7537 if {![info exists seen($d)]} {
7538 lappend todo $d
7539 set seen($d) 1
7540 }
7541 }
7542 }
7543 }
7544 set ret [lsort -unique $ret]
7545 set cached_dheads($origid) $ret
7546 return [concat $ret $aret]
7547}
7548
7549proc addedtag {id} {
7550 global arcnos arcout cached_dtags cached_atags
7551
7552 if {![info exists arcnos($id)]} return
7553 if {![info exists arcout($id)]} {
7554 recalcarc [lindex $arcnos($id) 0]
7555 }
7556 catch {unset cached_dtags}
7557 catch {unset cached_atags}
7558}
7559
7560proc addedhead {hid head} {
7561 global arcnos arcout cached_dheads
7562
7563 if {![info exists arcnos($hid)]} return
7564 if {![info exists arcout($hid)]} {
7565 recalcarc [lindex $arcnos($hid) 0]
7566 }
7567 catch {unset cached_dheads}
7568}
7569
7570proc removedhead {hid head} {
7571 global cached_dheads
7572
7573 catch {unset cached_dheads}
7574}
7575
7576proc movedhead {hid head} {
7577 global arcnos arcout cached_dheads
7578
7579 if {![info exists arcnos($hid)]} return
7580 if {![info exists arcout($hid)]} {
7581 recalcarc [lindex $arcnos($hid) 0]
7582 }
7583 catch {unset cached_dheads}
7584}
7585
7586proc changedrefs {} {
7587 global cached_dheads cached_dtags cached_atags
7588 global arctags archeads arcnos arcout idheads idtags
7589
7590 foreach id [concat [array names idheads] [array names idtags]] {
7591 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7592 set a [lindex $arcnos($id) 0]
7593 if {![info exists donearc($a)]} {
7594 recalcarc $a
7595 set donearc($a) 1
7596 }
7597 }
7598 }
7599 catch {unset cached_dtags}
7600 catch {unset cached_atags}
7601 catch {unset cached_dheads}
7602}
7603
7604proc rereadrefs {} {
7605 global idtags idheads idotherrefs mainhead
7606
7607 set refids [concat [array names idtags] \
7608 [array names idheads] [array names idotherrefs]]
7609 foreach id $refids {
7610 if {![info exists ref($id)]} {
7611 set ref($id) [listrefs $id]
7612 }
7613 }
7614 set oldmainhead $mainhead
7615 readrefs
7616 changedrefs
7617 set refids [lsort -unique [concat $refids [array names idtags] \
7618 [array names idheads] [array names idotherrefs]]]
7619 foreach id $refids {
7620 set v [listrefs $id]
7621 if {![info exists ref($id)] || $ref($id) != $v ||
7622 ($id eq $oldmainhead && $id ne $mainhead) ||
7623 ($id eq $mainhead && $id ne $oldmainhead)} {
7624 redrawtags $id
7625 }
7626 }
7627 run refill_reflist
7628}
7629
7630proc listrefs {id} {
7631 global idtags idheads idotherrefs
7632
7633 set x {}
7634 if {[info exists idtags($id)]} {
7635 set x $idtags($id)
7636 }
7637 set y {}
7638 if {[info exists idheads($id)]} {
7639 set y $idheads($id)
7640 }
7641 set z {}
7642 if {[info exists idotherrefs($id)]} {
7643 set z $idotherrefs($id)
7644 }
7645 return [list $x $y $z]
7646}
7647
7648proc showtag {tag isnew} {
7649 global ctext tagcontents tagids linknum tagobjid
7650
7651 if {$isnew} {
7652 addtohistory [list showtag $tag 0]
7653 }
7654 $ctext conf -state normal
7655 clear_ctext
7656 set linknum 0
7657 if {![info exists tagcontents($tag)]} {
7658 catch {
7659 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7660 }
7661 }
7662 if {[info exists tagcontents($tag)]} {
7663 set text $tagcontents($tag)
7664 } else {
7665 set text "Tag: $tag\nId: $tagids($tag)"
7666 }
7667 appendwithlinks $text {}
7668 $ctext conf -state disabled
7669 init_flist {}
7670}
7671
7672proc doquit {} {
7673 global stopped
7674 set stopped 100
7675 savestuff .
7676 destroy .
7677}
7678
7679proc doprefs {} {
7680 global maxwidth maxgraphpct diffopts
7681 global oldprefs prefstop showneartags showlocalchanges
7682 global bgcolor fgcolor ctext diffcolors selectbgcolor
7683 global uifont tabstop
7684
7685 set top .gitkprefs
7686 set prefstop $top
7687 if {[winfo exists $top]} {
7688 raise $top
7689 return
7690 }
7691 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7692 set oldprefs($v) [set $v]
7693 }
7694 toplevel $top
7695 wm title $top "Gitk preferences"
7696 label $top.ldisp -text "Commit list display options"
7697 $top.ldisp configure -font $uifont
7698 grid $top.ldisp - -sticky w -pady 10
7699 label $top.spacer -text " "
7700 label $top.maxwidthl -text "Maximum graph width (lines)" \
7701 -font optionfont
7702 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7703 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7704 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7705 -font optionfont
7706 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7707 grid x $top.maxpctl $top.maxpct -sticky w
7708 frame $top.showlocal
7709 label $top.showlocal.l -text "Show local changes" -font optionfont
7710 checkbutton $top.showlocal.b -variable showlocalchanges
7711 pack $top.showlocal.b $top.showlocal.l -side left
7712 grid x $top.showlocal -sticky w
7713
7714 label $top.ddisp -text "Diff display options"
7715 $top.ddisp configure -font $uifont
7716 grid $top.ddisp - -sticky w -pady 10
7717 label $top.diffoptl -text "Options for diff program" \
7718 -font optionfont
7719 entry $top.diffopt -width 20 -textvariable diffopts
7720 grid x $top.diffoptl $top.diffopt -sticky w
7721 frame $top.ntag
7722 label $top.ntag.l -text "Display nearby tags" -font optionfont
7723 checkbutton $top.ntag.b -variable showneartags
7724 pack $top.ntag.b $top.ntag.l -side left
7725 grid x $top.ntag -sticky w
7726 label $top.tabstopl -text "tabstop" -font optionfont
7727 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7728 grid x $top.tabstopl $top.tabstop -sticky w
7729
7730 label $top.cdisp -text "Colors: press to choose"
7731 $top.cdisp configure -font $uifont
7732 grid $top.cdisp - -sticky w -pady 10
7733 label $top.bg -padx 40 -relief sunk -background $bgcolor
7734 button $top.bgbut -text "Background" -font optionfont \
7735 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7736 grid x $top.bgbut $top.bg -sticky w
7737 label $top.fg -padx 40 -relief sunk -background $fgcolor
7738 button $top.fgbut -text "Foreground" -font optionfont \
7739 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7740 grid x $top.fgbut $top.fg -sticky w
7741 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7742 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7743 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7744 [list $ctext tag conf d0 -foreground]]
7745 grid x $top.diffoldbut $top.diffold -sticky w
7746 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7747 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7748 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7749 [list $ctext tag conf d1 -foreground]]
7750 grid x $top.diffnewbut $top.diffnew -sticky w
7751 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7752 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7753 -command [list choosecolor diffcolors 2 $top.hunksep \
7754 "diff hunk header" \
7755 [list $ctext tag conf hunksep -foreground]]
7756 grid x $top.hunksepbut $top.hunksep -sticky w
7757 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7758 button $top.selbgbut -text "Select bg" -font optionfont \
7759 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7760 grid x $top.selbgbut $top.selbgsep -sticky w
7761
7762 frame $top.buts
7763 button $top.buts.ok -text "OK" -command prefsok -default active
7764 $top.buts.ok configure -font $uifont
7765 button $top.buts.can -text "Cancel" -command prefscan -default normal
7766 $top.buts.can configure -font $uifont
7767 grid $top.buts.ok $top.buts.can
7768 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7769 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7770 grid $top.buts - - -pady 10 -sticky ew
7771 bind $top <Visibility> "focus $top.buts.ok"
7772}
7773
7774proc choosecolor {v vi w x cmd} {
7775 global $v
7776
7777 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7778 -title "Gitk: choose color for $x"]
7779 if {$c eq {}} return
7780 $w conf -background $c
7781 lset $v $vi $c
7782 eval $cmd $c
7783}
7784
7785proc setselbg {c} {
7786 global bglist cflist
7787 foreach w $bglist {
7788 $w configure -selectbackground $c
7789 }
7790 $cflist tag configure highlight \
7791 -background [$cflist cget -selectbackground]
7792 allcanvs itemconf secsel -fill $c
7793}
7794
7795proc setbg {c} {
7796 global bglist
7797
7798 foreach w $bglist {
7799 $w conf -background $c
7800 }
7801}
7802
7803proc setfg {c} {
7804 global fglist canv
7805
7806 foreach w $fglist {
7807 $w conf -foreground $c
7808 }
7809 allcanvs itemconf text -fill $c
7810 $canv itemconf circle -outline $c
7811}
7812
7813proc prefscan {} {
7814 global maxwidth maxgraphpct diffopts
7815 global oldprefs prefstop showneartags showlocalchanges
7816
7817 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7818 set $v $oldprefs($v)
7819 }
7820 catch {destroy $prefstop}
7821 unset prefstop
7822}
7823
7824proc prefsok {} {
7825 global maxwidth maxgraphpct
7826 global oldprefs prefstop showneartags showlocalchanges
7827 global charspc ctext tabstop
7828
7829 catch {destroy $prefstop}
7830 unset prefstop
7831 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7832 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7833 if {$showlocalchanges} {
7834 doshowlocalchanges
7835 } else {
7836 dohidelocalchanges
7837 }
7838 }
7839 if {$maxwidth != $oldprefs(maxwidth)
7840 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7841 redisplay
7842 } elseif {$showneartags != $oldprefs(showneartags)} {
7843 reselectline
7844 }
7845}
7846
7847proc formatdate {d} {
7848 global datetimeformat
7849 if {$d ne {}} {
7850 set d [clock format $d -format $datetimeformat]
7851 }
7852 return $d
7853}
7854
7855# This list of encoding names and aliases is distilled from
7856# http://www.iana.org/assignments/character-sets.
7857# Not all of them are supported by Tcl.
7858set encoding_aliases {
7859 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7860 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7861 { ISO-10646-UTF-1 csISO10646UTF1 }
7862 { ISO_646.basic:1983 ref csISO646basic1983 }
7863 { INVARIANT csINVARIANT }
7864 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7865 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7866 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7867 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7868 { NATS-DANO iso-ir-9-1 csNATSDANO }
7869 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7870 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7871 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7872 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7873 { ISO-2022-KR csISO2022KR }
7874 { EUC-KR csEUCKR }
7875 { ISO-2022-JP csISO2022JP }
7876 { ISO-2022-JP-2 csISO2022JP2 }
7877 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7878 csISO13JISC6220jp }
7879 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7880 { IT iso-ir-15 ISO646-IT csISO15Italian }
7881 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7882 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7883 { greek7-old iso-ir-18 csISO18Greek7Old }
7884 { latin-greek iso-ir-19 csISO19LatinGreek }
7885 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7886 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7887 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7888 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7889 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7890 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7891 { INIS iso-ir-49 csISO49INIS }
7892 { INIS-8 iso-ir-50 csISO50INIS8 }
7893 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7894 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7895 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7896 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7897 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7898 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7899 csISO60Norwegian1 }
7900 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7901 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7902 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7903 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7904 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7905 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7906 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7907 { greek7 iso-ir-88 csISO88Greek7 }
7908 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7909 { iso-ir-90 csISO90 }
7910 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7911 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7912 csISO92JISC62991984b }
7913 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7914 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7915 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7916 csISO95JIS62291984handadd }
7917 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7918 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7919 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7920 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7921 CP819 csISOLatin1 }
7922 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7923 { T.61-7bit iso-ir-102 csISO102T617bit }
7924 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7925 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7926 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7927 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7928 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7929 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7930 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7931 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7932 arabic csISOLatinArabic }
7933 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7934 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7935 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7936 greek greek8 csISOLatinGreek }
7937 { T.101-G2 iso-ir-128 csISO128T101G2 }
7938 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7939 csISOLatinHebrew }
7940 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7941 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7942 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7943 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7944 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7945 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7946 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7947 csISOLatinCyrillic }
7948 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7949 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7950 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7951 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7952 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7953 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7954 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7955 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7956 { ISO_10367-box iso-ir-155 csISO10367Box }
7957 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7958 { latin-lap lap iso-ir-158 csISO158Lap }
7959 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7960 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7961 { us-dk csUSDK }
7962 { dk-us csDKUS }
7963 { JIS_X0201 X0201 csHalfWidthKatakana }
7964 { KSC5636 ISO646-KR csKSC5636 }
7965 { ISO-10646-UCS-2 csUnicode }
7966 { ISO-10646-UCS-4 csUCS4 }
7967 { DEC-MCS dec csDECMCS }
7968 { hp-roman8 roman8 r8 csHPRoman8 }
7969 { macintosh mac csMacintosh }
7970 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7971 csIBM037 }
7972 { IBM038 EBCDIC-INT cp038 csIBM038 }
7973 { IBM273 CP273 csIBM273 }
7974 { IBM274 EBCDIC-BE CP274 csIBM274 }
7975 { IBM275 EBCDIC-BR cp275 csIBM275 }
7976 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7977 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7978 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7979 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7980 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7981 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7982 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7983 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7984 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7985 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7986 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7987 { IBM437 cp437 437 csPC8CodePage437 }
7988 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7989 { IBM775 cp775 csPC775Baltic }
7990 { IBM850 cp850 850 csPC850Multilingual }
7991 { IBM851 cp851 851 csIBM851 }
7992 { IBM852 cp852 852 csPCp852 }
7993 { IBM855 cp855 855 csIBM855 }
7994 { IBM857 cp857 857 csIBM857 }
7995 { IBM860 cp860 860 csIBM860 }
7996 { IBM861 cp861 861 cp-is csIBM861 }
7997 { IBM862 cp862 862 csPC862LatinHebrew }
7998 { IBM863 cp863 863 csIBM863 }
7999 { IBM864 cp864 csIBM864 }
8000 { IBM865 cp865 865 csIBM865 }
8001 { IBM866 cp866 866 csIBM866 }
8002 { IBM868 CP868 cp-ar csIBM868 }
8003 { IBM869 cp869 869 cp-gr csIBM869 }
8004 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8005 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8006 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8007 { IBM891 cp891 csIBM891 }
8008 { IBM903 cp903 csIBM903 }
8009 { IBM904 cp904 904 csIBBM904 }
8010 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8011 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8012 { IBM1026 CP1026 csIBM1026 }
8013 { EBCDIC-AT-DE csIBMEBCDICATDE }
8014 { EBCDIC-AT-DE-A csEBCDICATDEA }
8015 { EBCDIC-CA-FR csEBCDICCAFR }
8016 { EBCDIC-DK-NO csEBCDICDKNO }
8017 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8018 { EBCDIC-FI-SE csEBCDICFISE }
8019 { EBCDIC-FI-SE-A csEBCDICFISEA }
8020 { EBCDIC-FR csEBCDICFR }
8021 { EBCDIC-IT csEBCDICIT }
8022 { EBCDIC-PT csEBCDICPT }
8023 { EBCDIC-ES csEBCDICES }
8024 { EBCDIC-ES-A csEBCDICESA }
8025 { EBCDIC-ES-S csEBCDICESS }
8026 { EBCDIC-UK csEBCDICUK }
8027 { EBCDIC-US csEBCDICUS }
8028 { UNKNOWN-8BIT csUnknown8BiT }
8029 { MNEMONIC csMnemonic }
8030 { MNEM csMnem }
8031 { VISCII csVISCII }
8032 { VIQR csVIQR }
8033 { KOI8-R csKOI8R }
8034 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8035 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8036 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8037 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8038 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8039 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8040 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8041 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8042 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8043 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8044 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8045 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8046 { IBM1047 IBM-1047 }
8047 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8048 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8049 { UNICODE-1-1 csUnicode11 }
8050 { CESU-8 csCESU-8 }
8051 { BOCU-1 csBOCU-1 }
8052 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8053 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8054 l8 }
8055 { ISO-8859-15 ISO_8859-15 Latin-9 }
8056 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8057 { GBK CP936 MS936 windows-936 }
8058 { JIS_Encoding csJISEncoding }
8059 { Shift_JIS MS_Kanji csShiftJIS }
8060 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8061 EUC-JP }
8062 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8063 { ISO-10646-UCS-Basic csUnicodeASCII }
8064 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8065 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8066 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8067 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8068 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8069 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8070 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8071 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8072 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8073 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8074 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8075 { Ventura-US csVenturaUS }
8076 { Ventura-International csVenturaInternational }
8077 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8078 { PC8-Turkish csPC8Turkish }
8079 { IBM-Symbols csIBMSymbols }
8080 { IBM-Thai csIBMThai }
8081 { HP-Legal csHPLegal }
8082 { HP-Pi-font csHPPiFont }
8083 { HP-Math8 csHPMath8 }
8084 { Adobe-Symbol-Encoding csHPPSMath }
8085 { HP-DeskTop csHPDesktop }
8086 { Ventura-Math csVenturaMath }
8087 { Microsoft-Publishing csMicrosoftPublishing }
8088 { Windows-31J csWindows31J }
8089 { GB2312 csGB2312 }
8090 { Big5 csBig5 }
8091}
8092
8093proc tcl_encoding {enc} {
8094 global encoding_aliases
8095 set names [encoding names]
8096 set lcnames [string tolower $names]
8097 set enc [string tolower $enc]
8098 set i [lsearch -exact $lcnames $enc]
8099 if {$i < 0} {
8100 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8101 if {[regsub {^iso[-_]} $enc iso encx]} {
8102 set i [lsearch -exact $lcnames $encx]
8103 }
8104 }
8105 if {$i < 0} {
8106 foreach l $encoding_aliases {
8107 set ll [string tolower $l]
8108 if {[lsearch -exact $ll $enc] < 0} continue
8109 # look through the aliases for one that tcl knows about
8110 foreach e $ll {
8111 set i [lsearch -exact $lcnames $e]
8112 if {$i < 0} {
8113 if {[regsub {^iso[-_]} $e iso ex]} {
8114 set i [lsearch -exact $lcnames $ex]
8115 }
8116 }
8117 if {$i >= 0} break
8118 }
8119 break
8120 }
8121 }
8122 if {$i >= 0} {
8123 return [lindex $names $i]
8124 }
8125 return {}
8126}
8127
8128# defaults...
8129set datemode 0
8130set diffopts "-U 5 -p"
8131set wrcomcmd "git diff-tree --stdin -p --pretty"
8132
8133set gitencoding {}
8134catch {
8135 set gitencoding [exec git config --get i18n.commitencoding]
8136}
8137if {$gitencoding == ""} {
8138 set gitencoding "utf-8"
8139}
8140set tclencoding [tcl_encoding $gitencoding]
8141if {$tclencoding == {}} {
8142 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8143}
8144
8145set mainfont {Helvetica 9}
8146set textfont {Courier 9}
8147set uifont {Helvetica 9 bold}
8148set tabstop 8
8149set findmergefiles 0
8150set maxgraphpct 50
8151set maxwidth 16
8152set revlistorder 0
8153set fastdate 0
8154set uparrowlen 5
8155set downarrowlen 5
8156set mingaplen 100
8157set cmitmode "patch"
8158set wrapcomment "none"
8159set showneartags 1
8160set maxrefs 20
8161set maxlinelen 200
8162set showlocalchanges 1
8163set datetimeformat "%Y-%m-%d %H:%M:%S"
8164
8165set colors {green red blue magenta darkgrey brown orange}
8166set bgcolor white
8167set fgcolor black
8168set diffcolors {red "#00a000" blue}
8169set diffcontext 3
8170set selectbgcolor gray85
8171
8172catch {source ~/.gitk}
8173
8174font create optionfont -family sans-serif -size -12
8175
8176# check that we can find a .git directory somewhere...
8177if {[catch {set gitdir [gitdir]}]} {
8178 show_error {} . "Cannot find a git repository here."
8179 exit 1
8180}
8181if {![file isdirectory $gitdir]} {
8182 show_error {} . "Cannot find the git directory \"$gitdir\"."
8183 exit 1
8184}
8185
8186set revtreeargs {}
8187set cmdline_files {}
8188set i 0
8189foreach arg $argv {
8190 switch -- $arg {
8191 "" { }
8192 "-d" { set datemode 1 }
8193 "--" {
8194 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8195 break
8196 }
8197 default {
8198 lappend revtreeargs $arg
8199 }
8200 }
8201 incr i
8202}
8203
8204if {$i >= [llength $argv] && $revtreeargs ne {}} {
8205 # no -- on command line, but some arguments (other than -d)
8206 if {[catch {
8207 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8208 set cmdline_files [split $f "\n"]
8209 set n [llength $cmdline_files]
8210 set revtreeargs [lrange $revtreeargs 0 end-$n]
8211 # Unfortunately git rev-parse doesn't produce an error when
8212 # something is both a revision and a filename. To be consistent
8213 # with git log and git rev-list, check revtreeargs for filenames.
8214 foreach arg $revtreeargs {
8215 if {[file exists $arg]} {
8216 show_error {} . "Ambiguous argument '$arg': both revision\
8217 and filename"
8218 exit 1
8219 }
8220 }
8221 } err]} {
8222 # unfortunately we get both stdout and stderr in $err,
8223 # so look for "fatal:".
8224 set i [string first "fatal:" $err]
8225 if {$i > 0} {
8226 set err [string range $err [expr {$i + 6}] end]
8227 }
8228 show_error {} . "Bad arguments to gitk:\n$err"
8229 exit 1
8230 }
8231}
8232
8233set nullid "0000000000000000000000000000000000000000"
8234set nullid2 "0000000000000000000000000000000000000001"
8235
8236
8237set runq {}
8238set history {}
8239set historyindex 0
8240set fh_serial 0
8241set nhl_names {}
8242set highlight_paths {}
8243set findpattern {}
8244set searchdirn -forwards
8245set boldrows {}
8246set boldnamerows {}
8247set diffelide {0 0}
8248set markingmatches 0
8249set linkentercount 0
8250set need_redisplay 0
8251set nrows_drawn 0
8252
8253set nextviewnum 1
8254set curview 0
8255set selectedview 0
8256set selectedhlview None
8257set highlight_related None
8258set highlight_files {}
8259set viewfiles(0) {}
8260set viewperm(0) 0
8261set viewargs(0) {}
8262
8263set cmdlineok 0
8264set stopped 0
8265set stuffsaved 0
8266set patchnum 0
8267set localirow -1
8268set localfrow -1
8269set lserial 0
8270setcoords
8271makewindow
8272# wait for the window to become visible
8273tkwait visibility .
8274wm title . "[file tail $argv0]: [file tail [pwd]]"
8275readrefs
8276
8277if {$cmdline_files ne {} || $revtreeargs ne {}} {
8278 # create a view for the files/dirs specified on the command line
8279 set curview 1
8280 set selectedview 1
8281 set nextviewnum 2
8282 set viewname(1) "Command line"
8283 set viewfiles(1) $cmdline_files
8284 set viewargs(1) $revtreeargs
8285 set viewperm(1) 0
8286 addviewmenu 1
8287 .bar.view entryconf Edit* -state normal
8288 .bar.view entryconf Delete* -state normal
8289}
8290
8291if {[info exists permviews]} {
8292 foreach v $permviews {
8293 set n $nextviewnum
8294 incr nextviewnum
8295 set viewname($n) [lindex $v 0]
8296 set viewfiles($n) [lindex $v 1]
8297 set viewargs($n) [lindex $v 2]
8298 set viewperm($n) 1
8299 addviewmenu $n
8300 }
8301}
8302getcommits