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