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