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