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