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