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 if {$row < [llength $rowidlist]} {
4031 set idlist [lindex $rowidlist $row]
4032 if {$idlist ne {}} {
4033 if {[llength $kids] == 1} {
4034 set col [lsearch -exact $idlist $p]
4035 lset idlist $col $newcmit
4036 } else {
4037 set col [llength $idlist]
4038 lappend idlist $newcmit
4039 }
4040 }
4041 set rowidlist [linsert $rowidlist $row $idlist]
4042 set rowisopt [linsert $rowisopt $row 0]
4043 set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4044 }
4045
4046 incr numcommits
4047
4048 if {[info exists selectedline] && $selectedline >= $row} {
4049 incr selectedline
4050 }
4051 redisplay
4052}
4053
4054# Remove a commit that was inserted with insertrow on row $row.
4055proc removerow {row} {
4056 global displayorder parentlist commitlisted children
4057 global commitrow curview rowidlist rowisopt rowfinal numcommits
4058 global numcommits
4059 global linesegends selectedline commitidx
4060
4061 if {$row >= $numcommits} {
4062 puts "oops, removing row $row but only have $numcommits rows"
4063 return
4064 }
4065 set rp1 [expr {$row + 1}]
4066 set id [lindex $displayorder $row]
4067 set p [lindex $parentlist $row]
4068 set displayorder [lreplace $displayorder $row $row]
4069 set parentlist [lreplace $parentlist $row $row]
4070 set commitlisted [lreplace $commitlisted $row $row]
4071 set kids $children($curview,$p)
4072 set i [lsearch -exact $kids $id]
4073 if {$i >= 0} {
4074 set kids [lreplace $kids $i $i]
4075 set children($curview,$p) $kids
4076 }
4077 set l [llength $displayorder]
4078 for {set r $row} {$r < $l} {incr r} {
4079 set id [lindex $displayorder $r]
4080 set commitrow($curview,$id) $r
4081 }
4082 incr commitidx($curview) -1
4083
4084 if {$row < [llength $rowidlist]} {
4085 set rowidlist [lreplace $rowidlist $row $row]
4086 set rowisopt [lreplace $rowisopt $row $row]
4087 set rowfinal [lreplace $rowfinal $row $row]
4088 }
4089
4090 incr numcommits -1
4091
4092 if {[info exists selectedline] && $selectedline > $row} {
4093 incr selectedline -1
4094 }
4095 redisplay
4096}
4097
4098# Don't change the text pane cursor if it is currently the hand cursor,
4099# showing that we are over a sha1 ID link.
4100proc settextcursor {c} {
4101 global ctext curtextcursor
4102
4103 if {[$ctext cget -cursor] == $curtextcursor} {
4104 $ctext config -cursor $c
4105 }
4106 set curtextcursor $c
4107}
4108
4109proc nowbusy {what} {
4110 global isbusy
4111
4112 if {[array names isbusy] eq {}} {
4113 . config -cursor watch
4114 settextcursor watch
4115 }
4116 set isbusy($what) 1
4117}
4118
4119proc notbusy {what} {
4120 global isbusy maincursor textcursor
4121
4122 catch {unset isbusy($what)}
4123 if {[array names isbusy] eq {}} {
4124 . config -cursor $maincursor
4125 settextcursor $textcursor
4126 }
4127}
4128
4129proc findmatches {f} {
4130 global findtype findstring
4131 if {$findtype == "Regexp"} {
4132 set matches [regexp -indices -all -inline $findstring $f]
4133 } else {
4134 set fs $findstring
4135 if {$findtype == "IgnCase"} {
4136 set f [string tolower $f]
4137 set fs [string tolower $fs]
4138 }
4139 set matches {}
4140 set i 0
4141 set l [string length $fs]
4142 while {[set j [string first $fs $f $i]] >= 0} {
4143 lappend matches [list $j [expr {$j+$l-1}]]
4144 set i [expr {$j + $l}]
4145 }
4146 }
4147 return $matches
4148}
4149
4150proc dofind {{rev 0}} {
4151 global findstring findstartline findcurline selectedline numcommits
4152 global gdttype filehighlight fh_serial find_dirn
4153
4154 unmarkmatches
4155 focus .
4156 if {$findstring eq {} || $numcommits == 0} return
4157 if {![info exists selectedline]} {
4158 set findstartline [lindex [visiblerows] $rev]
4159 } else {
4160 set findstartline $selectedline
4161 }
4162 set findcurline $findstartline
4163 nowbusy finding
4164 if {$gdttype ne "containing:" && ![info exists filehighlight]} {
4165 after cancel do_file_hl $fh_serial
4166 do_file_hl $fh_serial
4167 }
4168 if {!$rev} {
4169 set find_dirn 1
4170 run findmore
4171 } else {
4172 set find_dirn -1
4173 run findmorerev
4174 }
4175}
4176
4177proc findnext {restart} {
4178 global findcurline find_dirn
4179
4180 if {[info exists find_dirn]} return
4181 set find_dirn 1
4182 if {![info exists findcurline]} {
4183 if {$restart} {
4184 dofind
4185 } else {
4186 bell
4187 }
4188 } else {
4189 run findmore
4190 nowbusy finding
4191 }
4192}
4193
4194proc findprev {} {
4195 global findcurline find_dirn
4196
4197 if {[info exists find_dirn]} return
4198 set find_dirn -1
4199 if {![info exists findcurline]} {
4200 dofind 1
4201 } else {
4202 run findmorerev
4203 nowbusy finding
4204 }
4205}
4206
4207proc findmore {} {
4208 global commitdata commitinfo numcommits findpattern findloc
4209 global findstartline findcurline displayorder
4210 global find_dirn gdttype fhighlights
4211
4212 set fldtypes {Headline Author Date Committer CDate Comments}
4213 set l [expr {$findcurline + 1}]
4214 if {$l >= $numcommits} {
4215 set l 0
4216 }
4217 if {$l <= $findstartline} {
4218 set lim [expr {$findstartline + 1}]
4219 } else {
4220 set lim $numcommits
4221 }
4222 if {$lim - $l > 500} {
4223 set lim [expr {$l + 500}]
4224 }
4225 set found 0
4226 set domore 1
4227 if {$gdttype eq "containing:"} {
4228 for {} {$l < $lim} {incr l} {
4229 set id [lindex $displayorder $l]
4230 # shouldn't happen unless git log doesn't give all the commits...
4231 if {![info exists commitdata($id)]} continue
4232 if {![doesmatch $commitdata($id)]} continue
4233 if {![info exists commitinfo($id)]} {
4234 getcommit $id
4235 }
4236 set info $commitinfo($id)
4237 foreach f $info ty $fldtypes {
4238 if {($findloc eq "All fields" || $findloc eq $ty) &&
4239 [doesmatch $f]} {
4240 set found 1
4241 break
4242 }
4243 }
4244 if {$found} break
4245 }
4246 } else {
4247 for {} {$l < $lim} {incr l} {
4248 set id [lindex $displayorder $l]
4249 if {![info exists fhighlights($l)]} {
4250 askfilehighlight $l $id
4251 if {$domore} {
4252 set domore 0
4253 set findcurline [expr {$l - 1}]
4254 }
4255 } elseif {$fhighlights($l)} {
4256 set found $domore
4257 break
4258 }
4259 }
4260 }
4261 if {$found} {
4262 unset find_dirn
4263 findselectline $l
4264 notbusy finding
4265 return 0
4266 }
4267 if {!$domore} {
4268 flushhighlights
4269 return 0
4270 }
4271 if {$l == $findstartline + 1} {
4272 bell
4273 unset findcurline
4274 unset find_dirn
4275 notbusy finding
4276 return 0
4277 }
4278 set findcurline [expr {$l - 1}]
4279 return 1
4280}
4281
4282proc findmorerev {} {
4283 global commitdata commitinfo numcommits findpattern findloc
4284 global findstartline findcurline displayorder
4285 global find_dirn gdttype fhighlights
4286
4287 set fldtypes {Headline Author Date Committer CDate Comments}
4288 set l $findcurline
4289 if {$l == 0} {
4290 set l $numcommits
4291 }
4292 incr l -1
4293 if {$l >= $findstartline} {
4294 set lim [expr {$findstartline - 1}]
4295 } else {
4296 set lim -1
4297 }
4298 if {$l - $lim > 500} {
4299 set lim [expr {$l - 500}]
4300 }
4301 set found 0
4302 set domore 1
4303 if {$gdttype eq "containing:"} {
4304 for {} {$l > $lim} {incr l -1} {
4305 set id [lindex $displayorder $l]
4306 if {![info exists commitdata($id)]} continue
4307 if {![doesmatch $commitdata($id)]} continue
4308 if {![info exists commitinfo($id)]} {
4309 getcommit $id
4310 }
4311 set info $commitinfo($id)
4312 foreach f $info ty $fldtypes {
4313 if {($findloc eq "All fields" || $findloc eq $ty) &&
4314 [doesmatch $f]} {
4315 set found 1
4316 break
4317 }
4318 }
4319 if {$found} break
4320 }
4321 } else {
4322 for {} {$l > $lim} {incr l -1} {
4323 set id [lindex $displayorder $l]
4324 if {![info exists fhighlights($l)]} {
4325 askfilehighlight $l $id
4326 if {$domore} {
4327 set domore 0
4328 set findcurline [expr {$l + 1}]
4329 }
4330 } elseif {$fhighlights($l)} {
4331 set found $domore
4332 break
4333 }
4334 }
4335 }
4336 if {$found} {
4337 unset find_dirn
4338 findselectline $l
4339 notbusy finding
4340 return 0
4341 }
4342 if {!$domore} {
4343 flushhighlights
4344 return 0
4345 }
4346 if {$l == -1} {
4347 bell
4348 unset findcurline
4349 unset find_dirn
4350 notbusy finding
4351 return 0
4352 }
4353 set findcurline [expr {$l + 1}]
4354 return 1
4355}
4356
4357proc findselectline {l} {
4358 global findloc commentend ctext findcurline markingmatches gdttype
4359
4360 set markingmatches 1
4361 set findcurline $l
4362 selectline $l 1
4363 if {$findloc == "All fields" || $findloc == "Comments"} {
4364 # highlight the matches in the comments
4365 set f [$ctext get 1.0 $commentend]
4366 set matches [findmatches $f]
4367 foreach match $matches {
4368 set start [lindex $match 0]
4369 set end [expr {[lindex $match 1] + 1}]
4370 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4371 }
4372 }
4373 drawvisible
4374}
4375
4376# mark the bits of a headline or author that match a find string
4377proc markmatches {canv l str tag matches font row} {
4378 global selectedline
4379
4380 set bbox [$canv bbox $tag]
4381 set x0 [lindex $bbox 0]
4382 set y0 [lindex $bbox 1]
4383 set y1 [lindex $bbox 3]
4384 foreach match $matches {
4385 set start [lindex $match 0]
4386 set end [lindex $match 1]
4387 if {$start > $end} continue
4388 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4389 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4390 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4391 [expr {$x0+$xlen+2}] $y1 \
4392 -outline {} -tags [list match$l matches] -fill yellow]
4393 $canv lower $t
4394 if {[info exists selectedline] && $row == $selectedline} {
4395 $canv raise $t secsel
4396 }
4397 }
4398}
4399
4400proc unmarkmatches {} {
4401 global findids markingmatches findcurline
4402
4403 allcanvs delete matches
4404 catch {unset findids}
4405 set markingmatches 0
4406 catch {unset findcurline}
4407}
4408
4409proc selcanvline {w x y} {
4410 global canv canvy0 ctext linespc
4411 global rowtextx
4412 set ymax [lindex [$canv cget -scrollregion] 3]
4413 if {$ymax == {}} return
4414 set yfrac [lindex [$canv yview] 0]
4415 set y [expr {$y + $yfrac * $ymax}]
4416 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4417 if {$l < 0} {
4418 set l 0
4419 }
4420 if {$w eq $canv} {
4421 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4422 }
4423 unmarkmatches
4424 selectline $l 1
4425}
4426
4427proc commit_descriptor {p} {
4428 global commitinfo
4429 if {![info exists commitinfo($p)]} {
4430 getcommit $p
4431 }
4432 set l "..."
4433 if {[llength $commitinfo($p)] > 1} {
4434 set l [lindex $commitinfo($p) 0]
4435 }
4436 return "$p ($l)\n"
4437}
4438
4439# append some text to the ctext widget, and make any SHA1 ID
4440# that we know about be a clickable link.
4441proc appendwithlinks {text tags} {
4442 global ctext commitrow linknum curview pendinglinks
4443
4444 set start [$ctext index "end - 1c"]
4445 $ctext insert end $text $tags
4446 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4447 foreach l $links {
4448 set s [lindex $l 0]
4449 set e [lindex $l 1]
4450 set linkid [string range $text $s $e]
4451 incr e
4452 $ctext tag delete link$linknum
4453 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4454 setlink $linkid link$linknum
4455 incr linknum
4456 }
4457}
4458
4459proc setlink {id lk} {
4460 global curview commitrow ctext pendinglinks commitinterest
4461
4462 if {[info exists commitrow($curview,$id)]} {
4463 $ctext tag conf $lk -foreground blue -underline 1
4464 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4465 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4466 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4467 } else {
4468 lappend pendinglinks($id) $lk
4469 lappend commitinterest($id) {makelink %I}
4470 }
4471}
4472
4473proc makelink {id} {
4474 global pendinglinks
4475
4476 if {![info exists pendinglinks($id)]} return
4477 foreach lk $pendinglinks($id) {
4478 setlink $id $lk
4479 }
4480 unset pendinglinks($id)
4481}
4482
4483proc linkcursor {w inc} {
4484 global linkentercount curtextcursor
4485
4486 if {[incr linkentercount $inc] > 0} {
4487 $w configure -cursor hand2
4488 } else {
4489 $w configure -cursor $curtextcursor
4490 if {$linkentercount < 0} {
4491 set linkentercount 0
4492 }
4493 }
4494}
4495
4496proc viewnextline {dir} {
4497 global canv linespc
4498
4499 $canv delete hover
4500 set ymax [lindex [$canv cget -scrollregion] 3]
4501 set wnow [$canv yview]
4502 set wtop [expr {[lindex $wnow 0] * $ymax}]
4503 set newtop [expr {$wtop + $dir * $linespc}]
4504 if {$newtop < 0} {
4505 set newtop 0
4506 } elseif {$newtop > $ymax} {
4507 set newtop $ymax
4508 }
4509 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4510}
4511
4512# add a list of tag or branch names at position pos
4513# returns the number of names inserted
4514proc appendrefs {pos ids var} {
4515 global ctext commitrow linknum curview $var maxrefs
4516
4517 if {[catch {$ctext index $pos}]} {
4518 return 0
4519 }
4520 $ctext conf -state normal
4521 $ctext delete $pos "$pos lineend"
4522 set tags {}
4523 foreach id $ids {
4524 foreach tag [set $var\($id\)] {
4525 lappend tags [list $tag $id]
4526 }
4527 }
4528 if {[llength $tags] > $maxrefs} {
4529 $ctext insert $pos "many ([llength $tags])"
4530 } else {
4531 set tags [lsort -index 0 -decreasing $tags]
4532 set sep {}
4533 foreach ti $tags {
4534 set id [lindex $ti 1]
4535 set lk link$linknum
4536 incr linknum
4537 $ctext tag delete $lk
4538 $ctext insert $pos $sep
4539 $ctext insert $pos [lindex $ti 0] $lk
4540 setlink $id $lk
4541 set sep ", "
4542 }
4543 }
4544 $ctext conf -state disabled
4545 return [llength $tags]
4546}
4547
4548# called when we have finished computing the nearby tags
4549proc dispneartags {delay} {
4550 global selectedline currentid showneartags tagphase
4551
4552 if {![info exists selectedline] || !$showneartags} return
4553 after cancel dispnexttag
4554 if {$delay} {
4555 after 200 dispnexttag
4556 set tagphase -1
4557 } else {
4558 after idle dispnexttag
4559 set tagphase 0
4560 }
4561}
4562
4563proc dispnexttag {} {
4564 global selectedline currentid showneartags tagphase ctext
4565
4566 if {![info exists selectedline] || !$showneartags} return
4567 switch -- $tagphase {
4568 0 {
4569 set dtags [desctags $currentid]
4570 if {$dtags ne {}} {
4571 appendrefs precedes $dtags idtags
4572 }
4573 }
4574 1 {
4575 set atags [anctags $currentid]
4576 if {$atags ne {}} {
4577 appendrefs follows $atags idtags
4578 }
4579 }
4580 2 {
4581 set dheads [descheads $currentid]
4582 if {$dheads ne {}} {
4583 if {[appendrefs branch $dheads idheads] > 1
4584 && [$ctext get "branch -3c"] eq "h"} {
4585 # turn "Branch" into "Branches"
4586 $ctext conf -state normal
4587 $ctext insert "branch -2c" "es"
4588 $ctext conf -state disabled
4589 }
4590 }
4591 }
4592 }
4593 if {[incr tagphase] <= 2} {
4594 after idle dispnexttag
4595 }
4596}
4597
4598proc make_secsel {l} {
4599 global linehtag linentag linedtag canv canv2 canv3
4600
4601 if {![info exists linehtag($l)]} return
4602 $canv delete secsel
4603 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4604 -tags secsel -fill [$canv cget -selectbackground]]
4605 $canv lower $t
4606 $canv2 delete secsel
4607 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4608 -tags secsel -fill [$canv2 cget -selectbackground]]
4609 $canv2 lower $t
4610 $canv3 delete secsel
4611 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4612 -tags secsel -fill [$canv3 cget -selectbackground]]
4613 $canv3 lower $t
4614}
4615
4616proc selectline {l isnew} {
4617 global canv ctext commitinfo selectedline
4618 global displayorder
4619 global canvy0 linespc parentlist children curview
4620 global currentid sha1entry
4621 global commentend idtags linknum
4622 global mergemax numcommits pending_select
4623 global cmitmode showneartags allcommits
4624
4625 catch {unset pending_select}
4626 $canv delete hover
4627 normalline
4628 unsel_reflist
4629 if {$l < 0 || $l >= $numcommits} return
4630 set y [expr {$canvy0 + $l * $linespc}]
4631 set ymax [lindex [$canv cget -scrollregion] 3]
4632 set ytop [expr {$y - $linespc - 1}]
4633 set ybot [expr {$y + $linespc + 1}]
4634 set wnow [$canv yview]
4635 set wtop [expr {[lindex $wnow 0] * $ymax}]
4636 set wbot [expr {[lindex $wnow 1] * $ymax}]
4637 set wh [expr {$wbot - $wtop}]
4638 set newtop $wtop
4639 if {$ytop < $wtop} {
4640 if {$ybot < $wtop} {
4641 set newtop [expr {$y - $wh / 2.0}]
4642 } else {
4643 set newtop $ytop
4644 if {$newtop > $wtop - $linespc} {
4645 set newtop [expr {$wtop - $linespc}]
4646 }
4647 }
4648 } elseif {$ybot > $wbot} {
4649 if {$ytop > $wbot} {
4650 set newtop [expr {$y - $wh / 2.0}]
4651 } else {
4652 set newtop [expr {$ybot - $wh}]
4653 if {$newtop < $wtop + $linespc} {
4654 set newtop [expr {$wtop + $linespc}]
4655 }
4656 }
4657 }
4658 if {$newtop != $wtop} {
4659 if {$newtop < 0} {
4660 set newtop 0
4661 }
4662 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4663 drawvisible
4664 }
4665
4666 make_secsel $l
4667
4668 if {$isnew} {
4669 addtohistory [list selectline $l 0]
4670 }
4671
4672 set selectedline $l
4673
4674 set id [lindex $displayorder $l]
4675 set currentid $id
4676 $sha1entry delete 0 end
4677 $sha1entry insert 0 $id
4678 $sha1entry selection from 0
4679 $sha1entry selection to end
4680 rhighlight_sel $id
4681
4682 $ctext conf -state normal
4683 clear_ctext
4684 set linknum 0
4685 set info $commitinfo($id)
4686 set date [formatdate [lindex $info 2]]
4687 $ctext insert end "Author: [lindex $info 1] $date\n"
4688 set date [formatdate [lindex $info 4]]
4689 $ctext insert end "Committer: [lindex $info 3] $date\n"
4690 if {[info exists idtags($id)]} {
4691 $ctext insert end "Tags:"
4692 foreach tag $idtags($id) {
4693 $ctext insert end " $tag"
4694 }
4695 $ctext insert end "\n"
4696 }
4697
4698 set headers {}
4699 set olds [lindex $parentlist $l]
4700 if {[llength $olds] > 1} {
4701 set np 0
4702 foreach p $olds {
4703 if {$np >= $mergemax} {
4704 set tag mmax
4705 } else {
4706 set tag m$np
4707 }
4708 $ctext insert end "Parent: " $tag
4709 appendwithlinks [commit_descriptor $p] {}
4710 incr np
4711 }
4712 } else {
4713 foreach p $olds {
4714 append headers "Parent: [commit_descriptor $p]"
4715 }
4716 }
4717
4718 foreach c $children($curview,$id) {
4719 append headers "Child: [commit_descriptor $c]"
4720 }
4721
4722 # make anything that looks like a SHA1 ID be a clickable link
4723 appendwithlinks $headers {}
4724 if {$showneartags} {
4725 if {![info exists allcommits]} {
4726 getallcommits
4727 }
4728 $ctext insert end "Branch: "
4729 $ctext mark set branch "end -1c"
4730 $ctext mark gravity branch left
4731 $ctext insert end "\nFollows: "
4732 $ctext mark set follows "end -1c"
4733 $ctext mark gravity follows left
4734 $ctext insert end "\nPrecedes: "
4735 $ctext mark set precedes "end -1c"
4736 $ctext mark gravity precedes left
4737 $ctext insert end "\n"
4738 dispneartags 1
4739 }
4740 $ctext insert end "\n"
4741 set comment [lindex $info 5]
4742 if {[string first "\r" $comment] >= 0} {
4743 set comment [string map {"\r" "\n "} $comment]
4744 }
4745 appendwithlinks $comment {comment}
4746
4747 $ctext tag remove found 1.0 end
4748 $ctext conf -state disabled
4749 set commentend [$ctext index "end - 1c"]
4750
4751 init_flist "Comments"
4752 if {$cmitmode eq "tree"} {
4753 gettree $id
4754 } elseif {[llength $olds] <= 1} {
4755 startdiff $id
4756 } else {
4757 mergediff $id $l
4758 }
4759}
4760
4761proc selfirstline {} {
4762 unmarkmatches
4763 selectline 0 1
4764}
4765
4766proc sellastline {} {
4767 global numcommits
4768 unmarkmatches
4769 set l [expr {$numcommits - 1}]
4770 selectline $l 1
4771}
4772
4773proc selnextline {dir} {
4774 global selectedline
4775 focus .
4776 if {![info exists selectedline]} return
4777 set l [expr {$selectedline + $dir}]
4778 unmarkmatches
4779 selectline $l 1
4780}
4781
4782proc selnextpage {dir} {
4783 global canv linespc selectedline numcommits
4784
4785 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4786 if {$lpp < 1} {
4787 set lpp 1
4788 }
4789 allcanvs yview scroll [expr {$dir * $lpp}] units
4790 drawvisible
4791 if {![info exists selectedline]} return
4792 set l [expr {$selectedline + $dir * $lpp}]
4793 if {$l < 0} {
4794 set l 0
4795 } elseif {$l >= $numcommits} {
4796 set l [expr $numcommits - 1]
4797 }
4798 unmarkmatches
4799 selectline $l 1
4800}
4801
4802proc unselectline {} {
4803 global selectedline currentid
4804
4805 catch {unset selectedline}
4806 catch {unset currentid}
4807 allcanvs delete secsel
4808 rhighlight_none
4809}
4810
4811proc reselectline {} {
4812 global selectedline
4813
4814 if {[info exists selectedline]} {
4815 selectline $selectedline 0
4816 }
4817}
4818
4819proc addtohistory {cmd} {
4820 global history historyindex curview
4821
4822 set elt [list $curview $cmd]
4823 if {$historyindex > 0
4824 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4825 return
4826 }
4827
4828 if {$historyindex < [llength $history]} {
4829 set history [lreplace $history $historyindex end $elt]
4830 } else {
4831 lappend history $elt
4832 }
4833 incr historyindex
4834 if {$historyindex > 1} {
4835 .tf.bar.leftbut conf -state normal
4836 } else {
4837 .tf.bar.leftbut conf -state disabled
4838 }
4839 .tf.bar.rightbut conf -state disabled
4840}
4841
4842proc godo {elt} {
4843 global curview
4844
4845 set view [lindex $elt 0]
4846 set cmd [lindex $elt 1]
4847 if {$curview != $view} {
4848 showview $view
4849 }
4850 eval $cmd
4851}
4852
4853proc goback {} {
4854 global history historyindex
4855 focus .
4856
4857 if {$historyindex > 1} {
4858 incr historyindex -1
4859 godo [lindex $history [expr {$historyindex - 1}]]
4860 .tf.bar.rightbut conf -state normal
4861 }
4862 if {$historyindex <= 1} {
4863 .tf.bar.leftbut conf -state disabled
4864 }
4865}
4866
4867proc goforw {} {
4868 global history historyindex
4869 focus .
4870
4871 if {$historyindex < [llength $history]} {
4872 set cmd [lindex $history $historyindex]
4873 incr historyindex
4874 godo $cmd
4875 .tf.bar.leftbut conf -state normal
4876 }
4877 if {$historyindex >= [llength $history]} {
4878 .tf.bar.rightbut conf -state disabled
4879 }
4880}
4881
4882proc gettree {id} {
4883 global treefilelist treeidlist diffids diffmergeid treepending
4884 global nullid nullid2
4885
4886 set diffids $id
4887 catch {unset diffmergeid}
4888 if {![info exists treefilelist($id)]} {
4889 if {![info exists treepending]} {
4890 if {$id eq $nullid} {
4891 set cmd [list | git ls-files]
4892 } elseif {$id eq $nullid2} {
4893 set cmd [list | git ls-files --stage -t]
4894 } else {
4895 set cmd [list | git ls-tree -r $id]
4896 }
4897 if {[catch {set gtf [open $cmd r]}]} {
4898 return
4899 }
4900 set treepending $id
4901 set treefilelist($id) {}
4902 set treeidlist($id) {}
4903 fconfigure $gtf -blocking 0
4904 filerun $gtf [list gettreeline $gtf $id]
4905 }
4906 } else {
4907 setfilelist $id
4908 }
4909}
4910
4911proc gettreeline {gtf id} {
4912 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4913
4914 set nl 0
4915 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4916 if {$diffids eq $nullid} {
4917 set fname $line
4918 } else {
4919 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4920 set i [string first "\t" $line]
4921 if {$i < 0} continue
4922 set sha1 [lindex $line 2]
4923 set fname [string range $line [expr {$i+1}] end]
4924 if {[string index $fname 0] eq "\""} {
4925 set fname [lindex $fname 0]
4926 }
4927 lappend treeidlist($id) $sha1
4928 }
4929 lappend treefilelist($id) $fname
4930 }
4931 if {![eof $gtf]} {
4932 return [expr {$nl >= 1000? 2: 1}]
4933 }
4934 close $gtf
4935 unset treepending
4936 if {$cmitmode ne "tree"} {
4937 if {![info exists diffmergeid]} {
4938 gettreediffs $diffids
4939 }
4940 } elseif {$id ne $diffids} {
4941 gettree $diffids
4942 } else {
4943 setfilelist $id
4944 }
4945 return 0
4946}
4947
4948proc showfile {f} {
4949 global treefilelist treeidlist diffids nullid nullid2
4950 global ctext commentend
4951
4952 set i [lsearch -exact $treefilelist($diffids) $f]
4953 if {$i < 0} {
4954 puts "oops, $f not in list for id $diffids"
4955 return
4956 }
4957 if {$diffids eq $nullid} {
4958 if {[catch {set bf [open $f r]} err]} {
4959 puts "oops, can't read $f: $err"
4960 return
4961 }
4962 } else {
4963 set blob [lindex $treeidlist($diffids) $i]
4964 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4965 puts "oops, error reading blob $blob: $err"
4966 return
4967 }
4968 }
4969 fconfigure $bf -blocking 0
4970 filerun $bf [list getblobline $bf $diffids]
4971 $ctext config -state normal
4972 clear_ctext $commentend
4973 $ctext insert end "\n"
4974 $ctext insert end "$f\n" filesep
4975 $ctext config -state disabled
4976 $ctext yview $commentend
4977}
4978
4979proc getblobline {bf id} {
4980 global diffids cmitmode ctext
4981
4982 if {$id ne $diffids || $cmitmode ne "tree"} {
4983 catch {close $bf}
4984 return 0
4985 }
4986 $ctext config -state normal
4987 set nl 0
4988 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4989 $ctext insert end "$line\n"
4990 }
4991 if {[eof $bf]} {
4992 # delete last newline
4993 $ctext delete "end - 2c" "end - 1c"
4994 close $bf
4995 return 0
4996 }
4997 $ctext config -state disabled
4998 return [expr {$nl >= 1000? 2: 1}]
4999}
5000
5001proc mergediff {id l} {
5002 global diffmergeid diffopts mdifffd
5003 global diffids
5004 global parentlist
5005
5006 set diffmergeid $id
5007 set diffids $id
5008 # this doesn't seem to actually affect anything...
5009 set env(GIT_DIFF_OPTS) $diffopts
5010 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5011 if {[catch {set mdf [open $cmd r]} err]} {
5012 error_popup "Error getting merge diffs: $err"
5013 return
5014 }
5015 fconfigure $mdf -blocking 0
5016 set mdifffd($id) $mdf
5017 set np [llength [lindex $parentlist $l]]
5018 filerun $mdf [list getmergediffline $mdf $id $np]
5019}
5020
5021proc getmergediffline {mdf id np} {
5022 global diffmergeid ctext cflist mergemax
5023 global difffilestart mdifffd
5024
5025 $ctext conf -state normal
5026 set nr 0
5027 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5028 if {![info exists diffmergeid] || $id != $diffmergeid
5029 || $mdf != $mdifffd($id)} {
5030 close $mdf
5031 return 0
5032 }
5033 if {[regexp {^diff --cc (.*)} $line match fname]} {
5034 # start of a new file
5035 $ctext insert end "\n"
5036 set here [$ctext index "end - 1c"]
5037 lappend difffilestart $here
5038 add_flist [list $fname]
5039 set l [expr {(78 - [string length $fname]) / 2}]
5040 set pad [string range "----------------------------------------" 1 $l]
5041 $ctext insert end "$pad $fname $pad\n" filesep
5042 } elseif {[regexp {^@@} $line]} {
5043 $ctext insert end "$line\n" hunksep
5044 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5045 # do nothing
5046 } else {
5047 # parse the prefix - one ' ', '-' or '+' for each parent
5048 set spaces {}
5049 set minuses {}
5050 set pluses {}
5051 set isbad 0
5052 for {set j 0} {$j < $np} {incr j} {
5053 set c [string range $line $j $j]
5054 if {$c == " "} {
5055 lappend spaces $j
5056 } elseif {$c == "-"} {
5057 lappend minuses $j
5058 } elseif {$c == "+"} {
5059 lappend pluses $j
5060 } else {
5061 set isbad 1
5062 break
5063 }
5064 }
5065 set tags {}
5066 set num {}
5067 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5068 # line doesn't appear in result, parents in $minuses have the line
5069 set num [lindex $minuses 0]
5070 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5071 # line appears in result, parents in $pluses don't have the line
5072 lappend tags mresult
5073 set num [lindex $spaces 0]
5074 }
5075 if {$num ne {}} {
5076 if {$num >= $mergemax} {
5077 set num "max"
5078 }
5079 lappend tags m$num
5080 }
5081 $ctext insert end "$line\n" $tags
5082 }
5083 }
5084 $ctext conf -state disabled
5085 if {[eof $mdf]} {
5086 close $mdf
5087 return 0
5088 }
5089 return [expr {$nr >= 1000? 2: 1}]
5090}
5091
5092proc startdiff {ids} {
5093 global treediffs diffids treepending diffmergeid nullid nullid2
5094
5095 set diffids $ids
5096 catch {unset diffmergeid}
5097 if {![info exists treediffs($ids)] ||
5098 [lsearch -exact $ids $nullid] >= 0 ||
5099 [lsearch -exact $ids $nullid2] >= 0} {
5100 if {![info exists treepending]} {
5101 gettreediffs $ids
5102 }
5103 } else {
5104 addtocflist $ids
5105 }
5106}
5107
5108proc addtocflist {ids} {
5109 global treediffs cflist
5110 add_flist $treediffs($ids)
5111 getblobdiffs $ids
5112}
5113
5114proc diffcmd {ids flags} {
5115 global nullid nullid2
5116
5117 set i [lsearch -exact $ids $nullid]
5118 set j [lsearch -exact $ids $nullid2]
5119 if {$i >= 0} {
5120 if {[llength $ids] > 1 && $j < 0} {
5121 # comparing working directory with some specific revision
5122 set cmd [concat | git diff-index $flags]
5123 if {$i == 0} {
5124 lappend cmd -R [lindex $ids 1]
5125 } else {
5126 lappend cmd [lindex $ids 0]
5127 }
5128 } else {
5129 # comparing working directory with index
5130 set cmd [concat | git diff-files $flags]
5131 if {$j == 1} {
5132 lappend cmd -R
5133 }
5134 }
5135 } elseif {$j >= 0} {
5136 set cmd [concat | git diff-index --cached $flags]
5137 if {[llength $ids] > 1} {
5138 # comparing index with specific revision
5139 if {$i == 0} {
5140 lappend cmd -R [lindex $ids 1]
5141 } else {
5142 lappend cmd [lindex $ids 0]
5143 }
5144 } else {
5145 # comparing index with HEAD
5146 lappend cmd HEAD
5147 }
5148 } else {
5149 set cmd [concat | git diff-tree -r $flags $ids]
5150 }
5151 return $cmd
5152}
5153
5154proc gettreediffs {ids} {
5155 global treediff treepending
5156
5157 set treepending $ids
5158 set treediff {}
5159 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5160 fconfigure $gdtf -blocking 0
5161 filerun $gdtf [list gettreediffline $gdtf $ids]
5162}
5163
5164proc gettreediffline {gdtf ids} {
5165 global treediff treediffs treepending diffids diffmergeid
5166 global cmitmode
5167
5168 set nr 0
5169 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5170 set i [string first "\t" $line]
5171 if {$i >= 0} {
5172 set file [string range $line [expr {$i+1}] end]
5173 if {[string index $file 0] eq "\""} {
5174 set file [lindex $file 0]
5175 }
5176 lappend treediff $file
5177 }
5178 }
5179 if {![eof $gdtf]} {
5180 return [expr {$nr >= 1000? 2: 1}]
5181 }
5182 close $gdtf
5183 set treediffs($ids) $treediff
5184 unset treepending
5185 if {$cmitmode eq "tree"} {
5186 gettree $diffids
5187 } elseif {$ids != $diffids} {
5188 if {![info exists diffmergeid]} {
5189 gettreediffs $diffids
5190 }
5191 } else {
5192 addtocflist $ids
5193 }
5194 return 0
5195}
5196
5197# empty string or positive integer
5198proc diffcontextvalidate {v} {
5199 return [regexp {^(|[1-9][0-9]*)$} $v]
5200}
5201
5202proc diffcontextchange {n1 n2 op} {
5203 global diffcontextstring diffcontext
5204
5205 if {[string is integer -strict $diffcontextstring]} {
5206 if {$diffcontextstring > 0} {
5207 set diffcontext $diffcontextstring
5208 reselectline
5209 }
5210 }
5211}
5212
5213proc getblobdiffs {ids} {
5214 global diffopts blobdifffd diffids env
5215 global diffinhdr treediffs
5216 global diffcontext
5217
5218 set env(GIT_DIFF_OPTS) $diffopts
5219 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5220 puts "error getting diffs: $err"
5221 return
5222 }
5223 set diffinhdr 0
5224 fconfigure $bdf -blocking 0
5225 set blobdifffd($ids) $bdf
5226 filerun $bdf [list getblobdiffline $bdf $diffids]
5227}
5228
5229proc setinlist {var i val} {
5230 global $var
5231
5232 while {[llength [set $var]] < $i} {
5233 lappend $var {}
5234 }
5235 if {[llength [set $var]] == $i} {
5236 lappend $var $val
5237 } else {
5238 lset $var $i $val
5239 }
5240}
5241
5242proc makediffhdr {fname ids} {
5243 global ctext curdiffstart treediffs
5244
5245 set i [lsearch -exact $treediffs($ids) $fname]
5246 if {$i >= 0} {
5247 setinlist difffilestart $i $curdiffstart
5248 }
5249 set l [expr {(78 - [string length $fname]) / 2}]
5250 set pad [string range "----------------------------------------" 1 $l]
5251 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5252}
5253
5254proc getblobdiffline {bdf ids} {
5255 global diffids blobdifffd ctext curdiffstart
5256 global diffnexthead diffnextnote difffilestart
5257 global diffinhdr treediffs
5258
5259 set nr 0
5260 $ctext conf -state normal
5261 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5262 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5263 close $bdf
5264 return 0
5265 }
5266 if {![string compare -length 11 "diff --git " $line]} {
5267 # trim off "diff --git "
5268 set line [string range $line 11 end]
5269 set diffinhdr 1
5270 # start of a new file
5271 $ctext insert end "\n"
5272 set curdiffstart [$ctext index "end - 1c"]
5273 $ctext insert end "\n" filesep
5274 # If the name hasn't changed the length will be odd,
5275 # the middle char will be a space, and the two bits either
5276 # side will be a/name and b/name, or "a/name" and "b/name".
5277 # If the name has changed we'll get "rename from" and
5278 # "rename to" or "copy from" and "copy to" lines following this,
5279 # and we'll use them to get the filenames.
5280 # This complexity is necessary because spaces in the filename(s)
5281 # don't get escaped.
5282 set l [string length $line]
5283 set i [expr {$l / 2}]
5284 if {!(($l & 1) && [string index $line $i] eq " " &&
5285 [string range $line 2 [expr {$i - 1}]] eq \
5286 [string range $line [expr {$i + 3}] end])} {
5287 continue
5288 }
5289 # unescape if quoted and chop off the a/ from the front
5290 if {[string index $line 0] eq "\""} {
5291 set fname [string range [lindex $line 0] 2 end]
5292 } else {
5293 set fname [string range $line 2 [expr {$i - 1}]]
5294 }
5295 makediffhdr $fname $ids
5296
5297 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5298 $line match f1l f1c f2l f2c rest]} {
5299 $ctext insert end "$line\n" hunksep
5300 set diffinhdr 0
5301
5302 } elseif {$diffinhdr} {
5303 if {![string compare -length 12 "rename from " $line] ||
5304 ![string compare -length 10 "copy from " $line]} {
5305 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5306 if {[string index $fname 0] eq "\""} {
5307 set fname [lindex $fname 0]
5308 }
5309 set i [lsearch -exact $treediffs($ids) $fname]
5310 if {$i >= 0} {
5311 setinlist difffilestart $i $curdiffstart
5312 }
5313 } elseif {![string compare -length 10 $line "rename to "] ||
5314 ![string compare -length 8 $line "copy to "]} {
5315 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5316 if {[string index $fname 0] eq "\""} {
5317 set fname [lindex $fname 0]
5318 }
5319 makediffhdr $fname $ids
5320 } elseif {[string compare -length 3 $line "---"] == 0} {
5321 # do nothing
5322 continue
5323 } elseif {[string compare -length 3 $line "+++"] == 0} {
5324 set diffinhdr 0
5325 continue
5326 }
5327 $ctext insert end "$line\n" filesep
5328
5329 } else {
5330 set x [string range $line 0 0]
5331 if {$x == "-" || $x == "+"} {
5332 set tag [expr {$x == "+"}]
5333 $ctext insert end "$line\n" d$tag
5334 } elseif {$x == " "} {
5335 $ctext insert end "$line\n"
5336 } else {
5337 # "\ No newline at end of file",
5338 # or something else we don't recognize
5339 $ctext insert end "$line\n" hunksep
5340 }
5341 }
5342 }
5343 $ctext conf -state disabled
5344 if {[eof $bdf]} {
5345 close $bdf
5346 return 0
5347 }
5348 return [expr {$nr >= 1000? 2: 1}]
5349}
5350
5351proc changediffdisp {} {
5352 global ctext diffelide
5353
5354 $ctext tag conf d0 -elide [lindex $diffelide 0]
5355 $ctext tag conf d1 -elide [lindex $diffelide 1]
5356}
5357
5358proc prevfile {} {
5359 global difffilestart ctext
5360 set prev [lindex $difffilestart 0]
5361 set here [$ctext index @0,0]
5362 foreach loc $difffilestart {
5363 if {[$ctext compare $loc >= $here]} {
5364 $ctext yview $prev
5365 return
5366 }
5367 set prev $loc
5368 }
5369 $ctext yview $prev
5370}
5371
5372proc nextfile {} {
5373 global difffilestart ctext
5374 set here [$ctext index @0,0]
5375 foreach loc $difffilestart {
5376 if {[$ctext compare $loc > $here]} {
5377 $ctext yview $loc
5378 return
5379 }
5380 }
5381}
5382
5383proc clear_ctext {{first 1.0}} {
5384 global ctext smarktop smarkbot
5385 global pendinglinks
5386
5387 set l [lindex [split $first .] 0]
5388 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5389 set smarktop $l
5390 }
5391 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5392 set smarkbot $l
5393 }
5394 $ctext delete $first end
5395 if {$first eq "1.0"} {
5396 catch {unset pendinglinks}
5397 }
5398}
5399
5400proc incrsearch {name ix op} {
5401 global ctext searchstring searchdirn
5402
5403 $ctext tag remove found 1.0 end
5404 if {[catch {$ctext index anchor}]} {
5405 # no anchor set, use start of selection, or of visible area
5406 set sel [$ctext tag ranges sel]
5407 if {$sel ne {}} {
5408 $ctext mark set anchor [lindex $sel 0]
5409 } elseif {$searchdirn eq "-forwards"} {
5410 $ctext mark set anchor @0,0
5411 } else {
5412 $ctext mark set anchor @0,[winfo height $ctext]
5413 }
5414 }
5415 if {$searchstring ne {}} {
5416 set here [$ctext search $searchdirn -- $searchstring anchor]
5417 if {$here ne {}} {
5418 $ctext see $here
5419 }
5420 searchmarkvisible 1
5421 }
5422}
5423
5424proc dosearch {} {
5425 global sstring ctext searchstring searchdirn
5426
5427 focus $sstring
5428 $sstring icursor end
5429 set searchdirn -forwards
5430 if {$searchstring ne {}} {
5431 set sel [$ctext tag ranges sel]
5432 if {$sel ne {}} {
5433 set start "[lindex $sel 0] + 1c"
5434 } elseif {[catch {set start [$ctext index anchor]}]} {
5435 set start "@0,0"
5436 }
5437 set match [$ctext search -count mlen -- $searchstring $start]
5438 $ctext tag remove sel 1.0 end
5439 if {$match eq {}} {
5440 bell
5441 return
5442 }
5443 $ctext see $match
5444 set mend "$match + $mlen c"
5445 $ctext tag add sel $match $mend
5446 $ctext mark unset anchor
5447 }
5448}
5449
5450proc dosearchback {} {
5451 global sstring ctext searchstring searchdirn
5452
5453 focus $sstring
5454 $sstring icursor end
5455 set searchdirn -backwards
5456 if {$searchstring ne {}} {
5457 set sel [$ctext tag ranges sel]
5458 if {$sel ne {}} {
5459 set start [lindex $sel 0]
5460 } elseif {[catch {set start [$ctext index anchor]}]} {
5461 set start @0,[winfo height $ctext]
5462 }
5463 set match [$ctext search -backwards -count ml -- $searchstring $start]
5464 $ctext tag remove sel 1.0 end
5465 if {$match eq {}} {
5466 bell
5467 return
5468 }
5469 $ctext see $match
5470 set mend "$match + $ml c"
5471 $ctext tag add sel $match $mend
5472 $ctext mark unset anchor
5473 }
5474}
5475
5476proc searchmark {first last} {
5477 global ctext searchstring
5478
5479 set mend $first.0
5480 while {1} {
5481 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5482 if {$match eq {}} break
5483 set mend "$match + $mlen c"
5484 $ctext tag add found $match $mend
5485 }
5486}
5487
5488proc searchmarkvisible {doall} {
5489 global ctext smarktop smarkbot
5490
5491 set topline [lindex [split [$ctext index @0,0] .] 0]
5492 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5493 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5494 # no overlap with previous
5495 searchmark $topline $botline
5496 set smarktop $topline
5497 set smarkbot $botline
5498 } else {
5499 if {$topline < $smarktop} {
5500 searchmark $topline [expr {$smarktop-1}]
5501 set smarktop $topline
5502 }
5503 if {$botline > $smarkbot} {
5504 searchmark [expr {$smarkbot+1}] $botline
5505 set smarkbot $botline
5506 }
5507 }
5508}
5509
5510proc scrolltext {f0 f1} {
5511 global searchstring
5512
5513 .bleft.sb set $f0 $f1
5514 if {$searchstring ne {}} {
5515 searchmarkvisible 0
5516 }
5517}
5518
5519proc setcoords {} {
5520 global linespc charspc canvx0 canvy0 mainfont
5521 global xspc1 xspc2 lthickness
5522
5523 set linespc [font metrics $mainfont -linespace]
5524 set charspc [font measure $mainfont "m"]
5525 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5526 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5527 set lthickness [expr {int($linespc / 9) + 1}]
5528 set xspc1(0) $linespc
5529 set xspc2 $linespc
5530}
5531
5532proc redisplay {} {
5533 global canv
5534 global selectedline
5535
5536 set ymax [lindex [$canv cget -scrollregion] 3]
5537 if {$ymax eq {} || $ymax == 0} return
5538 set span [$canv yview]
5539 clear_display
5540 setcanvscroll
5541 allcanvs yview moveto [lindex $span 0]
5542 drawvisible
5543 if {[info exists selectedline]} {
5544 selectline $selectedline 0
5545 allcanvs yview moveto [lindex $span 0]
5546 }
5547}
5548
5549proc incrfont {inc} {
5550 global mainfont textfont ctext canv phase cflist showrefstop
5551 global charspc tabstop
5552 global stopped entries
5553 unmarkmatches
5554 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5555 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5556 setcoords
5557 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5558 $cflist conf -font $textfont
5559 $ctext tag conf filesep -font [concat $textfont bold]
5560 foreach e $entries {
5561 $e conf -font $mainfont
5562 }
5563 if {$phase eq "getcommits"} {
5564 $canv itemconf textitems -font $mainfont
5565 }
5566 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5567 $showrefstop.list conf -font $mainfont
5568 }
5569 redisplay
5570}
5571
5572proc clearsha1 {} {
5573 global sha1entry sha1string
5574 if {[string length $sha1string] == 40} {
5575 $sha1entry delete 0 end
5576 }
5577}
5578
5579proc sha1change {n1 n2 op} {
5580 global sha1string currentid sha1but
5581 if {$sha1string == {}
5582 || ([info exists currentid] && $sha1string == $currentid)} {
5583 set state disabled
5584 } else {
5585 set state normal
5586 }
5587 if {[$sha1but cget -state] == $state} return
5588 if {$state == "normal"} {
5589 $sha1but conf -state normal -relief raised -text "Goto: "
5590 } else {
5591 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5592 }
5593}
5594
5595proc gotocommit {} {
5596 global sha1string currentid commitrow tagids headids
5597 global displayorder numcommits curview
5598
5599 if {$sha1string == {}
5600 || ([info exists currentid] && $sha1string == $currentid)} return
5601 if {[info exists tagids($sha1string)]} {
5602 set id $tagids($sha1string)
5603 } elseif {[info exists headids($sha1string)]} {
5604 set id $headids($sha1string)
5605 } else {
5606 set id [string tolower $sha1string]
5607 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5608 set matches {}
5609 foreach i $displayorder {
5610 if {[string match $id* $i]} {
5611 lappend matches $i
5612 }
5613 }
5614 if {$matches ne {}} {
5615 if {[llength $matches] > 1} {
5616 error_popup "Short SHA1 id $id is ambiguous"
5617 return
5618 }
5619 set id [lindex $matches 0]
5620 }
5621 }
5622 }
5623 if {[info exists commitrow($curview,$id)]} {
5624 selectline $commitrow($curview,$id) 1
5625 return
5626 }
5627 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5628 set type "SHA1 id"
5629 } else {
5630 set type "Tag/Head"
5631 }
5632 error_popup "$type $sha1string is not known"
5633}
5634
5635proc lineenter {x y id} {
5636 global hoverx hovery hoverid hovertimer
5637 global commitinfo canv
5638
5639 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5640 set hoverx $x
5641 set hovery $y
5642 set hoverid $id
5643 if {[info exists hovertimer]} {
5644 after cancel $hovertimer
5645 }
5646 set hovertimer [after 500 linehover]
5647 $canv delete hover
5648}
5649
5650proc linemotion {x y id} {
5651 global hoverx hovery hoverid hovertimer
5652
5653 if {[info exists hoverid] && $id == $hoverid} {
5654 set hoverx $x
5655 set hovery $y
5656 if {[info exists hovertimer]} {
5657 after cancel $hovertimer
5658 }
5659 set hovertimer [after 500 linehover]
5660 }
5661}
5662
5663proc lineleave {id} {
5664 global hoverid hovertimer canv
5665
5666 if {[info exists hoverid] && $id == $hoverid} {
5667 $canv delete hover
5668 if {[info exists hovertimer]} {
5669 after cancel $hovertimer
5670 unset hovertimer
5671 }
5672 unset hoverid
5673 }
5674}
5675
5676proc linehover {} {
5677 global hoverx hovery hoverid hovertimer
5678 global canv linespc lthickness
5679 global commitinfo mainfont
5680
5681 set text [lindex $commitinfo($hoverid) 0]
5682 set ymax [lindex [$canv cget -scrollregion] 3]
5683 if {$ymax == {}} return
5684 set yfrac [lindex [$canv yview] 0]
5685 set x [expr {$hoverx + 2 * $linespc}]
5686 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5687 set x0 [expr {$x - 2 * $lthickness}]
5688 set y0 [expr {$y - 2 * $lthickness}]
5689 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5690 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5691 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5692 -fill \#ffff80 -outline black -width 1 -tags hover]
5693 $canv raise $t
5694 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5695 -font $mainfont]
5696 $canv raise $t
5697}
5698
5699proc clickisonarrow {id y} {
5700 global lthickness
5701
5702 set ranges [rowranges $id]
5703 set thresh [expr {2 * $lthickness + 6}]
5704 set n [expr {[llength $ranges] - 1}]
5705 for {set i 1} {$i < $n} {incr i} {
5706 set row [lindex $ranges $i]
5707 if {abs([yc $row] - $y) < $thresh} {
5708 return $i
5709 }
5710 }
5711 return {}
5712}
5713
5714proc arrowjump {id n y} {
5715 global canv
5716
5717 # 1 <-> 2, 3 <-> 4, etc...
5718 set n [expr {(($n - 1) ^ 1) + 1}]
5719 set row [lindex [rowranges $id] $n]
5720 set yt [yc $row]
5721 set ymax [lindex [$canv cget -scrollregion] 3]
5722 if {$ymax eq {} || $ymax <= 0} return
5723 set view [$canv yview]
5724 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5725 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5726 if {$yfrac < 0} {
5727 set yfrac 0
5728 }
5729 allcanvs yview moveto $yfrac
5730}
5731
5732proc lineclick {x y id isnew} {
5733 global ctext commitinfo children canv thickerline curview commitrow
5734
5735 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5736 unmarkmatches
5737 unselectline
5738 normalline
5739 $canv delete hover
5740 # draw this line thicker than normal
5741 set thickerline $id
5742 drawlines $id
5743 if {$isnew} {
5744 set ymax [lindex [$canv cget -scrollregion] 3]
5745 if {$ymax eq {}} return
5746 set yfrac [lindex [$canv yview] 0]
5747 set y [expr {$y + $yfrac * $ymax}]
5748 }
5749 set dirn [clickisonarrow $id $y]
5750 if {$dirn ne {}} {
5751 arrowjump $id $dirn $y
5752 return
5753 }
5754
5755 if {$isnew} {
5756 addtohistory [list lineclick $x $y $id 0]
5757 }
5758 # fill the details pane with info about this line
5759 $ctext conf -state normal
5760 clear_ctext
5761 $ctext insert end "Parent:\t"
5762 $ctext insert end $id link0
5763 setlink $id link0
5764 set info $commitinfo($id)
5765 $ctext insert end "\n\t[lindex $info 0]\n"
5766 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5767 set date [formatdate [lindex $info 2]]
5768 $ctext insert end "\tDate:\t$date\n"
5769 set kids $children($curview,$id)
5770 if {$kids ne {}} {
5771 $ctext insert end "\nChildren:"
5772 set i 0
5773 foreach child $kids {
5774 incr i
5775 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5776 set info $commitinfo($child)
5777 $ctext insert end "\n\t"
5778 $ctext insert end $child link$i
5779 setlink $child link$i
5780 $ctext insert end "\n\t[lindex $info 0]"
5781 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5782 set date [formatdate [lindex $info 2]]
5783 $ctext insert end "\n\tDate:\t$date\n"
5784 }
5785 }
5786 $ctext conf -state disabled
5787 init_flist {}
5788}
5789
5790proc normalline {} {
5791 global thickerline
5792 if {[info exists thickerline]} {
5793 set id $thickerline
5794 unset thickerline
5795 drawlines $id
5796 }
5797}
5798
5799proc selbyid {id} {
5800 global commitrow curview
5801 if {[info exists commitrow($curview,$id)]} {
5802 selectline $commitrow($curview,$id) 1
5803 }
5804}
5805
5806proc mstime {} {
5807 global startmstime
5808 if {![info exists startmstime]} {
5809 set startmstime [clock clicks -milliseconds]
5810 }
5811 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5812}
5813
5814proc rowmenu {x y id} {
5815 global rowctxmenu commitrow selectedline rowmenuid curview
5816 global nullid nullid2 fakerowmenu mainhead
5817
5818 set rowmenuid $id
5819 if {![info exists selectedline]
5820 || $commitrow($curview,$id) eq $selectedline} {
5821 set state disabled
5822 } else {
5823 set state normal
5824 }
5825 if {$id ne $nullid && $id ne $nullid2} {
5826 set menu $rowctxmenu
5827 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5828 } else {
5829 set menu $fakerowmenu
5830 }
5831 $menu entryconfigure "Diff this*" -state $state
5832 $menu entryconfigure "Diff selected*" -state $state
5833 $menu entryconfigure "Make patch" -state $state
5834 tk_popup $menu $x $y
5835}
5836
5837proc diffvssel {dirn} {
5838 global rowmenuid selectedline displayorder
5839
5840 if {![info exists selectedline]} return
5841 if {$dirn} {
5842 set oldid [lindex $displayorder $selectedline]
5843 set newid $rowmenuid
5844 } else {
5845 set oldid $rowmenuid
5846 set newid [lindex $displayorder $selectedline]
5847 }
5848 addtohistory [list doseldiff $oldid $newid]
5849 doseldiff $oldid $newid
5850}
5851
5852proc doseldiff {oldid newid} {
5853 global ctext
5854 global commitinfo
5855
5856 $ctext conf -state normal
5857 clear_ctext
5858 init_flist "Top"
5859 $ctext insert end "From "
5860 $ctext insert end $oldid link0
5861 setlink $oldid link0
5862 $ctext insert end "\n "
5863 $ctext insert end [lindex $commitinfo($oldid) 0]
5864 $ctext insert end "\n\nTo "
5865 $ctext insert end $newid link1
5866 setlink $newid link1
5867 $ctext insert end "\n "
5868 $ctext insert end [lindex $commitinfo($newid) 0]
5869 $ctext insert end "\n"
5870 $ctext conf -state disabled
5871 $ctext tag remove found 1.0 end
5872 startdiff [list $oldid $newid]
5873}
5874
5875proc mkpatch {} {
5876 global rowmenuid currentid commitinfo patchtop patchnum
5877
5878 if {![info exists currentid]} return
5879 set oldid $currentid
5880 set oldhead [lindex $commitinfo($oldid) 0]
5881 set newid $rowmenuid
5882 set newhead [lindex $commitinfo($newid) 0]
5883 set top .patch
5884 set patchtop $top
5885 catch {destroy $top}
5886 toplevel $top
5887 label $top.title -text "Generate patch"
5888 grid $top.title - -pady 10
5889 label $top.from -text "From:"
5890 entry $top.fromsha1 -width 40 -relief flat
5891 $top.fromsha1 insert 0 $oldid
5892 $top.fromsha1 conf -state readonly
5893 grid $top.from $top.fromsha1 -sticky w
5894 entry $top.fromhead -width 60 -relief flat
5895 $top.fromhead insert 0 $oldhead
5896 $top.fromhead conf -state readonly
5897 grid x $top.fromhead -sticky w
5898 label $top.to -text "To:"
5899 entry $top.tosha1 -width 40 -relief flat
5900 $top.tosha1 insert 0 $newid
5901 $top.tosha1 conf -state readonly
5902 grid $top.to $top.tosha1 -sticky w
5903 entry $top.tohead -width 60 -relief flat
5904 $top.tohead insert 0 $newhead
5905 $top.tohead conf -state readonly
5906 grid x $top.tohead -sticky w
5907 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5908 grid $top.rev x -pady 10
5909 label $top.flab -text "Output file:"
5910 entry $top.fname -width 60
5911 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5912 incr patchnum
5913 grid $top.flab $top.fname -sticky w
5914 frame $top.buts
5915 button $top.buts.gen -text "Generate" -command mkpatchgo
5916 button $top.buts.can -text "Cancel" -command mkpatchcan
5917 grid $top.buts.gen $top.buts.can
5918 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5919 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5920 grid $top.buts - -pady 10 -sticky ew
5921 focus $top.fname
5922}
5923
5924proc mkpatchrev {} {
5925 global patchtop
5926
5927 set oldid [$patchtop.fromsha1 get]
5928 set oldhead [$patchtop.fromhead get]
5929 set newid [$patchtop.tosha1 get]
5930 set newhead [$patchtop.tohead get]
5931 foreach e [list fromsha1 fromhead tosha1 tohead] \
5932 v [list $newid $newhead $oldid $oldhead] {
5933 $patchtop.$e conf -state normal
5934 $patchtop.$e delete 0 end
5935 $patchtop.$e insert 0 $v
5936 $patchtop.$e conf -state readonly
5937 }
5938}
5939
5940proc mkpatchgo {} {
5941 global patchtop nullid nullid2
5942
5943 set oldid [$patchtop.fromsha1 get]
5944 set newid [$patchtop.tosha1 get]
5945 set fname [$patchtop.fname get]
5946 set cmd [diffcmd [list $oldid $newid] -p]
5947 # trim off the initial "|"
5948 set cmd [lrange $cmd 1 end]
5949 lappend cmd >$fname &
5950 if {[catch {eval exec $cmd} err]} {
5951 error_popup "Error creating patch: $err"
5952 }
5953 catch {destroy $patchtop}
5954 unset patchtop
5955}
5956
5957proc mkpatchcan {} {
5958 global patchtop
5959
5960 catch {destroy $patchtop}
5961 unset patchtop
5962}
5963
5964proc mktag {} {
5965 global rowmenuid mktagtop commitinfo
5966
5967 set top .maketag
5968 set mktagtop $top
5969 catch {destroy $top}
5970 toplevel $top
5971 label $top.title -text "Create tag"
5972 grid $top.title - -pady 10
5973 label $top.id -text "ID:"
5974 entry $top.sha1 -width 40 -relief flat
5975 $top.sha1 insert 0 $rowmenuid
5976 $top.sha1 conf -state readonly
5977 grid $top.id $top.sha1 -sticky w
5978 entry $top.head -width 60 -relief flat
5979 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5980 $top.head conf -state readonly
5981 grid x $top.head -sticky w
5982 label $top.tlab -text "Tag name:"
5983 entry $top.tag -width 60
5984 grid $top.tlab $top.tag -sticky w
5985 frame $top.buts
5986 button $top.buts.gen -text "Create" -command mktaggo
5987 button $top.buts.can -text "Cancel" -command mktagcan
5988 grid $top.buts.gen $top.buts.can
5989 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5990 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5991 grid $top.buts - -pady 10 -sticky ew
5992 focus $top.tag
5993}
5994
5995proc domktag {} {
5996 global mktagtop env tagids idtags
5997
5998 set id [$mktagtop.sha1 get]
5999 set tag [$mktagtop.tag get]
6000 if {$tag == {}} {
6001 error_popup "No tag name specified"
6002 return
6003 }
6004 if {[info exists tagids($tag)]} {
6005 error_popup "Tag \"$tag\" already exists"
6006 return
6007 }
6008 if {[catch {
6009 set dir [gitdir]
6010 set fname [file join $dir "refs/tags" $tag]
6011 set f [open $fname w]
6012 puts $f $id
6013 close $f
6014 } err]} {
6015 error_popup "Error creating tag: $err"
6016 return
6017 }
6018
6019 set tagids($tag) $id
6020 lappend idtags($id) $tag
6021 redrawtags $id
6022 addedtag $id
6023 dispneartags 0
6024 run refill_reflist
6025}
6026
6027proc redrawtags {id} {
6028 global canv linehtag commitrow idpos selectedline curview
6029 global mainfont canvxmax iddrawn
6030
6031 if {![info exists commitrow($curview,$id)]} return
6032 if {![info exists iddrawn($id)]} return
6033 drawcommits $commitrow($curview,$id)
6034 $canv delete tag.$id
6035 set xt [eval drawtags $id $idpos($id)]
6036 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6037 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6038 set xr [expr {$xt + [font measure $mainfont $text]}]
6039 if {$xr > $canvxmax} {
6040 set canvxmax $xr
6041 setcanvscroll
6042 }
6043 if {[info exists selectedline]
6044 && $selectedline == $commitrow($curview,$id)} {
6045 selectline $selectedline 0
6046 }
6047}
6048
6049proc mktagcan {} {
6050 global mktagtop
6051
6052 catch {destroy $mktagtop}
6053 unset mktagtop
6054}
6055
6056proc mktaggo {} {
6057 domktag
6058 mktagcan
6059}
6060
6061proc writecommit {} {
6062 global rowmenuid wrcomtop commitinfo wrcomcmd
6063
6064 set top .writecommit
6065 set wrcomtop $top
6066 catch {destroy $top}
6067 toplevel $top
6068 label $top.title -text "Write commit to file"
6069 grid $top.title - -pady 10
6070 label $top.id -text "ID:"
6071 entry $top.sha1 -width 40 -relief flat
6072 $top.sha1 insert 0 $rowmenuid
6073 $top.sha1 conf -state readonly
6074 grid $top.id $top.sha1 -sticky w
6075 entry $top.head -width 60 -relief flat
6076 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6077 $top.head conf -state readonly
6078 grid x $top.head -sticky w
6079 label $top.clab -text "Command:"
6080 entry $top.cmd -width 60 -textvariable wrcomcmd
6081 grid $top.clab $top.cmd -sticky w -pady 10
6082 label $top.flab -text "Output file:"
6083 entry $top.fname -width 60
6084 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6085 grid $top.flab $top.fname -sticky w
6086 frame $top.buts
6087 button $top.buts.gen -text "Write" -command wrcomgo
6088 button $top.buts.can -text "Cancel" -command wrcomcan
6089 grid $top.buts.gen $top.buts.can
6090 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6091 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6092 grid $top.buts - -pady 10 -sticky ew
6093 focus $top.fname
6094}
6095
6096proc wrcomgo {} {
6097 global wrcomtop
6098
6099 set id [$wrcomtop.sha1 get]
6100 set cmd "echo $id | [$wrcomtop.cmd get]"
6101 set fname [$wrcomtop.fname get]
6102 if {[catch {exec sh -c $cmd >$fname &} err]} {
6103 error_popup "Error writing commit: $err"
6104 }
6105 catch {destroy $wrcomtop}
6106 unset wrcomtop
6107}
6108
6109proc wrcomcan {} {
6110 global wrcomtop
6111
6112 catch {destroy $wrcomtop}
6113 unset wrcomtop
6114}
6115
6116proc mkbranch {} {
6117 global rowmenuid mkbrtop
6118
6119 set top .makebranch
6120 catch {destroy $top}
6121 toplevel $top
6122 label $top.title -text "Create new branch"
6123 grid $top.title - -pady 10
6124 label $top.id -text "ID:"
6125 entry $top.sha1 -width 40 -relief flat
6126 $top.sha1 insert 0 $rowmenuid
6127 $top.sha1 conf -state readonly
6128 grid $top.id $top.sha1 -sticky w
6129 label $top.nlab -text "Name:"
6130 entry $top.name -width 40
6131 grid $top.nlab $top.name -sticky w
6132 frame $top.buts
6133 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6134 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6135 grid $top.buts.go $top.buts.can
6136 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6137 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6138 grid $top.buts - -pady 10 -sticky ew
6139 focus $top.name
6140}
6141
6142proc mkbrgo {top} {
6143 global headids idheads
6144
6145 set name [$top.name get]
6146 set id [$top.sha1 get]
6147 if {$name eq {}} {
6148 error_popup "Please specify a name for the new branch"
6149 return
6150 }
6151 catch {destroy $top}
6152 nowbusy newbranch
6153 update
6154 if {[catch {
6155 exec git branch $name $id
6156 } err]} {
6157 notbusy newbranch
6158 error_popup $err
6159 } else {
6160 set headids($name) $id
6161 lappend idheads($id) $name
6162 addedhead $id $name
6163 notbusy newbranch
6164 redrawtags $id
6165 dispneartags 0
6166 run refill_reflist
6167 }
6168}
6169
6170proc cherrypick {} {
6171 global rowmenuid curview commitrow
6172 global mainhead
6173
6174 set oldhead [exec git rev-parse HEAD]
6175 set dheads [descheads $rowmenuid]
6176 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6177 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6178 included in branch $mainhead -- really re-apply it?"]
6179 if {!$ok} return
6180 }
6181 nowbusy cherrypick
6182 update
6183 # Unfortunately git-cherry-pick writes stuff to stderr even when
6184 # no error occurs, and exec takes that as an indication of error...
6185 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6186 notbusy cherrypick
6187 error_popup $err
6188 return
6189 }
6190 set newhead [exec git rev-parse HEAD]
6191 if {$newhead eq $oldhead} {
6192 notbusy cherrypick
6193 error_popup "No changes committed"
6194 return
6195 }
6196 addnewchild $newhead $oldhead
6197 if {[info exists commitrow($curview,$oldhead)]} {
6198 insertrow $commitrow($curview,$oldhead) $newhead
6199 if {$mainhead ne {}} {
6200 movehead $newhead $mainhead
6201 movedhead $newhead $mainhead
6202 }
6203 redrawtags $oldhead
6204 redrawtags $newhead
6205 }
6206 notbusy cherrypick
6207}
6208
6209proc resethead {} {
6210 global mainheadid mainhead rowmenuid confirm_ok resettype
6211
6212 set confirm_ok 0
6213 set w ".confirmreset"
6214 toplevel $w
6215 wm transient $w .
6216 wm title $w "Confirm reset"
6217 message $w.m -text \
6218 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6219 -justify center -aspect 1000
6220 pack $w.m -side top -fill x -padx 20 -pady 20
6221 frame $w.f -relief sunken -border 2
6222 message $w.f.rt -text "Reset type:" -aspect 1000
6223 grid $w.f.rt -sticky w
6224 set resettype mixed
6225 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6226 -text "Soft: Leave working tree and index untouched"
6227 grid $w.f.soft -sticky w
6228 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6229 -text "Mixed: Leave working tree untouched, reset index"
6230 grid $w.f.mixed -sticky w
6231 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6232 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6233 grid $w.f.hard -sticky w
6234 pack $w.f -side top -fill x
6235 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6236 pack $w.ok -side left -fill x -padx 20 -pady 20
6237 button $w.cancel -text Cancel -command "destroy $w"
6238 pack $w.cancel -side right -fill x -padx 20 -pady 20
6239 bind $w <Visibility> "grab $w; focus $w"
6240 tkwait window $w
6241 if {!$confirm_ok} return
6242 if {[catch {set fd [open \
6243 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6244 error_popup $err
6245 } else {
6246 dohidelocalchanges
6247 set w ".resetprogress"
6248 filerun $fd [list readresetstat $fd $w]
6249 toplevel $w
6250 wm transient $w
6251 wm title $w "Reset progress"
6252 message $w.m -text "Reset in progress, please wait..." \
6253 -justify center -aspect 1000
6254 pack $w.m -side top -fill x -padx 20 -pady 5
6255 canvas $w.c -width 150 -height 20 -bg white
6256 $w.c create rect 0 0 0 20 -fill green -tags rect
6257 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6258 nowbusy reset
6259 }
6260}
6261
6262proc readresetstat {fd w} {
6263 global mainhead mainheadid showlocalchanges
6264
6265 if {[gets $fd line] >= 0} {
6266 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6267 set x [expr {($m * 150) / $n}]
6268 $w.c coords rect 0 0 $x 20
6269 }
6270 return 1
6271 }
6272 destroy $w
6273 notbusy reset
6274 if {[catch {close $fd} err]} {
6275 error_popup $err
6276 }
6277 set oldhead $mainheadid
6278 set newhead [exec git rev-parse HEAD]
6279 if {$newhead ne $oldhead} {
6280 movehead $newhead $mainhead
6281 movedhead $newhead $mainhead
6282 set mainheadid $newhead
6283 redrawtags $oldhead
6284 redrawtags $newhead
6285 }
6286 if {$showlocalchanges} {
6287 doshowlocalchanges
6288 }
6289 return 0
6290}
6291
6292# context menu for a head
6293proc headmenu {x y id head} {
6294 global headmenuid headmenuhead headctxmenu mainhead
6295
6296 set headmenuid $id
6297 set headmenuhead $head
6298 set state normal
6299 if {$head eq $mainhead} {
6300 set state disabled
6301 }
6302 $headctxmenu entryconfigure 0 -state $state
6303 $headctxmenu entryconfigure 1 -state $state
6304 tk_popup $headctxmenu $x $y
6305}
6306
6307proc cobranch {} {
6308 global headmenuid headmenuhead mainhead headids
6309 global showlocalchanges mainheadid
6310
6311 # check the tree is clean first??
6312 set oldmainhead $mainhead
6313 nowbusy checkout
6314 update
6315 dohidelocalchanges
6316 if {[catch {
6317 exec git checkout -q $headmenuhead
6318 } err]} {
6319 notbusy checkout
6320 error_popup $err
6321 } else {
6322 notbusy checkout
6323 set mainhead $headmenuhead
6324 set mainheadid $headmenuid
6325 if {[info exists headids($oldmainhead)]} {
6326 redrawtags $headids($oldmainhead)
6327 }
6328 redrawtags $headmenuid
6329 }
6330 if {$showlocalchanges} {
6331 dodiffindex
6332 }
6333}
6334
6335proc rmbranch {} {
6336 global headmenuid headmenuhead mainhead
6337 global idheads
6338
6339 set head $headmenuhead
6340 set id $headmenuid
6341 # this check shouldn't be needed any more...
6342 if {$head eq $mainhead} {
6343 error_popup "Cannot delete the currently checked-out branch"
6344 return
6345 }
6346 set dheads [descheads $id]
6347 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6348 # the stuff on this branch isn't on any other branch
6349 if {![confirm_popup "The commits on branch $head aren't on any other\
6350 branch.\nReally delete branch $head?"]} return
6351 }
6352 nowbusy rmbranch
6353 update
6354 if {[catch {exec git branch -D $head} err]} {
6355 notbusy rmbranch
6356 error_popup $err
6357 return
6358 }
6359 removehead $id $head
6360 removedhead $id $head
6361 redrawtags $id
6362 notbusy rmbranch
6363 dispneartags 0
6364 run refill_reflist
6365}
6366
6367# Display a list of tags and heads
6368proc showrefs {} {
6369 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6370 global bglist fglist uifont reflistfilter reflist maincursor
6371
6372 set top .showrefs
6373 set showrefstop $top
6374 if {[winfo exists $top]} {
6375 raise $top
6376 refill_reflist
6377 return
6378 }
6379 toplevel $top
6380 wm title $top "Tags and heads: [file tail [pwd]]"
6381 text $top.list -background $bgcolor -foreground $fgcolor \
6382 -selectbackground $selectbgcolor -font $mainfont \
6383 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6384 -width 30 -height 20 -cursor $maincursor \
6385 -spacing1 1 -spacing3 1 -state disabled
6386 $top.list tag configure highlight -background $selectbgcolor
6387 lappend bglist $top.list
6388 lappend fglist $top.list
6389 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6390 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6391 grid $top.list $top.ysb -sticky nsew
6392 grid $top.xsb x -sticky ew
6393 frame $top.f
6394 label $top.f.l -text "Filter: " -font $uifont
6395 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6396 set reflistfilter "*"
6397 trace add variable reflistfilter write reflistfilter_change
6398 pack $top.f.e -side right -fill x -expand 1
6399 pack $top.f.l -side left
6400 grid $top.f - -sticky ew -pady 2
6401 button $top.close -command [list destroy $top] -text "Close" \
6402 -font $uifont
6403 grid $top.close -
6404 grid columnconfigure $top 0 -weight 1
6405 grid rowconfigure $top 0 -weight 1
6406 bind $top.list <1> {break}
6407 bind $top.list <B1-Motion> {break}
6408 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6409 set reflist {}
6410 refill_reflist
6411}
6412
6413proc sel_reflist {w x y} {
6414 global showrefstop reflist headids tagids otherrefids
6415
6416 if {![winfo exists $showrefstop]} return
6417 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6418 set ref [lindex $reflist [expr {$l-1}]]
6419 set n [lindex $ref 0]
6420 switch -- [lindex $ref 1] {
6421 "H" {selbyid $headids($n)}
6422 "T" {selbyid $tagids($n)}
6423 "o" {selbyid $otherrefids($n)}
6424 }
6425 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6426}
6427
6428proc unsel_reflist {} {
6429 global showrefstop
6430
6431 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6432 $showrefstop.list tag remove highlight 0.0 end
6433}
6434
6435proc reflistfilter_change {n1 n2 op} {
6436 global reflistfilter
6437
6438 after cancel refill_reflist
6439 after 200 refill_reflist
6440}
6441
6442proc refill_reflist {} {
6443 global reflist reflistfilter showrefstop headids tagids otherrefids
6444 global commitrow curview commitinterest
6445
6446 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6447 set refs {}
6448 foreach n [array names headids] {
6449 if {[string match $reflistfilter $n]} {
6450 if {[info exists commitrow($curview,$headids($n))]} {
6451 lappend refs [list $n H]
6452 } else {
6453 set commitinterest($headids($n)) {run refill_reflist}
6454 }
6455 }
6456 }
6457 foreach n [array names tagids] {
6458 if {[string match $reflistfilter $n]} {
6459 if {[info exists commitrow($curview,$tagids($n))]} {
6460 lappend refs [list $n T]
6461 } else {
6462 set commitinterest($tagids($n)) {run refill_reflist}
6463 }
6464 }
6465 }
6466 foreach n [array names otherrefids] {
6467 if {[string match $reflistfilter $n]} {
6468 if {[info exists commitrow($curview,$otherrefids($n))]} {
6469 lappend refs [list $n o]
6470 } else {
6471 set commitinterest($otherrefids($n)) {run refill_reflist}
6472 }
6473 }
6474 }
6475 set refs [lsort -index 0 $refs]
6476 if {$refs eq $reflist} return
6477
6478 # Update the contents of $showrefstop.list according to the
6479 # differences between $reflist (old) and $refs (new)
6480 $showrefstop.list conf -state normal
6481 $showrefstop.list insert end "\n"
6482 set i 0
6483 set j 0
6484 while {$i < [llength $reflist] || $j < [llength $refs]} {
6485 if {$i < [llength $reflist]} {
6486 if {$j < [llength $refs]} {
6487 set cmp [string compare [lindex $reflist $i 0] \
6488 [lindex $refs $j 0]]
6489 if {$cmp == 0} {
6490 set cmp [string compare [lindex $reflist $i 1] \
6491 [lindex $refs $j 1]]
6492 }
6493 } else {
6494 set cmp -1
6495 }
6496 } else {
6497 set cmp 1
6498 }
6499 switch -- $cmp {
6500 -1 {
6501 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6502 incr i
6503 }
6504 0 {
6505 incr i
6506 incr j
6507 }
6508 1 {
6509 set l [expr {$j + 1}]
6510 $showrefstop.list image create $l.0 -align baseline \
6511 -image reficon-[lindex $refs $j 1] -padx 2
6512 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6513 incr j
6514 }
6515 }
6516 }
6517 set reflist $refs
6518 # delete last newline
6519 $showrefstop.list delete end-2c end-1c
6520 $showrefstop.list conf -state disabled
6521}
6522
6523# Stuff for finding nearby tags
6524proc getallcommits {} {
6525 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6526 global idheads idtags idotherrefs allparents tagobjid
6527
6528 if {![info exists allcommits]} {
6529 set nextarc 0
6530 set allcommits 0
6531 set seeds {}
6532 set allcwait 0
6533 set cachedarcs 0
6534 set allccache [file join [gitdir] "gitk.cache"]
6535 if {![catch {
6536 set f [open $allccache r]
6537 set allcwait 1
6538 getcache $f
6539 }]} return
6540 }
6541
6542 if {$allcwait} {
6543 return
6544 }
6545 set cmd [list | git rev-list --parents]
6546 set allcupdate [expr {$seeds ne {}}]
6547 if {!$allcupdate} {
6548 set ids "--all"
6549 } else {
6550 set refs [concat [array names idheads] [array names idtags] \
6551 [array names idotherrefs]]
6552 set ids {}
6553 set tagobjs {}
6554 foreach name [array names tagobjid] {
6555 lappend tagobjs $tagobjid($name)
6556 }
6557 foreach id [lsort -unique $refs] {
6558 if {![info exists allparents($id)] &&
6559 [lsearch -exact $tagobjs $id] < 0} {
6560 lappend ids $id
6561 }
6562 }
6563 if {$ids ne {}} {
6564 foreach id $seeds {
6565 lappend ids "^$id"
6566 }
6567 }
6568 }
6569 if {$ids ne {}} {
6570 set fd [open [concat $cmd $ids] r]
6571 fconfigure $fd -blocking 0
6572 incr allcommits
6573 nowbusy allcommits
6574 filerun $fd [list getallclines $fd]
6575 } else {
6576 dispneartags 0
6577 }
6578}
6579
6580# Since most commits have 1 parent and 1 child, we group strings of
6581# such commits into "arcs" joining branch/merge points (BMPs), which
6582# are commits that either don't have 1 parent or don't have 1 child.
6583#
6584# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6585# arcout(id) - outgoing arcs for BMP
6586# arcids(a) - list of IDs on arc including end but not start
6587# arcstart(a) - BMP ID at start of arc
6588# arcend(a) - BMP ID at end of arc
6589# growing(a) - arc a is still growing
6590# arctags(a) - IDs out of arcids (excluding end) that have tags
6591# archeads(a) - IDs out of arcids (excluding end) that have heads
6592# The start of an arc is at the descendent end, so "incoming" means
6593# coming from descendents, and "outgoing" means going towards ancestors.
6594
6595proc getallclines {fd} {
6596 global allparents allchildren idtags idheads nextarc
6597 global arcnos arcids arctags arcout arcend arcstart archeads growing
6598 global seeds allcommits cachedarcs allcupdate
6599
6600 set nid 0
6601 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6602 set id [lindex $line 0]
6603 if {[info exists allparents($id)]} {
6604 # seen it already
6605 continue
6606 }
6607 set cachedarcs 0
6608 set olds [lrange $line 1 end]
6609 set allparents($id) $olds
6610 if {![info exists allchildren($id)]} {
6611 set allchildren($id) {}
6612 set arcnos($id) {}
6613 lappend seeds $id
6614 } else {
6615 set a $arcnos($id)
6616 if {[llength $olds] == 1 && [llength $a] == 1} {
6617 lappend arcids($a) $id
6618 if {[info exists idtags($id)]} {
6619 lappend arctags($a) $id
6620 }
6621 if {[info exists idheads($id)]} {
6622 lappend archeads($a) $id
6623 }
6624 if {[info exists allparents($olds)]} {
6625 # seen parent already
6626 if {![info exists arcout($olds)]} {
6627 splitarc $olds
6628 }
6629 lappend arcids($a) $olds
6630 set arcend($a) $olds
6631 unset growing($a)
6632 }
6633 lappend allchildren($olds) $id
6634 lappend arcnos($olds) $a
6635 continue
6636 }
6637 }
6638 foreach a $arcnos($id) {
6639 lappend arcids($a) $id
6640 set arcend($a) $id
6641 unset growing($a)
6642 }
6643
6644 set ao {}
6645 foreach p $olds {
6646 lappend allchildren($p) $id
6647 set a [incr nextarc]
6648 set arcstart($a) $id
6649 set archeads($a) {}
6650 set arctags($a) {}
6651 set archeads($a) {}
6652 set arcids($a) {}
6653 lappend ao $a
6654 set growing($a) 1
6655 if {[info exists allparents($p)]} {
6656 # seen it already, may need to make a new branch
6657 if {![info exists arcout($p)]} {
6658 splitarc $p
6659 }
6660 lappend arcids($a) $p
6661 set arcend($a) $p
6662 unset growing($a)
6663 }
6664 lappend arcnos($p) $a
6665 }
6666 set arcout($id) $ao
6667 }
6668 if {$nid > 0} {
6669 global cached_dheads cached_dtags cached_atags
6670 catch {unset cached_dheads}
6671 catch {unset cached_dtags}
6672 catch {unset cached_atags}
6673 }
6674 if {![eof $fd]} {
6675 return [expr {$nid >= 1000? 2: 1}]
6676 }
6677 set cacheok 1
6678 if {[catch {
6679 fconfigure $fd -blocking 1
6680 close $fd
6681 } err]} {
6682 # got an error reading the list of commits
6683 # if we were updating, try rereading the whole thing again
6684 if {$allcupdate} {
6685 incr allcommits -1
6686 dropcache $err
6687 return
6688 }
6689 error_popup "Error reading commit topology information;\
6690 branch and preceding/following tag information\
6691 will be incomplete.\n($err)"
6692 set cacheok 0
6693 }
6694 if {[incr allcommits -1] == 0} {
6695 notbusy allcommits
6696 if {$cacheok} {
6697 run savecache
6698 }
6699 }
6700 dispneartags 0
6701 return 0
6702}
6703
6704proc recalcarc {a} {
6705 global arctags archeads arcids idtags idheads
6706
6707 set at {}
6708 set ah {}
6709 foreach id [lrange $arcids($a) 0 end-1] {
6710 if {[info exists idtags($id)]} {
6711 lappend at $id
6712 }
6713 if {[info exists idheads($id)]} {
6714 lappend ah $id
6715 }
6716 }
6717 set arctags($a) $at
6718 set archeads($a) $ah
6719}
6720
6721proc splitarc {p} {
6722 global arcnos arcids nextarc arctags archeads idtags idheads
6723 global arcstart arcend arcout allparents growing
6724
6725 set a $arcnos($p)
6726 if {[llength $a] != 1} {
6727 puts "oops splitarc called but [llength $a] arcs already"
6728 return
6729 }
6730 set a [lindex $a 0]
6731 set i [lsearch -exact $arcids($a) $p]
6732 if {$i < 0} {
6733 puts "oops splitarc $p not in arc $a"
6734 return
6735 }
6736 set na [incr nextarc]
6737 if {[info exists arcend($a)]} {
6738 set arcend($na) $arcend($a)
6739 } else {
6740 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6741 set j [lsearch -exact $arcnos($l) $a]
6742 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6743 }
6744 set tail [lrange $arcids($a) [expr {$i+1}] end]
6745 set arcids($a) [lrange $arcids($a) 0 $i]
6746 set arcend($a) $p
6747 set arcstart($na) $p
6748 set arcout($p) $na
6749 set arcids($na) $tail
6750 if {[info exists growing($a)]} {
6751 set growing($na) 1
6752 unset growing($a)
6753 }
6754
6755 foreach id $tail {
6756 if {[llength $arcnos($id)] == 1} {
6757 set arcnos($id) $na
6758 } else {
6759 set j [lsearch -exact $arcnos($id) $a]
6760 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6761 }
6762 }
6763
6764 # reconstruct tags and heads lists
6765 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6766 recalcarc $a
6767 recalcarc $na
6768 } else {
6769 set arctags($na) {}
6770 set archeads($na) {}
6771 }
6772}
6773
6774# Update things for a new commit added that is a child of one
6775# existing commit. Used when cherry-picking.
6776proc addnewchild {id p} {
6777 global allparents allchildren idtags nextarc
6778 global arcnos arcids arctags arcout arcend arcstart archeads growing
6779 global seeds allcommits
6780
6781 if {![info exists allcommits]} return
6782 set allparents($id) [list $p]
6783 set allchildren($id) {}
6784 set arcnos($id) {}
6785 lappend seeds $id
6786 lappend allchildren($p) $id
6787 set a [incr nextarc]
6788 set arcstart($a) $id
6789 set archeads($a) {}
6790 set arctags($a) {}
6791 set arcids($a) [list $p]
6792 set arcend($a) $p
6793 if {![info exists arcout($p)]} {
6794 splitarc $p
6795 }
6796 lappend arcnos($p) $a
6797 set arcout($id) [list $a]
6798}
6799
6800# This implements a cache for the topology information.
6801# The cache saves, for each arc, the start and end of the arc,
6802# the ids on the arc, and the outgoing arcs from the end.
6803proc readcache {f} {
6804 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6805 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6806 global allcwait
6807
6808 set a $nextarc
6809 set lim $cachedarcs
6810 if {$lim - $a > 500} {
6811 set lim [expr {$a + 500}]
6812 }
6813 if {[catch {
6814 if {$a == $lim} {
6815 # finish reading the cache and setting up arctags, etc.
6816 set line [gets $f]
6817 if {$line ne "1"} {error "bad final version"}
6818 close $f
6819 foreach id [array names idtags] {
6820 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6821 [llength $allparents($id)] == 1} {
6822 set a [lindex $arcnos($id) 0]
6823 if {$arctags($a) eq {}} {
6824 recalcarc $a
6825 }
6826 }
6827 }
6828 foreach id [array names idheads] {
6829 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6830 [llength $allparents($id)] == 1} {
6831 set a [lindex $arcnos($id) 0]
6832 if {$archeads($a) eq {}} {
6833 recalcarc $a
6834 }
6835 }
6836 }
6837 foreach id [lsort -unique $possible_seeds] {
6838 if {$arcnos($id) eq {}} {
6839 lappend seeds $id
6840 }
6841 }
6842 set allcwait 0
6843 } else {
6844 while {[incr a] <= $lim} {
6845 set line [gets $f]
6846 if {[llength $line] != 3} {error "bad line"}
6847 set s [lindex $line 0]
6848 set arcstart($a) $s
6849 lappend arcout($s) $a
6850 if {![info exists arcnos($s)]} {
6851 lappend possible_seeds $s
6852 set arcnos($s) {}
6853 }
6854 set e [lindex $line 1]
6855 if {$e eq {}} {
6856 set growing($a) 1
6857 } else {
6858 set arcend($a) $e
6859 if {![info exists arcout($e)]} {
6860 set arcout($e) {}
6861 }
6862 }
6863 set arcids($a) [lindex $line 2]
6864 foreach id $arcids($a) {
6865 lappend allparents($s) $id
6866 set s $id
6867 lappend arcnos($id) $a
6868 }
6869 if {![info exists allparents($s)]} {
6870 set allparents($s) {}
6871 }
6872 set arctags($a) {}
6873 set archeads($a) {}
6874 }
6875 set nextarc [expr {$a - 1}]
6876 }
6877 } err]} {
6878 dropcache $err
6879 return 0
6880 }
6881 if {!$allcwait} {
6882 getallcommits
6883 }
6884 return $allcwait
6885}
6886
6887proc getcache {f} {
6888 global nextarc cachedarcs possible_seeds
6889
6890 if {[catch {
6891 set line [gets $f]
6892 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
6893 # make sure it's an integer
6894 set cachedarcs [expr {int([lindex $line 1])}]
6895 if {$cachedarcs < 0} {error "bad number of arcs"}
6896 set nextarc 0
6897 set possible_seeds {}
6898 run readcache $f
6899 } err]} {
6900 dropcache $err
6901 }
6902 return 0
6903}
6904
6905proc dropcache {err} {
6906 global allcwait nextarc cachedarcs seeds
6907
6908 #puts "dropping cache ($err)"
6909 foreach v {arcnos arcout arcids arcstart arcend growing \
6910 arctags archeads allparents allchildren} {
6911 global $v
6912 catch {unset $v}
6913 }
6914 set allcwait 0
6915 set nextarc 0
6916 set cachedarcs 0
6917 set seeds {}
6918 getallcommits
6919}
6920
6921proc writecache {f} {
6922 global cachearc cachedarcs allccache
6923 global arcstart arcend arcnos arcids arcout
6924
6925 set a $cachearc
6926 set lim $cachedarcs
6927 if {$lim - $a > 1000} {
6928 set lim [expr {$a + 1000}]
6929 }
6930 if {[catch {
6931 while {[incr a] <= $lim} {
6932 if {[info exists arcend($a)]} {
6933 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
6934 } else {
6935 puts $f [list $arcstart($a) {} $arcids($a)]
6936 }
6937 }
6938 } err]} {
6939 catch {close $f}
6940 catch {file delete $allccache}
6941 #puts "writing cache failed ($err)"
6942 return 0
6943 }
6944 set cachearc [expr {$a - 1}]
6945 if {$a > $cachedarcs} {
6946 puts $f "1"
6947 close $f
6948 return 0
6949 }
6950 return 1
6951}
6952
6953proc savecache {} {
6954 global nextarc cachedarcs cachearc allccache
6955
6956 if {$nextarc == $cachedarcs} return
6957 set cachearc 0
6958 set cachedarcs $nextarc
6959 catch {
6960 set f [open $allccache w]
6961 puts $f [list 1 $cachedarcs]
6962 run writecache $f
6963 }
6964}
6965
6966# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6967# or 0 if neither is true.
6968proc anc_or_desc {a b} {
6969 global arcout arcstart arcend arcnos cached_isanc
6970
6971 if {$arcnos($a) eq $arcnos($b)} {
6972 # Both are on the same arc(s); either both are the same BMP,
6973 # or if one is not a BMP, the other is also not a BMP or is
6974 # the BMP at end of the arc (and it only has 1 incoming arc).
6975 # Or both can be BMPs with no incoming arcs.
6976 if {$a eq $b || $arcnos($a) eq {}} {
6977 return 0
6978 }
6979 # assert {[llength $arcnos($a)] == 1}
6980 set arc [lindex $arcnos($a) 0]
6981 set i [lsearch -exact $arcids($arc) $a]
6982 set j [lsearch -exact $arcids($arc) $b]
6983 if {$i < 0 || $i > $j} {
6984 return 1
6985 } else {
6986 return -1
6987 }
6988 }
6989
6990 if {![info exists arcout($a)]} {
6991 set arc [lindex $arcnos($a) 0]
6992 if {[info exists arcend($arc)]} {
6993 set aend $arcend($arc)
6994 } else {
6995 set aend {}
6996 }
6997 set a $arcstart($arc)
6998 } else {
6999 set aend $a
7000 }
7001 if {![info exists arcout($b)]} {
7002 set arc [lindex $arcnos($b) 0]
7003 if {[info exists arcend($arc)]} {
7004 set bend $arcend($arc)
7005 } else {
7006 set bend {}
7007 }
7008 set b $arcstart($arc)
7009 } else {
7010 set bend $b
7011 }
7012 if {$a eq $bend} {
7013 return 1
7014 }
7015 if {$b eq $aend} {
7016 return -1
7017 }
7018 if {[info exists cached_isanc($a,$bend)]} {
7019 if {$cached_isanc($a,$bend)} {
7020 return 1
7021 }
7022 }
7023 if {[info exists cached_isanc($b,$aend)]} {
7024 if {$cached_isanc($b,$aend)} {
7025 return -1
7026 }
7027 if {[info exists cached_isanc($a,$bend)]} {
7028 return 0
7029 }
7030 }
7031
7032 set todo [list $a $b]
7033 set anc($a) a
7034 set anc($b) b
7035 for {set i 0} {$i < [llength $todo]} {incr i} {
7036 set x [lindex $todo $i]
7037 if {$anc($x) eq {}} {
7038 continue
7039 }
7040 foreach arc $arcnos($x) {
7041 set xd $arcstart($arc)
7042 if {$xd eq $bend} {
7043 set cached_isanc($a,$bend) 1
7044 set cached_isanc($b,$aend) 0
7045 return 1
7046 } elseif {$xd eq $aend} {
7047 set cached_isanc($b,$aend) 1
7048 set cached_isanc($a,$bend) 0
7049 return -1
7050 }
7051 if {![info exists anc($xd)]} {
7052 set anc($xd) $anc($x)
7053 lappend todo $xd
7054 } elseif {$anc($xd) ne $anc($x)} {
7055 set anc($xd) {}
7056 }
7057 }
7058 }
7059 set cached_isanc($a,$bend) 0
7060 set cached_isanc($b,$aend) 0
7061 return 0
7062}
7063
7064# This identifies whether $desc has an ancestor that is
7065# a growing tip of the graph and which is not an ancestor of $anc
7066# and returns 0 if so and 1 if not.
7067# If we subsequently discover a tag on such a growing tip, and that
7068# turns out to be a descendent of $anc (which it could, since we
7069# don't necessarily see children before parents), then $desc
7070# isn't a good choice to display as a descendent tag of
7071# $anc (since it is the descendent of another tag which is
7072# a descendent of $anc). Similarly, $anc isn't a good choice to
7073# display as a ancestor tag of $desc.
7074#
7075proc is_certain {desc anc} {
7076 global arcnos arcout arcstart arcend growing problems
7077
7078 set certain {}
7079 if {[llength $arcnos($anc)] == 1} {
7080 # tags on the same arc are certain
7081 if {$arcnos($desc) eq $arcnos($anc)} {
7082 return 1
7083 }
7084 if {![info exists arcout($anc)]} {
7085 # if $anc is partway along an arc, use the start of the arc instead
7086 set a [lindex $arcnos($anc) 0]
7087 set anc $arcstart($a)
7088 }
7089 }
7090 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7091 set x $desc
7092 } else {
7093 set a [lindex $arcnos($desc) 0]
7094 set x $arcend($a)
7095 }
7096 if {$x == $anc} {
7097 return 1
7098 }
7099 set anclist [list $x]
7100 set dl($x) 1
7101 set nnh 1
7102 set ngrowanc 0
7103 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7104 set x [lindex $anclist $i]
7105 if {$dl($x)} {
7106 incr nnh -1
7107 }
7108 set done($x) 1
7109 foreach a $arcout($x) {
7110 if {[info exists growing($a)]} {
7111 if {![info exists growanc($x)] && $dl($x)} {
7112 set growanc($x) 1
7113 incr ngrowanc
7114 }
7115 } else {
7116 set y $arcend($a)
7117 if {[info exists dl($y)]} {
7118 if {$dl($y)} {
7119 if {!$dl($x)} {
7120 set dl($y) 0
7121 if {![info exists done($y)]} {
7122 incr nnh -1
7123 }
7124 if {[info exists growanc($x)]} {
7125 incr ngrowanc -1
7126 }
7127 set xl [list $y]
7128 for {set k 0} {$k < [llength $xl]} {incr k} {
7129 set z [lindex $xl $k]
7130 foreach c $arcout($z) {
7131 if {[info exists arcend($c)]} {
7132 set v $arcend($c)
7133 if {[info exists dl($v)] && $dl($v)} {
7134 set dl($v) 0
7135 if {![info exists done($v)]} {
7136 incr nnh -1
7137 }
7138 if {[info exists growanc($v)]} {
7139 incr ngrowanc -1
7140 }
7141 lappend xl $v
7142 }
7143 }
7144 }
7145 }
7146 }
7147 }
7148 } elseif {$y eq $anc || !$dl($x)} {
7149 set dl($y) 0
7150 lappend anclist $y
7151 } else {
7152 set dl($y) 1
7153 lappend anclist $y
7154 incr nnh
7155 }
7156 }
7157 }
7158 }
7159 foreach x [array names growanc] {
7160 if {$dl($x)} {
7161 return 0
7162 }
7163 return 0
7164 }
7165 return 1
7166}
7167
7168proc validate_arctags {a} {
7169 global arctags idtags
7170
7171 set i -1
7172 set na $arctags($a)
7173 foreach id $arctags($a) {
7174 incr i
7175 if {![info exists idtags($id)]} {
7176 set na [lreplace $na $i $i]
7177 incr i -1
7178 }
7179 }
7180 set arctags($a) $na
7181}
7182
7183proc validate_archeads {a} {
7184 global archeads idheads
7185
7186 set i -1
7187 set na $archeads($a)
7188 foreach id $archeads($a) {
7189 incr i
7190 if {![info exists idheads($id)]} {
7191 set na [lreplace $na $i $i]
7192 incr i -1
7193 }
7194 }
7195 set archeads($a) $na
7196}
7197
7198# Return the list of IDs that have tags that are descendents of id,
7199# ignoring IDs that are descendents of IDs already reported.
7200proc desctags {id} {
7201 global arcnos arcstart arcids arctags idtags allparents
7202 global growing cached_dtags
7203
7204 if {![info exists allparents($id)]} {
7205 return {}
7206 }
7207 set t1 [clock clicks -milliseconds]
7208 set argid $id
7209 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7210 # part-way along an arc; check that arc first
7211 set a [lindex $arcnos($id) 0]
7212 if {$arctags($a) ne {}} {
7213 validate_arctags $a
7214 set i [lsearch -exact $arcids($a) $id]
7215 set tid {}
7216 foreach t $arctags($a) {
7217 set j [lsearch -exact $arcids($a) $t]
7218 if {$j >= $i} break
7219 set tid $t
7220 }
7221 if {$tid ne {}} {
7222 return $tid
7223 }
7224 }
7225 set id $arcstart($a)
7226 if {[info exists idtags($id)]} {
7227 return $id
7228 }
7229 }
7230 if {[info exists cached_dtags($id)]} {
7231 return $cached_dtags($id)
7232 }
7233
7234 set origid $id
7235 set todo [list $id]
7236 set queued($id) 1
7237 set nc 1
7238 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7239 set id [lindex $todo $i]
7240 set done($id) 1
7241 set ta [info exists hastaggedancestor($id)]
7242 if {!$ta} {
7243 incr nc -1
7244 }
7245 # ignore tags on starting node
7246 if {!$ta && $i > 0} {
7247 if {[info exists idtags($id)]} {
7248 set tagloc($id) $id
7249 set ta 1
7250 } elseif {[info exists cached_dtags($id)]} {
7251 set tagloc($id) $cached_dtags($id)
7252 set ta 1
7253 }
7254 }
7255 foreach a $arcnos($id) {
7256 set d $arcstart($a)
7257 if {!$ta && $arctags($a) ne {}} {
7258 validate_arctags $a
7259 if {$arctags($a) ne {}} {
7260 lappend tagloc($id) [lindex $arctags($a) end]
7261 }
7262 }
7263 if {$ta || $arctags($a) ne {}} {
7264 set tomark [list $d]
7265 for {set j 0} {$j < [llength $tomark]} {incr j} {
7266 set dd [lindex $tomark $j]
7267 if {![info exists hastaggedancestor($dd)]} {
7268 if {[info exists done($dd)]} {
7269 foreach b $arcnos($dd) {
7270 lappend tomark $arcstart($b)
7271 }
7272 if {[info exists tagloc($dd)]} {
7273 unset tagloc($dd)
7274 }
7275 } elseif {[info exists queued($dd)]} {
7276 incr nc -1
7277 }
7278 set hastaggedancestor($dd) 1
7279 }
7280 }
7281 }
7282 if {![info exists queued($d)]} {
7283 lappend todo $d
7284 set queued($d) 1
7285 if {![info exists hastaggedancestor($d)]} {
7286 incr nc
7287 }
7288 }
7289 }
7290 }
7291 set tags {}
7292 foreach id [array names tagloc] {
7293 if {![info exists hastaggedancestor($id)]} {
7294 foreach t $tagloc($id) {
7295 if {[lsearch -exact $tags $t] < 0} {
7296 lappend tags $t
7297 }
7298 }
7299 }
7300 }
7301 set t2 [clock clicks -milliseconds]
7302 set loopix $i
7303
7304 # remove tags that are descendents of other tags
7305 for {set i 0} {$i < [llength $tags]} {incr i} {
7306 set a [lindex $tags $i]
7307 for {set j 0} {$j < $i} {incr j} {
7308 set b [lindex $tags $j]
7309 set r [anc_or_desc $a $b]
7310 if {$r == 1} {
7311 set tags [lreplace $tags $j $j]
7312 incr j -1
7313 incr i -1
7314 } elseif {$r == -1} {
7315 set tags [lreplace $tags $i $i]
7316 incr i -1
7317 break
7318 }
7319 }
7320 }
7321
7322 if {[array names growing] ne {}} {
7323 # graph isn't finished, need to check if any tag could get
7324 # eclipsed by another tag coming later. Simply ignore any
7325 # tags that could later get eclipsed.
7326 set ctags {}
7327 foreach t $tags {
7328 if {[is_certain $t $origid]} {
7329 lappend ctags $t
7330 }
7331 }
7332 if {$tags eq $ctags} {
7333 set cached_dtags($origid) $tags
7334 } else {
7335 set tags $ctags
7336 }
7337 } else {
7338 set cached_dtags($origid) $tags
7339 }
7340 set t3 [clock clicks -milliseconds]
7341 if {0 && $t3 - $t1 >= 100} {
7342 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7343 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7344 }
7345 return $tags
7346}
7347
7348proc anctags {id} {
7349 global arcnos arcids arcout arcend arctags idtags allparents
7350 global growing cached_atags
7351
7352 if {![info exists allparents($id)]} {
7353 return {}
7354 }
7355 set t1 [clock clicks -milliseconds]
7356 set argid $id
7357 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7358 # part-way along an arc; check that arc first
7359 set a [lindex $arcnos($id) 0]
7360 if {$arctags($a) ne {}} {
7361 validate_arctags $a
7362 set i [lsearch -exact $arcids($a) $id]
7363 foreach t $arctags($a) {
7364 set j [lsearch -exact $arcids($a) $t]
7365 if {$j > $i} {
7366 return $t
7367 }
7368 }
7369 }
7370 if {![info exists arcend($a)]} {
7371 return {}
7372 }
7373 set id $arcend($a)
7374 if {[info exists idtags($id)]} {
7375 return $id
7376 }
7377 }
7378 if {[info exists cached_atags($id)]} {
7379 return $cached_atags($id)
7380 }
7381
7382 set origid $id
7383 set todo [list $id]
7384 set queued($id) 1
7385 set taglist {}
7386 set nc 1
7387 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7388 set id [lindex $todo $i]
7389 set done($id) 1
7390 set td [info exists hastaggeddescendent($id)]
7391 if {!$td} {
7392 incr nc -1
7393 }
7394 # ignore tags on starting node
7395 if {!$td && $i > 0} {
7396 if {[info exists idtags($id)]} {
7397 set tagloc($id) $id
7398 set td 1
7399 } elseif {[info exists cached_atags($id)]} {
7400 set tagloc($id) $cached_atags($id)
7401 set td 1
7402 }
7403 }
7404 foreach a $arcout($id) {
7405 if {!$td && $arctags($a) ne {}} {
7406 validate_arctags $a
7407 if {$arctags($a) ne {}} {
7408 lappend tagloc($id) [lindex $arctags($a) 0]
7409 }
7410 }
7411 if {![info exists arcend($a)]} continue
7412 set d $arcend($a)
7413 if {$td || $arctags($a) ne {}} {
7414 set tomark [list $d]
7415 for {set j 0} {$j < [llength $tomark]} {incr j} {
7416 set dd [lindex $tomark $j]
7417 if {![info exists hastaggeddescendent($dd)]} {
7418 if {[info exists done($dd)]} {
7419 foreach b $arcout($dd) {
7420 if {[info exists arcend($b)]} {
7421 lappend tomark $arcend($b)
7422 }
7423 }
7424 if {[info exists tagloc($dd)]} {
7425 unset tagloc($dd)
7426 }
7427 } elseif {[info exists queued($dd)]} {
7428 incr nc -1
7429 }
7430 set hastaggeddescendent($dd) 1
7431 }
7432 }
7433 }
7434 if {![info exists queued($d)]} {
7435 lappend todo $d
7436 set queued($d) 1
7437 if {![info exists hastaggeddescendent($d)]} {
7438 incr nc
7439 }
7440 }
7441 }
7442 }
7443 set t2 [clock clicks -milliseconds]
7444 set loopix $i
7445 set tags {}
7446 foreach id [array names tagloc] {
7447 if {![info exists hastaggeddescendent($id)]} {
7448 foreach t $tagloc($id) {
7449 if {[lsearch -exact $tags $t] < 0} {
7450 lappend tags $t
7451 }
7452 }
7453 }
7454 }
7455
7456 # remove tags that are ancestors of other tags
7457 for {set i 0} {$i < [llength $tags]} {incr i} {
7458 set a [lindex $tags $i]
7459 for {set j 0} {$j < $i} {incr j} {
7460 set b [lindex $tags $j]
7461 set r [anc_or_desc $a $b]
7462 if {$r == -1} {
7463 set tags [lreplace $tags $j $j]
7464 incr j -1
7465 incr i -1
7466 } elseif {$r == 1} {
7467 set tags [lreplace $tags $i $i]
7468 incr i -1
7469 break
7470 }
7471 }
7472 }
7473
7474 if {[array names growing] ne {}} {
7475 # graph isn't finished, need to check if any tag could get
7476 # eclipsed by another tag coming later. Simply ignore any
7477 # tags that could later get eclipsed.
7478 set ctags {}
7479 foreach t $tags {
7480 if {[is_certain $origid $t]} {
7481 lappend ctags $t
7482 }
7483 }
7484 if {$tags eq $ctags} {
7485 set cached_atags($origid) $tags
7486 } else {
7487 set tags $ctags
7488 }
7489 } else {
7490 set cached_atags($origid) $tags
7491 }
7492 set t3 [clock clicks -milliseconds]
7493 if {0 && $t3 - $t1 >= 100} {
7494 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7495 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7496 }
7497 return $tags
7498}
7499
7500# Return the list of IDs that have heads that are descendents of id,
7501# including id itself if it has a head.
7502proc descheads {id} {
7503 global arcnos arcstart arcids archeads idheads cached_dheads
7504 global allparents
7505
7506 if {![info exists allparents($id)]} {
7507 return {}
7508 }
7509 set aret {}
7510 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7511 # part-way along an arc; check it first
7512 set a [lindex $arcnos($id) 0]
7513 if {$archeads($a) ne {}} {
7514 validate_archeads $a
7515 set i [lsearch -exact $arcids($a) $id]
7516 foreach t $archeads($a) {
7517 set j [lsearch -exact $arcids($a) $t]
7518 if {$j > $i} break
7519 lappend aret $t
7520 }
7521 }
7522 set id $arcstart($a)
7523 }
7524 set origid $id
7525 set todo [list $id]
7526 set seen($id) 1
7527 set ret {}
7528 for {set i 0} {$i < [llength $todo]} {incr i} {
7529 set id [lindex $todo $i]
7530 if {[info exists cached_dheads($id)]} {
7531 set ret [concat $ret $cached_dheads($id)]
7532 } else {
7533 if {[info exists idheads($id)]} {
7534 lappend ret $id
7535 }
7536 foreach a $arcnos($id) {
7537 if {$archeads($a) ne {}} {
7538 validate_archeads $a
7539 if {$archeads($a) ne {}} {
7540 set ret [concat $ret $archeads($a)]
7541 }
7542 }
7543 set d $arcstart($a)
7544 if {![info exists seen($d)]} {
7545 lappend todo $d
7546 set seen($d) 1
7547 }
7548 }
7549 }
7550 }
7551 set ret [lsort -unique $ret]
7552 set cached_dheads($origid) $ret
7553 return [concat $ret $aret]
7554}
7555
7556proc addedtag {id} {
7557 global arcnos arcout cached_dtags cached_atags
7558
7559 if {![info exists arcnos($id)]} return
7560 if {![info exists arcout($id)]} {
7561 recalcarc [lindex $arcnos($id) 0]
7562 }
7563 catch {unset cached_dtags}
7564 catch {unset cached_atags}
7565}
7566
7567proc addedhead {hid head} {
7568 global arcnos arcout cached_dheads
7569
7570 if {![info exists arcnos($hid)]} return
7571 if {![info exists arcout($hid)]} {
7572 recalcarc [lindex $arcnos($hid) 0]
7573 }
7574 catch {unset cached_dheads}
7575}
7576
7577proc removedhead {hid head} {
7578 global cached_dheads
7579
7580 catch {unset cached_dheads}
7581}
7582
7583proc movedhead {hid head} {
7584 global arcnos arcout cached_dheads
7585
7586 if {![info exists arcnos($hid)]} return
7587 if {![info exists arcout($hid)]} {
7588 recalcarc [lindex $arcnos($hid) 0]
7589 }
7590 catch {unset cached_dheads}
7591}
7592
7593proc changedrefs {} {
7594 global cached_dheads cached_dtags cached_atags
7595 global arctags archeads arcnos arcout idheads idtags
7596
7597 foreach id [concat [array names idheads] [array names idtags]] {
7598 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7599 set a [lindex $arcnos($id) 0]
7600 if {![info exists donearc($a)]} {
7601 recalcarc $a
7602 set donearc($a) 1
7603 }
7604 }
7605 }
7606 catch {unset cached_dtags}
7607 catch {unset cached_atags}
7608 catch {unset cached_dheads}
7609}
7610
7611proc rereadrefs {} {
7612 global idtags idheads idotherrefs mainhead
7613
7614 set refids [concat [array names idtags] \
7615 [array names idheads] [array names idotherrefs]]
7616 foreach id $refids {
7617 if {![info exists ref($id)]} {
7618 set ref($id) [listrefs $id]
7619 }
7620 }
7621 set oldmainhead $mainhead
7622 readrefs
7623 changedrefs
7624 set refids [lsort -unique [concat $refids [array names idtags] \
7625 [array names idheads] [array names idotherrefs]]]
7626 foreach id $refids {
7627 set v [listrefs $id]
7628 if {![info exists ref($id)] || $ref($id) != $v ||
7629 ($id eq $oldmainhead && $id ne $mainhead) ||
7630 ($id eq $mainhead && $id ne $oldmainhead)} {
7631 redrawtags $id
7632 }
7633 }
7634 run refill_reflist
7635}
7636
7637proc listrefs {id} {
7638 global idtags idheads idotherrefs
7639
7640 set x {}
7641 if {[info exists idtags($id)]} {
7642 set x $idtags($id)
7643 }
7644 set y {}
7645 if {[info exists idheads($id)]} {
7646 set y $idheads($id)
7647 }
7648 set z {}
7649 if {[info exists idotherrefs($id)]} {
7650 set z $idotherrefs($id)
7651 }
7652 return [list $x $y $z]
7653}
7654
7655proc showtag {tag isnew} {
7656 global ctext tagcontents tagids linknum tagobjid
7657
7658 if {$isnew} {
7659 addtohistory [list showtag $tag 0]
7660 }
7661 $ctext conf -state normal
7662 clear_ctext
7663 set linknum 0
7664 if {![info exists tagcontents($tag)]} {
7665 catch {
7666 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7667 }
7668 }
7669 if {[info exists tagcontents($tag)]} {
7670 set text $tagcontents($tag)
7671 } else {
7672 set text "Tag: $tag\nId: $tagids($tag)"
7673 }
7674 appendwithlinks $text {}
7675 $ctext conf -state disabled
7676 init_flist {}
7677}
7678
7679proc doquit {} {
7680 global stopped
7681 set stopped 100
7682 savestuff .
7683 destroy .
7684}
7685
7686proc doprefs {} {
7687 global maxwidth maxgraphpct diffopts
7688 global oldprefs prefstop showneartags showlocalchanges
7689 global bgcolor fgcolor ctext diffcolors selectbgcolor
7690 global uifont tabstop
7691
7692 set top .gitkprefs
7693 set prefstop $top
7694 if {[winfo exists $top]} {
7695 raise $top
7696 return
7697 }
7698 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7699 set oldprefs($v) [set $v]
7700 }
7701 toplevel $top
7702 wm title $top "Gitk preferences"
7703 label $top.ldisp -text "Commit list display options"
7704 $top.ldisp configure -font $uifont
7705 grid $top.ldisp - -sticky w -pady 10
7706 label $top.spacer -text " "
7707 label $top.maxwidthl -text "Maximum graph width (lines)" \
7708 -font optionfont
7709 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7710 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7711 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7712 -font optionfont
7713 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7714 grid x $top.maxpctl $top.maxpct -sticky w
7715 frame $top.showlocal
7716 label $top.showlocal.l -text "Show local changes" -font optionfont
7717 checkbutton $top.showlocal.b -variable showlocalchanges
7718 pack $top.showlocal.b $top.showlocal.l -side left
7719 grid x $top.showlocal -sticky w
7720
7721 label $top.ddisp -text "Diff display options"
7722 $top.ddisp configure -font $uifont
7723 grid $top.ddisp - -sticky w -pady 10
7724 label $top.diffoptl -text "Options for diff program" \
7725 -font optionfont
7726 entry $top.diffopt -width 20 -textvariable diffopts
7727 grid x $top.diffoptl $top.diffopt -sticky w
7728 frame $top.ntag
7729 label $top.ntag.l -text "Display nearby tags" -font optionfont
7730 checkbutton $top.ntag.b -variable showneartags
7731 pack $top.ntag.b $top.ntag.l -side left
7732 grid x $top.ntag -sticky w
7733 label $top.tabstopl -text "tabstop" -font optionfont
7734 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7735 grid x $top.tabstopl $top.tabstop -sticky w
7736
7737 label $top.cdisp -text "Colors: press to choose"
7738 $top.cdisp configure -font $uifont
7739 grid $top.cdisp - -sticky w -pady 10
7740 label $top.bg -padx 40 -relief sunk -background $bgcolor
7741 button $top.bgbut -text "Background" -font optionfont \
7742 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7743 grid x $top.bgbut $top.bg -sticky w
7744 label $top.fg -padx 40 -relief sunk -background $fgcolor
7745 button $top.fgbut -text "Foreground" -font optionfont \
7746 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7747 grid x $top.fgbut $top.fg -sticky w
7748 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7749 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7750 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7751 [list $ctext tag conf d0 -foreground]]
7752 grid x $top.diffoldbut $top.diffold -sticky w
7753 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7754 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7755 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7756 [list $ctext tag conf d1 -foreground]]
7757 grid x $top.diffnewbut $top.diffnew -sticky w
7758 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7759 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7760 -command [list choosecolor diffcolors 2 $top.hunksep \
7761 "diff hunk header" \
7762 [list $ctext tag conf hunksep -foreground]]
7763 grid x $top.hunksepbut $top.hunksep -sticky w
7764 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7765 button $top.selbgbut -text "Select bg" -font optionfont \
7766 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7767 grid x $top.selbgbut $top.selbgsep -sticky w
7768
7769 frame $top.buts
7770 button $top.buts.ok -text "OK" -command prefsok -default active
7771 $top.buts.ok configure -font $uifont
7772 button $top.buts.can -text "Cancel" -command prefscan -default normal
7773 $top.buts.can configure -font $uifont
7774 grid $top.buts.ok $top.buts.can
7775 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7776 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7777 grid $top.buts - - -pady 10 -sticky ew
7778 bind $top <Visibility> "focus $top.buts.ok"
7779}
7780
7781proc choosecolor {v vi w x cmd} {
7782 global $v
7783
7784 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7785 -title "Gitk: choose color for $x"]
7786 if {$c eq {}} return
7787 $w conf -background $c
7788 lset $v $vi $c
7789 eval $cmd $c
7790}
7791
7792proc setselbg {c} {
7793 global bglist cflist
7794 foreach w $bglist {
7795 $w configure -selectbackground $c
7796 }
7797 $cflist tag configure highlight \
7798 -background [$cflist cget -selectbackground]
7799 allcanvs itemconf secsel -fill $c
7800}
7801
7802proc setbg {c} {
7803 global bglist
7804
7805 foreach w $bglist {
7806 $w conf -background $c
7807 }
7808}
7809
7810proc setfg {c} {
7811 global fglist canv
7812
7813 foreach w $fglist {
7814 $w conf -foreground $c
7815 }
7816 allcanvs itemconf text -fill $c
7817 $canv itemconf circle -outline $c
7818}
7819
7820proc prefscan {} {
7821 global maxwidth maxgraphpct diffopts
7822 global oldprefs prefstop showneartags showlocalchanges
7823
7824 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7825 set $v $oldprefs($v)
7826 }
7827 catch {destroy $prefstop}
7828 unset prefstop
7829}
7830
7831proc prefsok {} {
7832 global maxwidth maxgraphpct
7833 global oldprefs prefstop showneartags showlocalchanges
7834 global charspc ctext tabstop
7835
7836 catch {destroy $prefstop}
7837 unset prefstop
7838 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7839 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7840 if {$showlocalchanges} {
7841 doshowlocalchanges
7842 } else {
7843 dohidelocalchanges
7844 }
7845 }
7846 if {$maxwidth != $oldprefs(maxwidth)
7847 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7848 redisplay
7849 } elseif {$showneartags != $oldprefs(showneartags)} {
7850 reselectline
7851 }
7852}
7853
7854proc formatdate {d} {
7855 global datetimeformat
7856 if {$d ne {}} {
7857 set d [clock format $d -format $datetimeformat]
7858 }
7859 return $d
7860}
7861
7862# This list of encoding names and aliases is distilled from
7863# http://www.iana.org/assignments/character-sets.
7864# Not all of them are supported by Tcl.
7865set encoding_aliases {
7866 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7867 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7868 { ISO-10646-UTF-1 csISO10646UTF1 }
7869 { ISO_646.basic:1983 ref csISO646basic1983 }
7870 { INVARIANT csINVARIANT }
7871 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7872 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7873 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7874 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7875 { NATS-DANO iso-ir-9-1 csNATSDANO }
7876 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7877 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7878 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7879 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7880 { ISO-2022-KR csISO2022KR }
7881 { EUC-KR csEUCKR }
7882 { ISO-2022-JP csISO2022JP }
7883 { ISO-2022-JP-2 csISO2022JP2 }
7884 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7885 csISO13JISC6220jp }
7886 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7887 { IT iso-ir-15 ISO646-IT csISO15Italian }
7888 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7889 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7890 { greek7-old iso-ir-18 csISO18Greek7Old }
7891 { latin-greek iso-ir-19 csISO19LatinGreek }
7892 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7893 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7894 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7895 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7896 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7897 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7898 { INIS iso-ir-49 csISO49INIS }
7899 { INIS-8 iso-ir-50 csISO50INIS8 }
7900 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7901 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7902 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7903 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7904 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7905 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7906 csISO60Norwegian1 }
7907 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7908 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7909 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7910 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7911 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7912 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7913 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7914 { greek7 iso-ir-88 csISO88Greek7 }
7915 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7916 { iso-ir-90 csISO90 }
7917 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7918 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7919 csISO92JISC62991984b }
7920 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7921 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7922 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7923 csISO95JIS62291984handadd }
7924 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7925 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7926 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7927 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7928 CP819 csISOLatin1 }
7929 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7930 { T.61-7bit iso-ir-102 csISO102T617bit }
7931 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7932 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7933 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7934 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7935 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7936 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7937 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7938 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7939 arabic csISOLatinArabic }
7940 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7941 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7942 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7943 greek greek8 csISOLatinGreek }
7944 { T.101-G2 iso-ir-128 csISO128T101G2 }
7945 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7946 csISOLatinHebrew }
7947 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7948 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7949 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7950 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7951 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7952 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7953 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7954 csISOLatinCyrillic }
7955 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7956 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7957 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7958 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7959 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7960 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7961 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7962 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7963 { ISO_10367-box iso-ir-155 csISO10367Box }
7964 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7965 { latin-lap lap iso-ir-158 csISO158Lap }
7966 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7967 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7968 { us-dk csUSDK }
7969 { dk-us csDKUS }
7970 { JIS_X0201 X0201 csHalfWidthKatakana }
7971 { KSC5636 ISO646-KR csKSC5636 }
7972 { ISO-10646-UCS-2 csUnicode }
7973 { ISO-10646-UCS-4 csUCS4 }
7974 { DEC-MCS dec csDECMCS }
7975 { hp-roman8 roman8 r8 csHPRoman8 }
7976 { macintosh mac csMacintosh }
7977 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7978 csIBM037 }
7979 { IBM038 EBCDIC-INT cp038 csIBM038 }
7980 { IBM273 CP273 csIBM273 }
7981 { IBM274 EBCDIC-BE CP274 csIBM274 }
7982 { IBM275 EBCDIC-BR cp275 csIBM275 }
7983 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7984 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7985 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7986 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7987 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7988 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7989 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7990 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7991 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7992 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7993 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7994 { IBM437 cp437 437 csPC8CodePage437 }
7995 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7996 { IBM775 cp775 csPC775Baltic }
7997 { IBM850 cp850 850 csPC850Multilingual }
7998 { IBM851 cp851 851 csIBM851 }
7999 { IBM852 cp852 852 csPCp852 }
8000 { IBM855 cp855 855 csIBM855 }
8001 { IBM857 cp857 857 csIBM857 }
8002 { IBM860 cp860 860 csIBM860 }
8003 { IBM861 cp861 861 cp-is csIBM861 }
8004 { IBM862 cp862 862 csPC862LatinHebrew }
8005 { IBM863 cp863 863 csIBM863 }
8006 { IBM864 cp864 csIBM864 }
8007 { IBM865 cp865 865 csIBM865 }
8008 { IBM866 cp866 866 csIBM866 }
8009 { IBM868 CP868 cp-ar csIBM868 }
8010 { IBM869 cp869 869 cp-gr csIBM869 }
8011 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8012 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8013 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8014 { IBM891 cp891 csIBM891 }
8015 { IBM903 cp903 csIBM903 }
8016 { IBM904 cp904 904 csIBBM904 }
8017 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8018 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8019 { IBM1026 CP1026 csIBM1026 }
8020 { EBCDIC-AT-DE csIBMEBCDICATDE }
8021 { EBCDIC-AT-DE-A csEBCDICATDEA }
8022 { EBCDIC-CA-FR csEBCDICCAFR }
8023 { EBCDIC-DK-NO csEBCDICDKNO }
8024 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8025 { EBCDIC-FI-SE csEBCDICFISE }
8026 { EBCDIC-FI-SE-A csEBCDICFISEA }
8027 { EBCDIC-FR csEBCDICFR }
8028 { EBCDIC-IT csEBCDICIT }
8029 { EBCDIC-PT csEBCDICPT }
8030 { EBCDIC-ES csEBCDICES }
8031 { EBCDIC-ES-A csEBCDICESA }
8032 { EBCDIC-ES-S csEBCDICESS }
8033 { EBCDIC-UK csEBCDICUK }
8034 { EBCDIC-US csEBCDICUS }
8035 { UNKNOWN-8BIT csUnknown8BiT }
8036 { MNEMONIC csMnemonic }
8037 { MNEM csMnem }
8038 { VISCII csVISCII }
8039 { VIQR csVIQR }
8040 { KOI8-R csKOI8R }
8041 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8042 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8043 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8044 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8045 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8046 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8047 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8048 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8049 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8050 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8051 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8052 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8053 { IBM1047 IBM-1047 }
8054 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8055 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8056 { UNICODE-1-1 csUnicode11 }
8057 { CESU-8 csCESU-8 }
8058 { BOCU-1 csBOCU-1 }
8059 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8060 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8061 l8 }
8062 { ISO-8859-15 ISO_8859-15 Latin-9 }
8063 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8064 { GBK CP936 MS936 windows-936 }
8065 { JIS_Encoding csJISEncoding }
8066 { Shift_JIS MS_Kanji csShiftJIS }
8067 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8068 EUC-JP }
8069 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8070 { ISO-10646-UCS-Basic csUnicodeASCII }
8071 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8072 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8073 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8074 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8075 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8076 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8077 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8078 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8079 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8080 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8081 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8082 { Ventura-US csVenturaUS }
8083 { Ventura-International csVenturaInternational }
8084 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8085 { PC8-Turkish csPC8Turkish }
8086 { IBM-Symbols csIBMSymbols }
8087 { IBM-Thai csIBMThai }
8088 { HP-Legal csHPLegal }
8089 { HP-Pi-font csHPPiFont }
8090 { HP-Math8 csHPMath8 }
8091 { Adobe-Symbol-Encoding csHPPSMath }
8092 { HP-DeskTop csHPDesktop }
8093 { Ventura-Math csVenturaMath }
8094 { Microsoft-Publishing csMicrosoftPublishing }
8095 { Windows-31J csWindows31J }
8096 { GB2312 csGB2312 }
8097 { Big5 csBig5 }
8098}
8099
8100proc tcl_encoding {enc} {
8101 global encoding_aliases
8102 set names [encoding names]
8103 set lcnames [string tolower $names]
8104 set enc [string tolower $enc]
8105 set i [lsearch -exact $lcnames $enc]
8106 if {$i < 0} {
8107 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8108 if {[regsub {^iso[-_]} $enc iso encx]} {
8109 set i [lsearch -exact $lcnames $encx]
8110 }
8111 }
8112 if {$i < 0} {
8113 foreach l $encoding_aliases {
8114 set ll [string tolower $l]
8115 if {[lsearch -exact $ll $enc] < 0} continue
8116 # look through the aliases for one that tcl knows about
8117 foreach e $ll {
8118 set i [lsearch -exact $lcnames $e]
8119 if {$i < 0} {
8120 if {[regsub {^iso[-_]} $e iso ex]} {
8121 set i [lsearch -exact $lcnames $ex]
8122 }
8123 }
8124 if {$i >= 0} break
8125 }
8126 break
8127 }
8128 }
8129 if {$i >= 0} {
8130 return [lindex $names $i]
8131 }
8132 return {}
8133}
8134
8135# defaults...
8136set datemode 0
8137set diffopts "-U 5 -p"
8138set wrcomcmd "git diff-tree --stdin -p --pretty"
8139
8140set gitencoding {}
8141catch {
8142 set gitencoding [exec git config --get i18n.commitencoding]
8143}
8144if {$gitencoding == ""} {
8145 set gitencoding "utf-8"
8146}
8147set tclencoding [tcl_encoding $gitencoding]
8148if {$tclencoding == {}} {
8149 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8150}
8151
8152set mainfont {Helvetica 9}
8153set textfont {Courier 9}
8154set uifont {Helvetica 9 bold}
8155set tabstop 8
8156set findmergefiles 0
8157set maxgraphpct 50
8158set maxwidth 16
8159set revlistorder 0
8160set fastdate 0
8161set uparrowlen 5
8162set downarrowlen 5
8163set mingaplen 100
8164set cmitmode "patch"
8165set wrapcomment "none"
8166set showneartags 1
8167set maxrefs 20
8168set maxlinelen 200
8169set showlocalchanges 1
8170set datetimeformat "%Y-%m-%d %H:%M:%S"
8171
8172set colors {green red blue magenta darkgrey brown orange}
8173set bgcolor white
8174set fgcolor black
8175set diffcolors {red "#00a000" blue}
8176set diffcontext 3
8177set selectbgcolor gray85
8178
8179catch {source ~/.gitk}
8180
8181font create optionfont -family sans-serif -size -12
8182
8183# check that we can find a .git directory somewhere...
8184if {[catch {set gitdir [gitdir]}]} {
8185 show_error {} . "Cannot find a git repository here."
8186 exit 1
8187}
8188if {![file isdirectory $gitdir]} {
8189 show_error {} . "Cannot find the git directory \"$gitdir\"."
8190 exit 1
8191}
8192
8193set revtreeargs {}
8194set cmdline_files {}
8195set i 0
8196foreach arg $argv {
8197 switch -- $arg {
8198 "" { }
8199 "-d" { set datemode 1 }
8200 "--" {
8201 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8202 break
8203 }
8204 default {
8205 lappend revtreeargs $arg
8206 }
8207 }
8208 incr i
8209}
8210
8211if {$i >= [llength $argv] && $revtreeargs ne {}} {
8212 # no -- on command line, but some arguments (other than -d)
8213 if {[catch {
8214 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8215 set cmdline_files [split $f "\n"]
8216 set n [llength $cmdline_files]
8217 set revtreeargs [lrange $revtreeargs 0 end-$n]
8218 # Unfortunately git rev-parse doesn't produce an error when
8219 # something is both a revision and a filename. To be consistent
8220 # with git log and git rev-list, check revtreeargs for filenames.
8221 foreach arg $revtreeargs {
8222 if {[file exists $arg]} {
8223 show_error {} . "Ambiguous argument '$arg': both revision\
8224 and filename"
8225 exit 1
8226 }
8227 }
8228 } err]} {
8229 # unfortunately we get both stdout and stderr in $err,
8230 # so look for "fatal:".
8231 set i [string first "fatal:" $err]
8232 if {$i > 0} {
8233 set err [string range $err [expr {$i + 6}] end]
8234 }
8235 show_error {} . "Bad arguments to gitk:\n$err"
8236 exit 1
8237 }
8238}
8239
8240set nullid "0000000000000000000000000000000000000000"
8241set nullid2 "0000000000000000000000000000000000000001"
8242
8243
8244set runq {}
8245set history {}
8246set historyindex 0
8247set fh_serial 0
8248set nhl_names {}
8249set highlight_paths {}
8250set findpattern {}
8251set searchdirn -forwards
8252set boldrows {}
8253set boldnamerows {}
8254set diffelide {0 0}
8255set markingmatches 0
8256set linkentercount 0
8257set need_redisplay 0
8258set nrows_drawn 0
8259
8260set nextviewnum 1
8261set curview 0
8262set selectedview 0
8263set selectedhlview None
8264set highlight_related None
8265set highlight_files {}
8266set viewfiles(0) {}
8267set viewperm(0) 0
8268set viewargs(0) {}
8269
8270set cmdlineok 0
8271set stopped 0
8272set stuffsaved 0
8273set patchnum 0
8274set localirow -1
8275set localfrow -1
8276set lserial 0
8277setcoords
8278makewindow
8279# wait for the window to become visible
8280tkwait visibility .
8281wm title . "[file tail $argv0]: [file tail [pwd]]"
8282readrefs
8283
8284if {$cmdline_files ne {} || $revtreeargs ne {}} {
8285 # create a view for the files/dirs specified on the command line
8286 set curview 1
8287 set selectedview 1
8288 set nextviewnum 2
8289 set viewname(1) "Command line"
8290 set viewfiles(1) $cmdline_files
8291 set viewargs(1) $revtreeargs
8292 set viewperm(1) 0
8293 addviewmenu 1
8294 .bar.view entryconf Edit* -state normal
8295 .bar.view entryconf Delete* -state normal
8296}
8297
8298if {[info exists permviews]} {
8299 foreach v $permviews {
8300 set n $nextviewnum
8301 incr nextviewnum
8302 set viewname($n) [lindex $v 0]
8303 set viewfiles($n) [lindex $v 1]
8304 set viewargs($n) [lindex $v 2]
8305 set viewperm($n) 1
8306 addviewmenu $n
8307 }
8308}
8309getcommits