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