2 # Tcl ignores the next line -*- tcl -*- \
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.
12 if {[info exists env
(GIT_DIR
)]} {
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.
28 if {[info exists isonrunq
($script)]} return
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} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 set tstart
[clock clicks
-milliseconds]
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]
68 fileevent
$fd readable
[list filereadable
$fd $script]
70 } elseif
{$fd eq
{}} {
71 unset isonrunq
($script)
74 if {$t1 - $tstart >= 80} break
81 # Start off a git rev-list process and arrange to read its output
82 proc start_rev_list
{view
} {
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"
93 set order
"--date-order"
96 set fd
[open
[concat | git log
-z --pretty=raw
$order --parents \
97 --boundary $viewargs($view) "--" $viewfiles($view)] r
]
99 error_popup
"Error executing git rev-list: $err"
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]
113 proc stop_rev_list
{} {
114 global commfd curview
116 if {![info exists commfd
($curview)]} return
117 set fd
$commfd($curview)
123 unset commfd
($curview)
127 global phase canv mainfont curview
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
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
} {
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]} {
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
177 lappend vparentlist
($view) {}
178 lappend vdisporder
($view) $id
179 lappend vcmitlisted
($view) 0
185 # set it blocking so we wait for the process to terminate
186 fconfigure
$fd -blocking 1
187 if {[catch
{close
$fd} err
]} {
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"} {
197 " (Note: arguments to gitk are passed to git rev-list\
198 to allow selection of commits to be displayed.)"
201 set err
"Error reading commits$fv: $err"
205 if {$view == $curview} {
206 run chewcommits
$view
213 set i
[string first
"\0" $stuff $start]
215 append leftover
($view) [string range
$stuff $start end
]
219 set cmit
$leftover($view)
220 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
221 set leftover
($view) {}
223 set cmit
[string range
$stuff $start [expr {$i - 1}]]
225 set start
[expr {$i + 1}]
226 set j
[string first
"\n" $cmit]
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] {
237 set ids
[string range
$ids 1 end
]
241 if {[string length
$id] != 40} {
249 if {[string length
$shortcmit] > 80} {
250 set shortcmit
"[string range $shortcmit 0 80]..."
252 error_popup
"Can't parse git log output: {$shortcmit}"
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
261 set otok
$ordertok($view,$id)
262 unset idpending
($view,$id)
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
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
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
300 lappend vparentlist
($view) $olds
301 lappend vdisporder
($view) $id
302 lappend vcmitlisted
($view) $listed
307 run chewcommits
$view
312 proc chewcommits
{view
} {
313 global curview hlview commfd
314 global selectedline pending_select
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
]
329 if {$commitidx($curview) > 0} {
330 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
331 #puts "overall $ms ms for $numcommits commits"
333 show_status
"No commits selected"
339 if {[info exists hlview
] && $view == $hlview} {
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
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)
368 catch
{unset selectedline
}
369 catch
{unset thickerline
}
370 catch
{unset viewdata
($n)}
379 proc parsecommit
{id contents listed
} {
380 global commitinfo cdate
389 set hdrend
[string first
"\n\n" $contents]
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
]
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]
411 set headline
[string range
$headline 0 $i]
413 set headline
[string trimright
$headline]
414 set i
[string first
"\r" $headline]
416 set headline
[string trimright
[string range
$headline 0 $i]]
419 # git rev-list indents the comment by 4 spaces;
420 # if we got this via git cat-file, add the indentation
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
443 if {![info exists commitinfo
($id)]} {
444 set commitinfo
($id) {"No commit information available"}
451 global tagids idtags headids idheads tagobjid
452 global otherrefids idotherrefs mainhead mainheadid
454 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
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
]
480 set tagobjid
($name) $id
482 set tagids
($name) $id
483 lappend idtags
($id) $name
485 set otherrefids
($name) $id
486 lappend idotherrefs
($id) $name
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} {
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} {
532 set i
[lsearch
-exact $idheads($id) $name]
534 set idheads
($id) [lreplace
$idheads($id) $i $i]
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"
550 proc error_popup msg
{
554 show_error
$w $w $msg
557 proc confirm_popup msg
{
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"
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
588 .bar add cascade
-label "File" -menu .bar.
file
589 .bar configure
-font $uifont
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
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 \
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
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
)
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
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
646 -selectbackground $selectbgcolor \
647 -background $bgcolor -bd 0 -yscrollincr $linespc
648 .tf.histframe.pwclist add
$canv2
649 set canv3 .tf.histframe.pwclist.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
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
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
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 " \
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
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
)
776 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
781 button .bleft.top.search
-text "Search" -command dosearch \
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: " \
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
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
847 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
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"]
863 -selectbackground $selectbgcolor \
864 -background $bgcolor -foreground $fgcolor \
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
882 # restore window position if known
883 if {[info exists geometry
(main
)]} {
884 wm geometry .
"$geometry(main)"
887 if {[tk windowingsystem
] eq
{aqua
}} {
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 }
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"
929 bindkey i
"selnextline -1"
930 bindkey k
"selnextline 1"
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}
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" \
976 $rowctxmenu add command -label "Reset HEAD branch to here" \
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" \
994 $headctxmenu add command -label "Remove this branch" \
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]
1013 set u [expr {$D < 0 ? 5 : -5}]
1014 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1015 allcanvs yview scroll $u units
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] {
1037 proc scrollcanv {cscroll f0 f1} {
1038 $cscroll set $f0 $f1
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} {
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
1061 global ctext entries
1062 foreach e [concat $entries $ctext] {
1063 if {$w == $e} return
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
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)]}"
1115 file rename -force "~/.gitk-new" "~/.gitk"
1120 proc resizeclistpanes {win w} {
1122 if {[info exists oldwidth($win)]} {
1123 set s0 [$win sash coord 0]
1124 set s1 [$win sash coord 1]
1126 set sash0 [expr {int($w/2 - 2)}]
1127 set sash1 [expr {int($w*5/6 - 2)}]
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])}]
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} {
1153 if {[info exists oldwidth($win)]} {
1154 set s0 [$win sash coord 0]
1156 set sash0 [expr {int($w*3/4 - 2)}]
1158 set factor [expr {1.0 * $w / $oldwidth($win)}]
1159 set sash0 [expr {int($factor * [lindex $s0 0])}]
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
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
1189 if {[winfo exists $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"
1215 if {[winfo exists $w]} {
1219 if {[tk windowingsystem] eq {aqua}} {
1225 wm title $w "Gitk key bindings"
1226 message $w.m -text "
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
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
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
1290 set treecontents() {}
1291 $w conf -state normal
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]
1306 set tail [string range $f [expr {$prefixend+1}] end]
1307 while {[set slash [string first "/" $tail]] >= 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
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} {
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
1327 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1329 $w image create end -align center -image $bm -padx 1 \
1331 $w insert end $d [highlight_tag $prefix]
1332 $w mark set s:$ix "end -1c"
1333 $w mark gravity s:$ix left
1338 if {$lev <= $openlevs} {
1341 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
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
1365 foreach e $treecontents($prefix) {
1370 if {[string index $e end] eq "/"} {
1371 set n $treeheight($prefix$e)
1383 proc highlight_tree {y prefix} {
1384 global treeheight treecontents cflist
1386 foreach e $treecontents($prefix) {
1388 if {[highlight_tag $path] ne {}} {
1389 $cflist tag add bold $y.0 "$y.0 lineend"
1392 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1393 set y [highlight_tree $y $path]
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
1425 set n [llength $treecontents($dir)]
1426 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1429 incr treeheight($x) $n
1431 foreach e $treecontents($dir) {
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 \
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
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]
1458 } elseif {$l + $n + 1 > $top + $ht} {
1459 set top [expr {$l + $n + 2 - $ht}]
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"
1480 set e [linetoelt $l]
1481 if {[string index $e end] ne "/"} {
1483 } elseif {$treediropen($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,
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,
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,
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,
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};
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};
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};
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
1565 $cflist insert end $first
1567 $cflist tag add highlight 1.0 "1.0 lineend"
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]} {
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"
1601 $cflist conf -state disabled
1604 proc unhighlight_filelist {} {
1607 $cflist conf -state normal
1608 $cflist tag remove bold 1.0 end
1609 $cflist conf -state disabled
1612 proc add_flist {fl} {
1615 $cflist conf -state normal
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"
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]
1645 if {$cmitmode eq "tree"} {
1646 set e [linetoelt $l]
1647 if {[string index $e end] eq "/"} return
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
1662 append highlight_files " " $x
1666 # Functions for adding and removing shell-type quoting
1668 proc shellquote {str} {
1669 if {![string match "*\['\"\\ \t]*" $str]} {
1672 if {![string match "*\['\"\\]*" $str]} {
1675 if {![string match "*'*" $str]} {
1678 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1681 proc shellarglist {l} {
1687 append str [shellquote $a]
1692 proc shelldequote {str} {
1697 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1698 append ret [string range $str $used end]
1699 set used [string length $str]
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}]]
1708 if {$ch eq " " || $ch eq "\t"} break
1711 set first [string first "'" $str $used]
1713 error "unmatched single-quote"
1715 append ret [string range $str $used [expr {$first - 1}]]
1720 if {$used >= [string length $str]} {
1721 error "trailing backslash"
1723 append ret [string index $str $used]
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}]]
1737 if {$ch eq "\""} break
1739 append ret [string index $str $used]
1743 return [list $used $ret]
1746 proc shellsplit {str} {
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]
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
1768 if {[winfo exists $top]} {
1772 set newviewname($nextviewnum) "View $nextviewnum"
1773 set newviewperm($nextviewnum) 0
1774 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1775 vieweditor $top $nextviewnum "Gitk view definition"
1780 global viewname viewperm newviewname newviewperm
1781 global viewargs newviewargs
1783 set top .gitkvedit-$curview
1784 if {[winfo exists $top]} {
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
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) \
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
1826 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1828 button $top.buts.can -text "Cancel" -command [list destroy $top] \
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
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
1847 proc allviewmenus {n op args} {
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
1860 set newargs [shellsplit $newviewargs($n)]
1862 error_popup "Error in commit selection arguments: $err"
1868 foreach f [split [$top.t get 0.0 end] "\n"] {
1869 set ft [string trim $f]
1874 if {![info exists viewfiles($n)]} {
1875 # creating a new view
1877 set viewname($n) $newviewname($n)
1878 set viewperm($n) $newviewperm($n)
1879 set viewfiles($n) $files
1880 set viewargs($n) $newargs
1882 if {!$newishighlight} {
1885 run addvhighlight $n
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} {
1905 catch {destroy $top}
1909 global curview viewdata viewperm hlview selectedhlview
1911 if {$curview == 0} return
1912 if {[info exists hlview] && $hlview == $curview} {
1913 set selectedhlview None
1916 allviewmenus $curview delete
1917 set viewdata($curview) {}
1918 set viewperm($curview) 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} {
1935 foreach i [array names $var] {
1936 lappend ret $i [set $var\($i\)]
1941 proc unflatten {var l} {
1951 global curview viewdata viewfiles
1952 global displayorder parentlist rowidlist rowisopt
1953 global colormap rowtextx commitrow nextcolor canvxmax
1954 global numcommits commitlisted
1955 global selectedline currentid canv canvy0
1957 global pending_select phase
1960 global selectedview selectfirst
1961 global vparentlist vdisporder vcmitlisted
1962 global hlview selectedhlview commitinterest
1964 if {$n == $curview} return
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}]
1976 set yscreen [expr {($ybot - $ytop) / 2}]
1978 } elseif {[info exists pending_select]} {
1979 set selid $pending_select
1980 unset pending_select
1984 if {$curview >= 0} {
1985 set vparentlist($curview) $parentlist
1986 set vdisporder($curview) $displayorder
1987 set vcmitlisted($curview) $commitlisted
1989 set viewdata($curview) \
1990 [list $phase $rowidlist $rowisopt $numcommits]
1991 } elseif {![info exists viewdata($curview)]
1992 || [lindex $viewdata($curview) 0] ne {}} {
1993 set viewdata($curview) \
1994 [list {} $rowidlist $rowisopt]
1997 catch {unset treediffs}
1999 if {[info exists hlview] && $hlview == $n} {
2001 set selectedhlview None
2003 catch {unset commitinterest}
2007 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2008 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2011 if {![info exists viewdata($n)]} {
2013 set pending_select $selid
2020 set phase [lindex $v 0]
2021 set displayorder $vdisporder($n)
2022 set parentlist $vparentlist($n)
2023 set commitlisted $vcmitlisted($n)
2024 set rowidlist [lindex $v 1]
2025 set rowisopt [lindex $v 2]
2027 set numcommits [llength $displayorder]
2029 set numcommits [lindex $v 3]
2032 catch {unset colormap}
2033 catch {unset rowtextx}
2035 set canvxmax [$canv cget -width]
2042 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2043 set row $commitrow($n,$selid)
2044 # try to get the selected row in the same position on the screen
2045 set ymax [lindex [$canv cget -scrollregion] 3]
2046 set ytop [expr {[yc $row] - $yscreen}]
2050 set yf [expr {$ytop * 1.0 / $ymax}]
2052 allcanvs yview moveto $yf
2056 } elseif {$selid ne {}} {
2057 set pending_select $selid
2059 set row [first_real_row]
2060 if {$row < $numcommits} {
2067 if {$phase eq "getcommits"} {
2068 show_status "Reading commits..."
2071 } elseif {$numcommits == 0} {
2072 show_status "No commits selected"
2076 # Stuff relating to the highlighting facility
2078 proc ishighlighted {row} {
2079 global vhighlights fhighlights nhighlights rhighlights
2081 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2082 return $nhighlights($row)
2084 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2085 return $vhighlights($row)
2087 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2088 return $fhighlights($row)
2090 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2091 return $rhighlights($row)
2096 proc bolden {row font} {
2097 global canv linehtag selectedline boldrows
2099 lappend boldrows $row
2100 $canv itemconf $linehtag($row) -font $font
2101 if {[info exists selectedline] && $row == $selectedline} {
2103 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2104 -outline {{}} -tags secsel \
2105 -fill [$canv cget -selectbackground]]
2110 proc bolden_name {row font} {
2111 global canv2 linentag selectedline boldnamerows
2113 lappend boldnamerows $row
2114 $canv2 itemconf $linentag($row) -font $font
2115 if {[info exists selectedline] && $row == $selectedline} {
2116 $canv2 delete secsel
2117 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2118 -outline {{}} -tags secsel \
2119 -fill [$canv2 cget -selectbackground]]
2125 global mainfont boldrows
2128 foreach row $boldrows {
2129 if {![ishighlighted $row]} {
2130 bolden $row $mainfont
2132 lappend stillbold $row
2135 set boldrows $stillbold
2138 proc addvhighlight {n} {
2139 global hlview curview viewdata vhl_done vhighlights commitidx
2141 if {[info exists hlview]} {
2145 if {$n != $curview && ![info exists viewdata($n)]} {
2146 set viewdata($n) [list getcommits {{}} 0 0 0]
2147 set vparentlist($n) {}
2148 set vdisporder($n) {}
2149 set vcmitlisted($n) {}
2152 set vhl_done $commitidx($hlview)
2153 if {$vhl_done > 0} {
2158 proc delvhighlight {} {
2159 global hlview vhighlights
2161 if {![info exists hlview]} return
2163 catch {unset vhighlights}
2167 proc vhighlightmore {} {
2168 global hlview vhl_done commitidx vhighlights
2169 global displayorder vdisporder curview mainfont
2171 set font [concat $mainfont bold]
2172 set max $commitidx($hlview)
2173 if {$hlview == $curview} {
2174 set disp $displayorder
2176 set disp $vdisporder($hlview)
2178 set vr [visiblerows]
2179 set r0 [lindex $vr 0]
2180 set r1 [lindex $vr 1]
2181 for {set i $vhl_done} {$i < $max} {incr i} {
2182 set id [lindex $disp $i]
2183 if {[info exists commitrow($curview,$id)]} {
2184 set row $commitrow($curview,$id)
2185 if {$r0 <= $row && $row <= $r1} {
2186 if {![highlighted $row]} {
2189 set vhighlights($row) 1
2196 proc askvhighlight {row id} {
2197 global hlview vhighlights commitrow iddrawn mainfont
2199 if {[info exists commitrow($hlview,$id)]} {
2200 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2201 bolden $row [concat $mainfont bold]
2203 set vhighlights($row) 1
2205 set vhighlights($row) 0
2209 proc hfiles_change {name ix op} {
2210 global highlight_files filehighlight fhighlights fh_serial
2211 global mainfont highlight_paths
2213 if {[info exists filehighlight]} {
2214 # delete previous highlights
2215 catch {close $filehighlight}
2217 catch {unset fhighlights}
2219 unhighlight_filelist
2221 set highlight_paths {}
2222 after cancel do_file_hl $fh_serial
2224 if {$highlight_files ne {}} {
2225 after 300 do_file_hl $fh_serial
2229 proc makepatterns {l} {
2232 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2233 if {[string index $ee end] eq "/"} {
2243 proc do_file_hl {serial} {
2244 global highlight_files filehighlight highlight_paths gdttype fhl_list
2246 if {$gdttype eq "touching paths:"} {
2247 if {[catch {set paths [shellsplit $highlight_files]}]} return
2248 set highlight_paths [makepatterns $paths]
2250 set gdtargs [concat -- $paths]
2252 set gdtargs [list "-S$highlight_files"]
2254 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2255 set filehighlight [open $cmd r+]
2256 fconfigure $filehighlight -blocking 0
2257 filerun $filehighlight readfhighlight
2263 proc flushhighlights {} {
2264 global filehighlight fhl_list
2266 if {[info exists filehighlight]} {
2268 puts $filehighlight ""
2269 flush $filehighlight
2273 proc askfilehighlight {row id} {
2274 global filehighlight fhighlights fhl_list
2276 lappend fhl_list $id
2277 set fhighlights($row) -1
2278 puts $filehighlight $id
2281 proc readfhighlight {} {
2282 global filehighlight fhighlights commitrow curview mainfont iddrawn
2285 if {![info exists filehighlight]} {
2289 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2290 set line [string trim $line]
2291 set i [lsearch -exact $fhl_list $line]
2292 if {$i < 0} continue
2293 for {set j 0} {$j < $i} {incr j} {
2294 set id [lindex $fhl_list $j]
2295 if {[info exists commitrow($curview,$id)]} {
2296 set fhighlights($commitrow($curview,$id)) 0
2299 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2300 if {$line eq {}} continue
2301 if {![info exists commitrow($curview,$line)]} continue
2302 set row $commitrow($curview,$line)
2303 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2304 bolden $row [concat $mainfont bold]
2306 set fhighlights($row) 1
2308 if {[eof $filehighlight]} {
2310 puts "oops, git diff-tree died"
2311 catch {close $filehighlight}
2319 proc find_change {name ix op} {
2320 global nhighlights mainfont boldnamerows
2321 global findstring findpattern findtype
2323 # delete previous highlights, if any
2324 foreach row $boldnamerows {
2325 bolden_name $row $mainfont
2328 catch {unset nhighlights}
2331 if {$findtype ne "Regexp"} {
2332 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2334 set findpattern "*$e*"
2339 proc doesmatch {f} {
2340 global findtype findstring findpattern
2342 if {$findtype eq "Regexp"} {
2343 return [regexp $findstring $f]
2344 } elseif {$findtype eq "IgnCase"} {
2345 return [string match -nocase $findpattern $f]
2347 return [string match $findpattern $f]
2351 proc askfindhighlight {row id} {
2352 global nhighlights commitinfo iddrawn mainfont
2354 global markingmatches
2356 if {![info exists commitinfo($id)]} {
2359 set info $commitinfo($id)
2361 set fldtypes {Headline Author Date Committer CDate Comments}
2362 foreach f $info ty $fldtypes {
2363 if {($findloc eq "All fields" || $findloc eq $ty) &&
2365 if {$ty eq "Author"} {
2372 if {$isbold && [info exists iddrawn($id)]} {
2373 set f [concat $mainfont bold]
2374 if {![ishighlighted $row]} {
2380 if {$markingmatches} {
2381 markrowmatches $row $id
2384 set nhighlights($row) $isbold
2387 proc markrowmatches {row id} {
2388 global canv canv2 linehtag linentag commitinfo findloc
2390 set headline [lindex $commitinfo($id) 0]
2391 set author [lindex $commitinfo($id) 1]
2392 $canv delete match$row
2393 $canv2 delete match$row
2394 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2395 set m [findmatches $headline]
2397 markmatches $canv $row $headline $linehtag($row) $m \
2398 [$canv itemcget $linehtag($row) -font] $row
2401 if {$findloc eq "All fields" || $findloc eq "Author"} {
2402 set m [findmatches $author]
2404 markmatches $canv2 $row $author $linentag($row) $m \
2405 [$canv2 itemcget $linentag($row) -font] $row
2410 proc vrel_change {name ix op} {
2411 global highlight_related
2414 if {$highlight_related ne "None"} {
2419 # prepare for testing whether commits are descendents or ancestors of a
2420 proc rhighlight_sel {a} {
2421 global descendent desc_todo ancestor anc_todo
2422 global highlight_related rhighlights
2424 catch {unset descendent}
2425 set desc_todo [list $a]
2426 catch {unset ancestor}
2427 set anc_todo [list $a]
2428 if {$highlight_related ne "None"} {
2434 proc rhighlight_none {} {
2437 catch {unset rhighlights}
2441 proc is_descendent {a} {
2442 global curview children commitrow descendent desc_todo
2445 set la $commitrow($v,$a)
2449 for {set i 0} {$i < [llength $todo]} {incr i} {
2450 set do [lindex $todo $i]
2451 if {$commitrow($v,$do) < $la} {
2452 lappend leftover $do
2455 foreach nk $children($v,$do) {
2456 if {![info exists descendent($nk)]} {
2457 set descendent($nk) 1
2465 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2469 set descendent($a) 0
2470 set desc_todo $leftover
2473 proc is_ancestor {a} {
2474 global curview parentlist commitrow ancestor anc_todo
2477 set la $commitrow($v,$a)
2481 for {set i 0} {$i < [llength $todo]} {incr i} {
2482 set do [lindex $todo $i]
2483 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2484 lappend leftover $do
2487 foreach np [lindex $parentlist $commitrow($v,$do)] {
2488 if {![info exists ancestor($np)]} {
2497 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2502 set anc_todo $leftover
2505 proc askrelhighlight {row id} {
2506 global descendent highlight_related iddrawn mainfont rhighlights
2507 global selectedline ancestor
2509 if {![info exists selectedline]} return
2511 if {$highlight_related eq "Descendent" ||
2512 $highlight_related eq "Not descendent"} {
2513 if {![info exists descendent($id)]} {
2516 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2519 } elseif {$highlight_related eq "Ancestor" ||
2520 $highlight_related eq "Not ancestor"} {
2521 if {![info exists ancestor($id)]} {
2524 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2528 if {[info exists iddrawn($id)]} {
2529 if {$isbold && ![ishighlighted $row]} {
2530 bolden $row [concat $mainfont bold]
2533 set rhighlights($row) $isbold
2536 proc next_hlcont {} {
2537 global fhl_row fhl_dirn displayorder numcommits
2538 global vhighlights fhighlights nhighlights rhighlights
2539 global hlview filehighlight findstring highlight_related
2541 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2544 if {$row < 0 || $row >= $numcommits} {
2549 set id [lindex $displayorder $row]
2550 if {[info exists hlview]} {
2551 if {![info exists vhighlights($row)]} {
2552 askvhighlight $row $id
2554 if {$vhighlights($row) > 0} break
2556 if {$findstring ne {}} {
2557 if {![info exists nhighlights($row)]} {
2558 askfindhighlight $row $id
2560 if {$nhighlights($row) > 0} break
2562 if {$highlight_related ne "None"} {
2563 if {![info exists rhighlights($row)]} {
2564 askrelhighlight $row $id
2566 if {$rhighlights($row) > 0} break
2568 if {[info exists filehighlight]} {
2569 if {![info exists fhighlights($row)]} {
2570 # ask for a few more while we're at it...
2572 for {set n 0} {$n < 100} {incr n} {
2573 if {![info exists fhighlights($r)]} {
2574 askfilehighlight $r [lindex $displayorder $r]
2577 if {$r < 0 || $r >= $numcommits} break
2581 if {$fhighlights($row) < 0} {
2585 if {$fhighlights($row) > 0} break
2593 proc next_highlight {dirn} {
2594 global selectedline fhl_row fhl_dirn
2595 global hlview filehighlight findstring highlight_related
2597 if {![info exists selectedline]} return
2598 if {!([info exists hlview] || $findstring ne {} ||
2599 $highlight_related ne "None" || [info exists filehighlight])} return
2600 set fhl_row [expr {$selectedline + $dirn}]
2605 proc cancel_next_highlight {} {
2611 # Graph layout functions
2613 proc shortids {ids} {
2616 if {[llength $id] > 1} {
2617 lappend res [shortids $id]
2618 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2619 lappend res [string range $id 0 7]
2630 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2631 if {($n & $mask) != 0} {
2632 set ret [concat $ret $o]
2634 set o [concat $o $o]
2639 # Work out where id should go in idlist so that order-token
2640 # values increase from left to right
2641 proc idcol {idlist id {i 0}} {
2642 global ordertok curview
2644 set t $ordertok($curview,$id)
2645 if {$i >= [llength $idlist] ||
2646 $t < $ordertok($curview,[lindex $idlist $i])} {
2647 if {$i > [llength $idlist]} {
2648 set i [llength $idlist]
2650 while {[incr i -1] >= 0 &&
2651 $t < $ordertok($curview,[lindex $idlist $i])} {}
2654 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2655 while {[incr i] < [llength $idlist] &&
2656 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2662 proc initlayout {} {
2663 global rowidlist rowisopt displayorder commitlisted
2664 global numcommits canvxmax canv
2667 global colormap rowtextx
2677 set canvxmax [$canv cget -width]
2678 catch {unset colormap}
2679 catch {unset rowtextx}
2683 proc setcanvscroll {} {
2684 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2686 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2687 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2688 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2689 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2692 proc visiblerows {} {
2693 global canv numcommits linespc
2695 set ymax [lindex [$canv cget -scrollregion] 3]
2696 if {$ymax eq {} || $ymax == 0} return
2698 set y0 [expr {int([lindex $f 0] * $ymax)}]
2699 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2703 set y1 [expr {int([lindex $f 1] * $ymax)}]
2704 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2705 if {$r1 >= $numcommits} {
2706 set r1 [expr {$numcommits - 1}]
2708 return [list $r0 $r1]
2711 proc layoutmore {tmax allread} {
2712 global commitidx numcommits
2713 global uparrowlen downarrowlen mingaplen curview
2715 set show $commitidx($curview)
2717 set delay [expr {$uparrowlen + $mingaplen + $downarrowlen + 3}]
2718 set show [expr {$show - $delay}]
2720 if {$show > $numcommits} {
2721 showstuff $show $allread
2726 proc showstuff {canshow last} {
2727 global numcommits commitrow pending_select selectedline curview
2728 global lookingforhead mainheadid displayorder selectfirst
2729 global lastscrollset commitinterest
2731 if {$numcommits == 0} {
2733 set phase "incrdraw"
2736 for {set l $numcommits} {$l < $canshow} {incr l} {
2737 set id [lindex $displayorder $l]
2738 if {[info exists commitinterest($id)]} {
2739 foreach script $commitinterest($id) {
2740 eval [string map [list "%I" $id] $script]
2742 unset commitinterest($id)
2746 set prev $numcommits
2747 set numcommits $canshow
2748 set t [clock clicks -milliseconds]
2749 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2750 set lastscrollset $t
2753 set rows [visiblerows]
2754 set r1 [lindex $rows 1]
2755 if {$r1 >= $canshow} {
2756 set r1 [expr {$canshow - 1}]
2761 if {[info exists pending_select] &&
2762 [info exists commitrow($curview,$pending_select)] &&
2763 $commitrow($curview,$pending_select) < $numcommits} {
2764 selectline $commitrow($curview,$pending_select) 1
2767 if {[info exists selectedline] || [info exists pending_select]} {
2770 set l [first_real_row]
2775 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2776 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2777 set lookingforhead 0
2782 proc doshowlocalchanges {} {
2783 global lookingforhead curview mainheadid phase commitrow
2785 if {[info exists commitrow($curview,$mainheadid)] &&
2786 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2788 } elseif {$phase ne {}} {
2789 set lookingforhead 1
2793 proc dohidelocalchanges {} {
2794 global lookingforhead localfrow localirow lserial
2796 set lookingforhead 0
2797 if {$localfrow >= 0} {
2798 removerow $localfrow
2800 if {$localirow > 0} {
2804 if {$localirow >= 0} {
2805 removerow $localirow
2811 # spawn off a process to do git diff-index --cached HEAD
2812 proc dodiffindex {} {
2813 global localirow localfrow lserial
2818 set fd [open "|git diff-index --cached HEAD" r]
2819 fconfigure $fd -blocking 0
2820 filerun $fd [list readdiffindex $fd $lserial]
2823 proc readdiffindex {fd serial} {
2824 global localirow commitrow mainheadid nullid2 curview
2825 global commitinfo commitdata lserial
2828 if {[gets $fd line] < 0} {
2834 # we only need to see one line and we don't really care what it says...
2837 # now see if there are any local changes not checked in to the index
2838 if {$serial == $lserial} {
2839 set fd [open "|git diff-files" r]
2840 fconfigure $fd -blocking 0
2841 filerun $fd [list readdifffiles $fd $serial]
2844 if {$isdiff && $serial == $lserial && $localirow == -1} {
2845 # add the line for the changes in the index to the graph
2846 set localirow $commitrow($curview,$mainheadid)
2847 set hl "Local changes checked in to index but not committed"
2848 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2849 set commitdata($nullid2) "\n $hl\n"
2850 insertrow $localirow $nullid2
2855 proc readdifffiles {fd serial} {
2856 global localirow localfrow commitrow mainheadid nullid curview
2857 global commitinfo commitdata lserial
2860 if {[gets $fd line] < 0} {
2866 # we only need to see one line and we don't really care what it says...
2869 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2870 # add the line for the local diff to the graph
2871 if {$localirow >= 0} {
2872 set localfrow $localirow
2875 set localfrow $commitrow($curview,$mainheadid)
2877 set hl "Local uncommitted changes, not checked in to index"
2878 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2879 set commitdata($nullid) "\n $hl\n"
2880 insertrow $localfrow $nullid
2885 proc nextuse {id row} {
2886 global commitrow curview children
2888 if {[info exists children($curview,$id)]} {
2889 foreach kid $children($curview,$id) {
2890 if {![info exists commitrow($curview,$kid)]} {
2893 if {$commitrow($curview,$kid) > $row} {
2894 return $commitrow($curview,$kid)
2898 if {[info exists commitrow($curview,$id)]} {
2899 return $commitrow($curview,$id)
2904 proc make_idlist {row} {
2905 global displayorder parentlist uparrowlen downarrowlen mingaplen
2906 global commitidx curview ordertok children commitrow
2908 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2912 set ra [expr {$row - $downarrowlen}]
2916 set rb [expr {$row + $uparrowlen}]
2917 if {$rb > $commitidx($curview)} {
2918 set rb $commitidx($curview)
2921 for {} {$r < $ra} {incr r} {
2922 set nextid [lindex $displayorder [expr {$r + 1}]]
2923 foreach p [lindex $parentlist $r] {
2924 if {$p eq $nextid} continue
2925 set rn [nextuse $p $r]
2927 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2928 lappend ids [list $ordertok($curview,$p) $p]
2932 for {} {$r < $row} {incr r} {
2933 set nextid [lindex $displayorder [expr {$r + 1}]]
2934 foreach p [lindex $parentlist $r] {
2935 if {$p eq $nextid} continue
2936 set rn [nextuse $p $r]
2937 if {$rn < 0 || $rn >= $row} {
2938 lappend ids [list $ordertok($curview,$p) $p]
2942 set id [lindex $displayorder $row]
2943 lappend ids [list $ordertok($curview,$id) $id]
2945 foreach p [lindex $parentlist $r] {
2946 set firstkid [lindex $children($curview,$p) 0]
2947 if {$commitrow($curview,$firstkid) < $row} {
2948 lappend ids [list $ordertok($curview,$p) $p]
2952 set id [lindex $displayorder $r]
2954 set firstkid [lindex $children($curview,$id) 0]
2955 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
2956 lappend ids [list $ordertok($curview,$id) $id]
2961 foreach idx [lsort -unique $ids] {
2962 lappend idlist [lindex $idx 1]
2967 proc layoutrows {row endrow} {
2968 global rowidlist rowisopt displayorder
2969 global uparrowlen downarrowlen maxwidth mingaplen
2970 global children parentlist
2971 global commitidx curview commitrow
2975 foreach id [lindex $rowidlist [expr {$row - 1}]] {
2981 for {} {$row < $endrow} {incr row} {
2982 set rm1 [expr {$row - 1}]
2983 if {$rm1 < 0 || [lindex $rowidlist $rm1] eq {}} {
2984 set idlist [make_idlist $row]
2986 set id [lindex $displayorder $rm1]
2987 set col [lsearch -exact $idlist $id]
2988 set idlist [lreplace $idlist $col $col]
2989 foreach p [lindex $parentlist $rm1] {
2990 if {[lsearch -exact $idlist $p] < 0} {
2991 set col [idcol $idlist $p $col]
2992 set idlist [linsert $idlist $col $p]
2995 set id [lindex $displayorder $row]
2996 if {$row > $downarrowlen} {
2997 set termrow [expr {$row - $downarrowlen - 1}]
2998 foreach p [lindex $parentlist $termrow] {
2999 set i [lsearch -exact $idlist $p]
3000 if {$i < 0} continue
3001 set nr [nextuse $p $termrow]
3002 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3003 set idlist [lreplace $idlist $i $i]
3007 set col [lsearch -exact $idlist $id]
3009 set col [idcol $idlist $id]
3010 set idlist [linsert $idlist $col $id]
3012 set r [expr {$row + $uparrowlen - 1}]
3013 if {$r < $commitidx($curview)} {
3015 foreach p [lindex $parentlist $r] {
3016 if {[lsearch -exact $idlist $p] >= 0} continue
3017 set fk [lindex $children($curview,$p) 0]
3018 if {$commitrow($curview,$fk) < $row} {
3019 set x [idcol $idlist $p $x]
3020 set idlist [linsert $idlist $x $p]
3023 if {[incr r] < $commitidx($curview)} {
3024 set p [lindex $displayorder $r]
3025 if {[lsearch -exact $idlist $p] < 0} {
3026 set fk [lindex $children($curview,$p) 0]
3027 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3028 set x [idcol $idlist $p $x]
3029 set idlist [linsert $idlist $x $p]
3035 set l [llength $rowidlist]
3037 lappend rowidlist $idlist
3039 } elseif {$row < $l} {
3040 if {$idlist ne [lindex $rowidlist $row]} {
3041 lset rowidlist $row $idlist
3045 set rowidlist [concat $rowidlist [ntimes [expr {$row - $l}] {}]]
3046 lappend rowidlist $idlist
3047 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3053 proc changedrow {row} {
3054 global displayorder iddrawn rowisopt need_redisplay
3056 set l [llength $rowisopt]
3058 lset rowisopt $row 0
3059 if {$row + 1 < $l} {
3060 lset rowisopt [expr {$row + 1}] 0
3061 if {$row + 2 < $l} {
3062 lset rowisopt [expr {$row + 2}] 0
3066 set id [lindex $displayorder $row]
3067 if {[info exists iddrawn($id)]} {
3068 set need_redisplay 1
3072 proc insert_pad {row col npad} {
3075 set pad [ntimes $npad {}]
3076 set idlist [lindex $rowidlist $row]
3077 set bef [lrange $idlist 0 [expr {$col - 1}]]
3078 set aft [lrange $idlist $col end]
3079 set i [lsearch -exact $aft {}]
3081 set aft [lreplace $aft $i $i]
3083 lset rowidlist $row [concat $bef $pad $aft]
3087 proc optimize_rows {row col endrow} {
3088 global rowidlist rowisopt displayorder curview children
3093 for {} {$row < $endrow} {incr row; set col 0} {
3094 if {[lindex $rowisopt $row]} continue
3096 set y0 [expr {$row - 1}]
3097 set ym [expr {$row - 2}]
3098 set idlist [lindex $rowidlist $row]
3099 set previdlist [lindex $rowidlist $y0]
3100 if {$idlist eq {} || $previdlist eq {}} continue
3102 set pprevidlist [lindex $rowidlist $ym]
3103 if {$pprevidlist eq {}} continue
3109 for {} {$col < [llength $idlist]} {incr col} {
3110 set id [lindex $idlist $col]
3111 if {[lindex $previdlist $col] eq $id} continue
3116 set x0 [lsearch -exact $previdlist $id]
3117 if {$x0 < 0} continue
3118 set z [expr {$x0 - $col}]
3122 set xm [lsearch -exact $pprevidlist $id]
3124 set z0 [expr {$xm - $x0}]
3128 # if row y0 is the first child of $id then it's not an arrow
3129 if {[lindex $children($curview,$id) 0] ne
3130 [lindex $displayorder $y0]} {
3134 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3135 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3138 # Looking at lines from this row to the previous row,
3139 # make them go straight up if they end in an arrow on
3140 # the previous row; otherwise make them go straight up
3142 if {$z < -1 || ($z < 0 && $isarrow)} {
3143 # Line currently goes left too much;
3144 # insert pads in the previous row, then optimize it
3145 set npad [expr {-1 - $z + $isarrow}]
3146 insert_pad $y0 $x0 $npad
3148 optimize_rows $y0 $x0 $row
3150 set previdlist [lindex $rowidlist $y0]
3151 set x0 [lsearch -exact $previdlist $id]
3152 set z [expr {$x0 - $col}]
3154 set pprevidlist [lindex $rowidlist $ym]
3155 set xm [lsearch -exact $pprevidlist $id]
3156 set z0 [expr {$xm - $x0}]
3158 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3159 # Line currently goes right too much;
3160 # insert pads in this line
3161 set npad [expr {$z - 1 + $isarrow}]
3162 insert_pad $row $col $npad
3163 set idlist [lindex $rowidlist $row]
3165 set z [expr {$x0 - $col}]
3168 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3169 # this line links to its first child on row $row-2
3170 set id [lindex $displayorder $ym]
3171 set xc [lsearch -exact $pprevidlist $id]
3173 set z0 [expr {$xc - $x0}]
3176 # avoid lines jigging left then immediately right
3177 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3178 insert_pad $y0 $x0 1
3180 optimize_rows $y0 $x0 $row
3181 set previdlist [lindex $rowidlist $y0]
3185 # Find the first column that doesn't have a line going right
3186 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3187 set id [lindex $idlist $col]
3188 if {$id eq {}} break
3189 set x0 [lsearch -exact $previdlist $id]
3191 # check if this is the link to the first child
3192 set kid [lindex $displayorder $y0]
3193 if {[lindex $children($curview,$id) 0] eq $kid} {
3194 # it is, work out offset to child
3195 set x0 [lsearch -exact $previdlist $kid]
3198 if {$x0 <= $col} break
3200 # Insert a pad at that column as long as it has a line and
3201 # isn't the last column
3202 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3203 set idlist [linsert $idlist $col {}]
3204 lset rowidlist $row $idlist
3212 global canvx0 linespc
3213 return [expr {$canvx0 + $col * $linespc}]
3217 global canvy0 linespc
3218 return [expr {$canvy0 + $row * $linespc}]
3221 proc linewidth {id} {
3222 global thickerline lthickness
3225 if {[info exists thickerline] && $id eq $thickerline} {
3226 set wid [expr {2 * $lthickness}]
3231 proc rowranges {id} {
3232 global commitrow curview children uparrowlen downarrowlen
3235 set kids $children($curview,$id)
3241 foreach child $kids {
3242 if {![info exists commitrow($curview,$child)]} break
3243 set row $commitrow($curview,$child)
3244 if {![info exists prev]} {
3245 lappend ret [expr {$row + 1}]
3247 if {$row <= $prevrow} {
3248 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3250 # see if the line extends the whole way from prevrow to row
3251 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3252 [lsearch -exact [lindex $rowidlist \
3253 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3254 # it doesn't, see where it ends
3255 set r [expr {$prevrow + $downarrowlen}]
3256 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3257 while {[incr r -1] > $prevrow &&
3258 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3260 while {[incr r] <= $row &&
3261 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3265 # see where it starts up again
3266 set r [expr {$row - $uparrowlen}]
3267 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3268 while {[incr r] < $row &&
3269 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3271 while {[incr r -1] >= $prevrow &&
3272 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3278 if {$child eq $id} {
3287 proc drawlineseg {id row endrow arrowlow} {
3288 global rowidlist displayorder iddrawn linesegs
3289 global canv colormap linespc curview maxlinelen parentlist
3291 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3292 set le [expr {$row + 1}]
3295 set c [lsearch -exact [lindex $rowidlist $le] $id]
3301 set x [lindex $displayorder $le]
3306 if {[info exists iddrawn($x)] || $le == $endrow} {
3307 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3323 if {[info exists linesegs($id)]} {
3324 set lines $linesegs($id)
3326 set r0 [lindex $li 0]
3328 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3338 set li [lindex $lines [expr {$i-1}]]
3339 set r1 [lindex $li 1]
3340 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3345 set x [lindex $cols [expr {$le - $row}]]
3346 set xp [lindex $cols [expr {$le - 1 - $row}]]
3347 set dir [expr {$xp - $x}]
3349 set ith [lindex $lines $i 2]
3350 set coords [$canv coords $ith]
3351 set ah [$canv itemcget $ith -arrow]
3352 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3353 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3354 if {$x2 ne {} && $x - $x2 == $dir} {
3355 set coords [lrange $coords 0 end-2]
3358 set coords [list [xc $le $x] [yc $le]]
3361 set itl [lindex $lines [expr {$i-1}] 2]
3362 set al [$canv itemcget $itl -arrow]
3363 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3364 } elseif {$arrowlow} {
3365 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3366 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3370 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3371 for {set y $le} {[incr y -1] > $row} {} {
3373 set xp [lindex $cols [expr {$y - 1 - $row}]]
3374 set ndir [expr {$xp - $x}]
3375 if {$dir != $ndir || $xp < 0} {
3376 lappend coords [xc $y $x] [yc $y]
3382 # join parent line to first child
3383 set ch [lindex $displayorder $row]
3384 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3386 puts "oops: drawlineseg: child $ch not on row $row"
3387 } elseif {$xc != $x} {
3388 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3389 set d [expr {int(0.5 * $linespc)}]
3392 set x2 [expr {$x1 - $d}]
3394 set x2 [expr {$x1 + $d}]
3397 set y1 [expr {$y2 + $d}]
3398 lappend coords $x1 $y1 $x2 $y2
3399 } elseif {$xc < $x - 1} {
3400 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3401 } elseif {$xc > $x + 1} {
3402 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3406 lappend coords [xc $row $x] [yc $row]
3408 set xn [xc $row $xp]
3410 lappend coords $xn $yn
3414 set t [$canv create line $coords -width [linewidth $id] \
3415 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3418 set lines [linsert $lines $i [list $row $le $t]]
3420 $canv coords $ith $coords
3421 if {$arrow ne $ah} {
3422 $canv itemconf $ith -arrow $arrow
3424 lset lines $i 0 $row
3427 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3428 set ndir [expr {$xo - $xp}]
3429 set clow [$canv coords $itl]
3430 if {$dir == $ndir} {
3431 set clow [lrange $clow 2 end]
3433 set coords [concat $coords $clow]
3435 lset lines [expr {$i-1}] 1 $le
3437 # coalesce two pieces
3439 set b [lindex $lines [expr {$i-1}] 0]
3440 set e [lindex $lines $i 1]
3441 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3443 $canv coords $itl $coords
3444 if {$arrow ne $al} {
3445 $canv itemconf $itl -arrow $arrow
3449 set linesegs($id) $lines
3453 proc drawparentlinks {id row} {
3454 global rowidlist canv colormap curview parentlist
3455 global idpos linespc
3457 set rowids [lindex $rowidlist $row]
3458 set col [lsearch -exact $rowids $id]
3459 if {$col < 0} return
3460 set olds [lindex $parentlist $row]
3461 set row2 [expr {$row + 1}]
3462 set x [xc $row $col]
3465 set d [expr {int(0.5 * $linespc)}]
3466 set ymid [expr {$y + $d}]
3467 set ids [lindex $rowidlist $row2]
3468 # rmx = right-most X coord used
3471 set i [lsearch -exact $ids $p]
3473 puts "oops, parent $p of $id not in list"
3476 set x2 [xc $row2 $i]
3480 set j [lsearch -exact $rowids $p]
3482 # drawlineseg will do this one for us
3486 # should handle duplicated parents here...
3487 set coords [list $x $y]
3489 # if attaching to a vertical segment, draw a smaller
3490 # slant for visual distinctness
3493 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3495 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3497 } elseif {$i < $col && $i < $j} {
3498 # segment slants towards us already
3499 lappend coords [xc $row $j] $y
3501 if {$i < $col - 1} {
3502 lappend coords [expr {$x2 + $linespc}] $y
3503 } elseif {$i > $col + 1} {
3504 lappend coords [expr {$x2 - $linespc}] $y
3506 lappend coords $x2 $y2
3509 lappend coords $x2 $y2
3511 set t [$canv create line $coords -width [linewidth $p] \
3512 -fill $colormap($p) -tags lines.$p]
3516 if {$rmx > [lindex $idpos($id) 1]} {
3517 lset idpos($id) 1 $rmx
3522 proc drawlines {id} {
3525 $canv itemconf lines.$id -width [linewidth $id]
3528 proc drawcmittext {id row col} {
3529 global linespc canv canv2 canv3 canvy0 fgcolor curview
3530 global commitlisted commitinfo rowidlist parentlist
3531 global rowtextx idpos idtags idheads idotherrefs
3532 global linehtag linentag linedtag selectedline
3533 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3535 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3536 set listed [lindex $commitlisted $row]
3537 if {$id eq $nullid} {
3539 } elseif {$id eq $nullid2} {
3542 set ofill [expr {$listed != 0? "blue": "white"}]
3544 set x [xc $row $col]
3546 set orad [expr {$linespc / 3}]
3548 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3549 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3550 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3551 } elseif {$listed == 2} {
3552 # triangle pointing left for left-side commits
3553 set t [$canv create polygon \
3554 [expr {$x - $orad}] $y \
3555 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3556 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3557 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3559 # triangle pointing right for right-side commits
3560 set t [$canv create polygon \
3561 [expr {$x + $orad - 1}] $y \
3562 [expr {$x - $orad}] [expr {$y - $orad}] \
3563 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3564 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3567 $canv bind $t <1> {selcanvline {} %x %y}
3568 set rmx [llength [lindex $rowidlist $row]]
3569 set olds [lindex $parentlist $row]
3571 set nextids [lindex $rowidlist [expr {$row + 1}]]
3573 set i [lsearch -exact $nextids $p]
3579 set xt [xc $row $rmx]
3580 set rowtextx($row) $xt
3581 set idpos($id) [list $x $xt $y]
3582 if {[info exists idtags($id)] || [info exists idheads($id)]
3583 || [info exists idotherrefs($id)]} {
3584 set xt [drawtags $id $x $xt $y]
3586 set headline [lindex $commitinfo($id) 0]
3587 set name [lindex $commitinfo($id) 1]
3588 set date [lindex $commitinfo($id) 2]
3589 set date [formatdate $date]
3592 set isbold [ishighlighted $row]
3594 lappend boldrows $row
3597 lappend boldnamerows $row
3601 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3602 -text $headline -font $font -tags text]
3603 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3604 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3605 -text $name -font $nfont -tags text]
3606 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3607 -text $date -font $mainfont -tags text]
3608 if {[info exists selectedline] && $selectedline == $row} {
3611 set xr [expr {$xt + [font measure $mainfont $headline]}]
3612 if {$xr > $canvxmax} {
3618 proc drawcmitrow {row} {
3619 global displayorder rowidlist nrows_drawn
3620 global iddrawn markingmatches
3621 global commitinfo parentlist numcommits
3622 global filehighlight fhighlights findstring nhighlights
3623 global hlview vhighlights
3624 global highlight_related rhighlights
3626 if {$row >= $numcommits} return
3628 set id [lindex $displayorder $row]
3629 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3630 askvhighlight $row $id
3632 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3633 askfilehighlight $row $id
3635 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3636 askfindhighlight $row $id
3638 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3639 askrelhighlight $row $id
3641 if {![info exists iddrawn($id)]} {
3642 set col [lsearch -exact [lindex $rowidlist $row] $id]
3644 puts "oops, row $row id $id not in list"
3647 if {![info exists commitinfo($id)]} {
3651 drawcmittext $id $row $col
3655 if {$markingmatches} {
3656 markrowmatches $row $id
3660 proc drawcommits {row {endrow {}}} {
3661 global numcommits iddrawn displayorder curview need_redisplay
3662 global parentlist rowidlist uparrowlen downarrowlen nrows_drawn
3667 if {$endrow eq {}} {
3670 if {$endrow >= $numcommits} {
3671 set endrow [expr {$numcommits - 1}]
3674 set rl1 [expr {$row - $downarrowlen - 3}]
3678 set ro1 [expr {$row - 3}]
3682 set r2 [expr {$endrow + $uparrowlen + 3}]
3683 if {$r2 > $numcommits} {
3686 for {set r $rl1} {$r < $r2} {incr r} {
3687 if {[lindex $rowidlist $r] ne {}} {
3691 set rl1 [expr {$r + 1}]
3697 optimize_rows $ro1 0 $r2
3698 if {$need_redisplay || $nrows_drawn > 2000} {
3703 # make the lines join to already-drawn rows either side
3704 set r [expr {$row - 1}]
3705 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3708 set er [expr {$endrow + 1}]
3709 if {$er >= $numcommits ||
3710 ![info exists iddrawn([lindex $displayorder $er])]} {
3713 for {} {$r <= $er} {incr r} {
3714 set id [lindex $displayorder $r]
3715 set wasdrawn [info exists iddrawn($id)]
3717 if {$r == $er} break
3718 set nextid [lindex $displayorder [expr {$r + 1}]]
3719 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3720 catch {unset prevlines}
3723 drawparentlinks $id $r
3725 if {[info exists lineends($r)]} {
3726 foreach lid $lineends($r) {
3727 unset prevlines($lid)
3730 set rowids [lindex $rowidlist $r]
3731 foreach lid $rowids {
3732 if {$lid eq {}} continue
3734 # see if this is the first child of any of its parents
3735 foreach p [lindex $parentlist $r] {
3736 if {[lsearch -exact $rowids $p] < 0} {
3737 # make this line extend up to the child
3738 set le [drawlineseg $p $r $er 0]
3739 lappend lineends($le) $p
3743 } elseif {![info exists prevlines($lid)]} {
3744 set le [drawlineseg $lid $r $er 1]
3745 lappend lineends($le) $lid
3746 set prevlines($lid) 1
3752 proc drawfrac {f0 f1} {
3755 set ymax [lindex [$canv cget -scrollregion] 3]
3756 if {$ymax eq {} || $ymax == 0} return
3757 set y0 [expr {int($f0 * $ymax)}]
3758 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3759 set y1 [expr {int($f1 * $ymax)}]
3760 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3761 drawcommits $row $endrow
3764 proc drawvisible {} {
3766 eval drawfrac [$canv yview]
3769 proc clear_display {} {
3770 global iddrawn linesegs need_redisplay nrows_drawn
3771 global vhighlights fhighlights nhighlights rhighlights
3774 catch {unset iddrawn}
3775 catch {unset linesegs}
3776 catch {unset vhighlights}
3777 catch {unset fhighlights}
3778 catch {unset nhighlights}
3779 catch {unset rhighlights}
3780 set need_redisplay 0
3784 proc findcrossings {id} {
3785 global rowidlist parentlist numcommits displayorder
3789 foreach {s e} [rowranges $id] {
3790 if {$e >= $numcommits} {
3791 set e [expr {$numcommits - 1}]
3793 if {$e <= $s} continue
3794 for {set row $e} {[incr row -1] >= $s} {} {
3795 set x [lsearch -exact [lindex $rowidlist $row] $id]
3797 set olds [lindex $parentlist $row]
3798 set kid [lindex $displayorder $row]
3799 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3800 if {$kidx < 0} continue
3801 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3803 set px [lsearch -exact $nextrow $p]
3804 if {$px < 0} continue
3805 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3806 if {[lsearch -exact $ccross $p] >= 0} continue
3807 if {$x == $px + ($kidx < $px? -1: 1)} {
3809 } elseif {[lsearch -exact $cross $p] < 0} {
3816 return [concat $ccross {{}} $cross]
3819 proc assigncolor {id} {
3820 global colormap colors nextcolor
3821 global commitrow parentlist children children curview
3823 if {[info exists colormap($id)]} return
3824 set ncolors [llength $colors]
3825 if {[info exists children($curview,$id)]} {
3826 set kids $children($curview,$id)
3830 if {[llength $kids] == 1} {
3831 set child [lindex $kids 0]
3832 if {[info exists colormap($child)]
3833 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3834 set colormap($id) $colormap($child)
3840 foreach x [findcrossings $id] {
3842 # delimiter between corner crossings and other crossings
3843 if {[llength $badcolors] >= $ncolors - 1} break
3844 set origbad $badcolors
3846 if {[info exists colormap($x)]
3847 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3848 lappend badcolors $colormap($x)
3851 if {[llength $badcolors] >= $ncolors} {
3852 set badcolors $origbad
3854 set origbad $badcolors
3855 if {[llength $badcolors] < $ncolors - 1} {
3856 foreach child $kids {
3857 if {[info exists colormap($child)]
3858 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3859 lappend badcolors $colormap($child)
3861 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3862 if {[info exists colormap($p)]
3863 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3864 lappend badcolors $colormap($p)
3868 if {[llength $badcolors] >= $ncolors} {
3869 set badcolors $origbad
3872 for {set i 0} {$i <= $ncolors} {incr i} {
3873 set c [lindex $colors $nextcolor]
3874 if {[incr nextcolor] >= $ncolors} {
3877 if {[lsearch -exact $badcolors $c]} break
3879 set colormap($id) $c
3882 proc bindline {t id} {
3885 $canv bind $t <Enter> "lineenter %x %y $id"
3886 $canv bind $t <Motion> "linemotion %x %y $id"
3887 $canv bind $t <Leave> "lineleave $id"
3888 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3891 proc drawtags {id x xt y1} {
3892 global idtags idheads idotherrefs mainhead
3893 global linespc lthickness
3894 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3899 if {[info exists idtags($id)]} {
3900 set marks $idtags($id)
3901 set ntags [llength $marks]
3903 if {[info exists idheads($id)]} {
3904 set marks [concat $marks $idheads($id)]
3905 set nheads [llength $idheads($id)]
3907 if {[info exists idotherrefs($id)]} {
3908 set marks [concat $marks $idotherrefs($id)]
3914 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3915 set yt [expr {$y1 - 0.5 * $linespc}]
3916 set yb [expr {$yt + $linespc - 1}]
3920 foreach tag $marks {
3922 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3923 set wid [font measure [concat $mainfont bold] $tag]
3925 set wid [font measure $mainfont $tag]
3929 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3931 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3932 -width $lthickness -fill black -tags tag.$id]
3934 foreach tag $marks x $xvals wid $wvals {
3935 set xl [expr {$x + $delta}]
3936 set xr [expr {$x + $delta + $wid + $lthickness}]
3938 if {[incr ntags -1] >= 0} {
3940 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3941 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3942 -width 1 -outline black -fill yellow -tags tag.$id]
3943 $canv bind $t <1> [list showtag $tag 1]
3944 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3946 # draw a head or other ref
3947 if {[incr nheads -1] >= 0} {
3949 if {$tag eq $mainhead} {
3955 set xl [expr {$xl - $delta/2}]
3956 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3957 -width 1 -outline black -fill $col -tags tag.$id
3958 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3959 set rwid [font measure $mainfont $remoteprefix]
3960 set xi [expr {$x + 1}]
3961 set yti [expr {$yt + 1}]
3962 set xri [expr {$x + $rwid}]
3963 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3964 -width 0 -fill "#ffddaa" -tags tag.$id
3967 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3968 -font $font -tags [list tag.$id text]]
3970 $canv bind $t <1> [list showtag $tag 1]
3971 } elseif {$nheads >= 0} {
3972 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3978 proc xcoord {i level ln} {
3979 global canvx0 xspc1 xspc2
3981 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3982 if {$i > 0 && $i == $level} {
3983 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3984 } elseif {$i > $level} {
3985 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3990 proc show_status {msg} {
3991 global canv mainfont fgcolor
3994 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3995 -tags text -fill $fgcolor
3998 # Insert a new commit as the child of the commit on row $row.
3999 # The new commit will be displayed on row $row and the commits
4000 # on that row and below will move down one row.
4001 proc insertrow {row newcmit} {
4002 global displayorder parentlist commitlisted children
4003 global commitrow curview rowidlist rowisopt numcommits
4005 global selectedline commitidx ordertok
4007 if {$row >= $numcommits} {
4008 puts "oops, inserting new row $row but only have $numcommits rows"
4011 set p [lindex $displayorder $row]
4012 set displayorder [linsert $displayorder $row $newcmit]
4013 set parentlist [linsert $parentlist $row $p]
4014 set kids $children($curview,$p)
4015 lappend kids $newcmit
4016 set children($curview,$p) $kids
4017 set children($curview,$newcmit) {}
4018 set commitlisted [linsert $commitlisted $row 1]
4019 set l [llength $displayorder]
4020 for {set r $row} {$r < $l} {incr r} {
4021 set id [lindex $displayorder $r]
4022 set commitrow($curview,$id) $r
4024 incr commitidx($curview)
4025 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4027 set idlist [lindex $rowidlist $row]
4028 if {[llength $kids] == 1} {
4029 set col [lsearch -exact $idlist $p]
4030 lset idlist $col $newcmit
4032 set col [llength $idlist]
4033 lappend idlist $newcmit
4035 set rowidlist [linsert $rowidlist $row $idlist]
4036 set rowisopt [linsert $rowisopt $row 0]
4040 if {[info exists selectedline] && $selectedline >= $row} {
4046 # Remove a commit that was inserted with insertrow on row $row.
4047 proc removerow {row} {
4048 global displayorder parentlist commitlisted children
4049 global commitrow curview rowidlist rowisopt numcommits
4051 global linesegends selectedline commitidx
4053 if {$row >= $numcommits} {
4054 puts "oops, removing row $row but only have $numcommits rows"
4057 set rp1 [expr {$row + 1}]
4058 set id [lindex $displayorder $row]
4059 set p [lindex $parentlist $row]
4060 set displayorder [lreplace $displayorder $row $row]
4061 set parentlist [lreplace $parentlist $row $row]
4062 set commitlisted [lreplace $commitlisted $row $row]
4063 set kids $children($curview,$p)
4064 set i [lsearch -exact $kids $id]
4066 set kids [lreplace $kids $i $i]
4067 set children($curview,$p) $kids
4069 set l [llength $displayorder]
4070 for {set r $row} {$r < $l} {incr r} {
4071 set id [lindex $displayorder $r]
4072 set commitrow($curview,$id) $r
4074 incr commitidx($curview) -1
4076 set rowidlist [lreplace $rowidlist $row $row]
4077 set rowisopt [lreplace $rowisopt $row $row]
4081 if {[info exists selectedline] && $selectedline > $row} {
4082 incr selectedline -1
4087 # Don't change the text pane cursor if it is currently the hand cursor,
4088 # showing that we are over a sha1 ID link.
4089 proc settextcursor {c} {
4090 global ctext curtextcursor
4092 if {[$ctext cget -cursor] == $curtextcursor} {
4093 $ctext config -cursor $c
4095 set curtextcursor $c
4098 proc nowbusy {what} {
4101 if {[array names isbusy] eq {}} {
4102 . config -cursor watch
4108 proc notbusy {what} {
4109 global isbusy maincursor textcursor
4111 catch {unset isbusy($what)}
4112 if {[array names isbusy] eq {}} {
4113 . config -cursor $maincursor
4114 settextcursor $textcursor
4118 proc findmatches {f} {
4119 global findtype findstring
4120 if {$findtype == "Regexp"} {
4121 set matches [regexp -indices -all -inline $findstring $f]
4124 if {$findtype == "IgnCase"} {
4125 set f [string tolower $f]
4126 set fs [string tolower $fs]
4130 set l [string length $fs]
4131 while {[set j [string first $fs $f $i]] >= 0} {
4132 lappend matches [list $j [expr {$j+$l-1}]]
4133 set i [expr {$j + $l}]
4139 proc dofind {{rev 0}} {
4140 global findstring findstartline findcurline selectedline numcommits
4143 cancel_next_highlight
4145 if {$findstring eq {} || $numcommits == 0} return
4146 if {![info exists selectedline]} {
4147 set findstartline [lindex [visiblerows] $rev]
4149 set findstartline $selectedline
4151 set findcurline $findstartline
4156 if {$findcurline == 0} {
4157 set findcurline $numcommits
4164 proc findnext {restart} {
4166 if {![info exists findcurline]} {
4180 if {![info exists findcurline]} {
4189 global commitdata commitinfo numcommits findstring findpattern findloc
4190 global findstartline findcurline displayorder
4192 set fldtypes {Headline Author Date Committer CDate Comments}
4193 set l [expr {$findcurline + 1}]
4194 if {$l >= $numcommits} {
4197 if {$l <= $findstartline} {
4198 set lim [expr {$findstartline + 1}]
4202 if {$lim - $l > 500} {
4203 set lim [expr {$l + 500}]
4206 for {} {$l < $lim} {incr l} {
4207 set id [lindex $displayorder $l]
4208 # shouldn't happen unless git log doesn't give all the commits...
4209 if {![info exists commitdata($id)]} continue
4210 if {![doesmatch $commitdata($id)]} continue
4211 if {![info exists commitinfo($id)]} {
4214 set info $commitinfo($id)
4215 foreach f $info ty $fldtypes {
4216 if {($findloc eq "All fields" || $findloc eq $ty) &&
4224 if {$l == $findstartline + 1} {
4230 set findcurline [expr {$l - 1}]
4234 proc findmorerev {} {
4235 global commitdata commitinfo numcommits findstring findpattern findloc
4236 global findstartline findcurline displayorder
4238 set fldtypes {Headline Author Date Committer CDate Comments}
4244 if {$l >= $findstartline} {
4245 set lim [expr {$findstartline - 1}]
4249 if {$l - $lim > 500} {
4250 set lim [expr {$l - 500}]
4253 for {} {$l > $lim} {incr l -1} {
4254 set id [lindex $displayorder $l]
4255 if {![info exists commitdata($id)]} continue
4256 if {![doesmatch $commitdata($id)]} continue
4257 if {![info exists commitinfo($id)]} {
4260 set info $commitinfo($id)
4261 foreach f $info ty $fldtypes {
4262 if {($findloc eq "All fields" || $findloc eq $ty) &&
4276 set findcurline [expr {$l + 1}]
4280 proc findselectline {l} {
4281 global findloc commentend ctext findcurline markingmatches
4283 set markingmatches 1
4286 if {$findloc == "All fields" || $findloc == "Comments"} {
4287 # highlight the matches in the comments
4288 set f [$ctext get 1.0 $commentend]
4289 set matches [findmatches $f]
4290 foreach match $matches {
4291 set start [lindex $match 0]
4292 set end [expr {[lindex $match 1] + 1}]
4293 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4299 # mark the bits of a headline or author that match a find string
4300 proc markmatches {canv l str tag matches font row} {
4303 set bbox [$canv bbox $tag]
4304 set x0 [lindex $bbox 0]
4305 set y0 [lindex $bbox 1]
4306 set y1 [lindex $bbox 3]
4307 foreach match $matches {
4308 set start [lindex $match 0]
4309 set end [lindex $match 1]
4310 if {$start > $end} continue
4311 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4312 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4313 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4314 [expr {$x0+$xlen+2}] $y1 \
4315 -outline {} -tags [list match$l matches] -fill yellow]
4317 if {[info exists selectedline] && $row == $selectedline} {
4318 $canv raise $t secsel
4323 proc unmarkmatches {} {
4324 global findids markingmatches findcurline
4326 allcanvs delete matches
4327 catch {unset findids}
4328 set markingmatches 0
4329 catch {unset findcurline}
4332 proc selcanvline {w x y} {
4333 global canv canvy0 ctext linespc
4335 set ymax [lindex [$canv cget -scrollregion] 3]
4336 if {$ymax == {}} return
4337 set yfrac [lindex [$canv yview] 0]
4338 set y [expr {$y + $yfrac * $ymax}]
4339 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4344 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4350 proc commit_descriptor {p} {
4352 if {![info exists commitinfo($p)]} {
4356 if {[llength $commitinfo($p)] > 1} {
4357 set l [lindex $commitinfo($p) 0]
4362 # append some text to the ctext widget, and make any SHA1 ID
4363 # that we know about be a clickable link.
4364 proc appendwithlinks {text tags} {
4365 global ctext commitrow linknum curview pendinglinks
4367 set start [$ctext index "end - 1c"]
4368 $ctext insert end $text $tags
4369 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4373 set linkid [string range $text $s $e]
4375 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4376 setlink $linkid link$linknum
4381 proc setlink {id lk} {
4382 global curview commitrow ctext pendinglinks commitinterest
4384 if {[info exists commitrow($curview,$id)]} {
4385 $ctext tag conf $lk -foreground blue -underline 1
4386 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4387 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4388 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4390 lappend pendinglinks($id) $lk
4391 lappend commitinterest($id) {makelink %I}
4395 proc makelink {id} {
4398 if {![info exists pendinglinks($id)]} return
4399 foreach lk $pendinglinks($id) {
4402 unset pendinglinks($id)
4405 proc linkcursor {w inc} {
4406 global linkentercount curtextcursor
4408 if {[incr linkentercount $inc] > 0} {
4409 $w configure -cursor hand2
4411 $w configure -cursor $curtextcursor
4412 if {$linkentercount < 0} {
4413 set linkentercount 0
4418 proc viewnextline {dir} {
4422 set ymax [lindex [$canv cget -scrollregion] 3]
4423 set wnow [$canv yview]
4424 set wtop [expr {[lindex $wnow 0] * $ymax}]
4425 set newtop [expr {$wtop + $dir * $linespc}]
4428 } elseif {$newtop > $ymax} {
4431 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4434 # add a list of tag or branch names at position pos
4435 # returns the number of names inserted
4436 proc appendrefs {pos ids var} {
4437 global ctext commitrow linknum curview $var maxrefs
4439 if {[catch {$ctext index $pos}]} {
4442 $ctext conf -state normal
4443 $ctext delete $pos "$pos lineend"
4446 foreach tag [set $var\($id\)] {
4447 lappend tags [list $tag $id]
4450 if {[llength $tags] > $maxrefs} {
4451 $ctext insert $pos "many ([llength $tags])"
4453 set tags [lsort -index 0 -decreasing $tags]
4456 set id [lindex $ti 1]
4459 $ctext tag delete $lk
4460 $ctext insert $pos $sep
4461 $ctext insert $pos [lindex $ti 0] $lk
4466 $ctext conf -state disabled
4467 return [llength $tags]
4470 # called when we have finished computing the nearby tags
4471 proc dispneartags {delay} {
4472 global selectedline currentid showneartags tagphase
4474 if {![info exists selectedline] || !$showneartags} return
4475 after cancel dispnexttag
4477 after 200 dispnexttag
4480 after idle dispnexttag
4485 proc dispnexttag {} {
4486 global selectedline currentid showneartags tagphase ctext
4488 if {![info exists selectedline] || !$showneartags} return
4489 switch -- $tagphase {
4491 set dtags [desctags $currentid]
4493 appendrefs precedes $dtags idtags
4497 set atags [anctags $currentid]
4499 appendrefs follows $atags idtags
4503 set dheads [descheads $currentid]
4504 if {$dheads ne {}} {
4505 if {[appendrefs branch $dheads idheads] > 1
4506 && [$ctext get "branch -3c"] eq "h"} {
4507 # turn "Branch" into "Branches"
4508 $ctext conf -state normal
4509 $ctext insert "branch -2c" "es"
4510 $ctext conf -state disabled
4515 if {[incr tagphase] <= 2} {
4516 after idle dispnexttag
4520 proc make_secsel {l} {
4521 global linehtag linentag linedtag canv canv2 canv3
4523 if {![info exists linehtag($l)]} return
4525 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4526 -tags secsel -fill [$canv cget -selectbackground]]
4528 $canv2 delete secsel
4529 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4530 -tags secsel -fill [$canv2 cget -selectbackground]]
4532 $canv3 delete secsel
4533 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4534 -tags secsel -fill [$canv3 cget -selectbackground]]
4538 proc selectline {l isnew} {
4539 global canv ctext commitinfo selectedline
4541 global canvy0 linespc parentlist children curview
4542 global currentid sha1entry
4543 global commentend idtags linknum
4544 global mergemax numcommits pending_select
4545 global cmitmode showneartags allcommits
4547 catch {unset pending_select}
4550 cancel_next_highlight
4552 if {$l < 0 || $l >= $numcommits} return
4553 set y [expr {$canvy0 + $l * $linespc}]
4554 set ymax [lindex [$canv cget -scrollregion] 3]
4555 set ytop [expr {$y - $linespc - 1}]
4556 set ybot [expr {$y + $linespc + 1}]
4557 set wnow [$canv yview]
4558 set wtop [expr {[lindex $wnow 0] * $ymax}]
4559 set wbot [expr {[lindex $wnow 1] * $ymax}]
4560 set wh [expr {$wbot - $wtop}]
4562 if {$ytop < $wtop} {
4563 if {$ybot < $wtop} {
4564 set newtop [expr {$y - $wh / 2.0}]
4567 if {$newtop > $wtop - $linespc} {
4568 set newtop [expr {$wtop - $linespc}]
4571 } elseif {$ybot > $wbot} {
4572 if {$ytop > $wbot} {
4573 set newtop [expr {$y - $wh / 2.0}]
4575 set newtop [expr {$ybot - $wh}]
4576 if {$newtop < $wtop + $linespc} {
4577 set newtop [expr {$wtop + $linespc}]
4581 if {$newtop != $wtop} {
4585 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4592 addtohistory [list selectline $l 0]
4597 set id [lindex $displayorder $l]
4599 $sha1entry delete 0 end
4600 $sha1entry insert 0 $id
4601 $sha1entry selection from 0
4602 $sha1entry selection to end
4605 $ctext conf -state normal
4608 set info $commitinfo($id)
4609 set date [formatdate [lindex $info 2]]
4610 $ctext insert end "Author: [lindex $info 1] $date\n"
4611 set date [formatdate [lindex $info 4]]
4612 $ctext insert end "Committer: [lindex $info 3] $date\n"
4613 if {[info exists idtags($id)]} {
4614 $ctext insert end "Tags:"
4615 foreach tag $idtags($id) {
4616 $ctext insert end " $tag"
4618 $ctext insert end "\n"
4622 set olds [lindex $parentlist $l]
4623 if {[llength $olds] > 1} {
4626 if {$np >= $mergemax} {
4631 $ctext insert end "Parent: " $tag
4632 appendwithlinks [commit_descriptor $p] {}
4637 append headers "Parent: [commit_descriptor $p]"
4641 foreach c $children($curview,$id) {
4642 append headers "Child: [commit_descriptor $c]"
4645 # make anything that looks like a SHA1 ID be a clickable link
4646 appendwithlinks $headers {}
4647 if {$showneartags} {
4648 if {![info exists allcommits]} {
4651 $ctext insert end "Branch: "
4652 $ctext mark set branch "end -1c"
4653 $ctext mark gravity branch left
4654 $ctext insert end "\nFollows: "
4655 $ctext mark set follows "end -1c"
4656 $ctext mark gravity follows left
4657 $ctext insert end "\nPrecedes: "
4658 $ctext mark set precedes "end -1c"
4659 $ctext mark gravity precedes left
4660 $ctext insert end "\n"
4663 $ctext insert end "\n"
4664 set comment [lindex $info 5]
4665 if {[string first "\r" $comment] >= 0} {
4666 set comment [string map {"\r" "\n "} $comment]
4668 appendwithlinks $comment {comment}
4670 $ctext tag remove found 1.0 end
4671 $ctext conf -state disabled
4672 set commentend [$ctext index "end - 1c"]
4674 init_flist "Comments"
4675 if {$cmitmode eq "tree"} {
4677 } elseif {[llength $olds] <= 1} {
4684 proc selfirstline {} {
4689 proc sellastline {} {
4692 set l [expr {$numcommits - 1}]
4696 proc selnextline {dir} {
4699 if {![info exists selectedline]} return
4700 set l [expr {$selectedline + $dir}]
4705 proc selnextpage {dir} {
4706 global canv linespc selectedline numcommits
4708 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4712 allcanvs yview scroll [expr {$dir * $lpp}] units
4714 if {![info exists selectedline]} return
4715 set l [expr {$selectedline + $dir * $lpp}]
4718 } elseif {$l >= $numcommits} {
4719 set l [expr $numcommits - 1]
4725 proc unselectline {} {
4726 global selectedline currentid
4728 catch {unset selectedline}
4729 catch {unset currentid}
4730 allcanvs delete secsel
4732 cancel_next_highlight
4735 proc reselectline {} {
4738 if {[info exists selectedline]} {
4739 selectline $selectedline 0
4743 proc addtohistory {cmd} {
4744 global history historyindex curview
4746 set elt [list $curview $cmd]
4747 if {$historyindex > 0
4748 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4752 if {$historyindex < [llength $history]} {
4753 set history [lreplace $history $historyindex end $elt]
4755 lappend history $elt
4758 if {$historyindex > 1} {
4759 .tf.bar.leftbut conf -state normal
4761 .tf.bar.leftbut conf -state disabled
4763 .tf.bar.rightbut conf -state disabled
4769 set view [lindex $elt 0]
4770 set cmd [lindex $elt 1]
4771 if {$curview != $view} {
4778 global history historyindex
4781 if {$historyindex > 1} {
4782 incr historyindex -1
4783 godo [lindex $history [expr {$historyindex - 1}]]
4784 .tf.bar.rightbut conf -state normal
4786 if {$historyindex <= 1} {
4787 .tf.bar.leftbut conf -state disabled
4792 global history historyindex
4795 if {$historyindex < [llength $history]} {
4796 set cmd [lindex $history $historyindex]
4799 .tf.bar.leftbut conf -state normal
4801 if {$historyindex >= [llength $history]} {
4802 .tf.bar.rightbut conf -state disabled
4807 global treefilelist treeidlist diffids diffmergeid treepending
4808 global nullid nullid2
4811 catch {unset diffmergeid}
4812 if {![info exists treefilelist($id)]} {
4813 if {![info exists treepending]} {
4814 if {$id eq $nullid} {
4815 set cmd [list | git ls-files]
4816 } elseif {$id eq $nullid2} {
4817 set cmd [list | git ls-files --stage -t]
4819 set cmd [list | git ls-tree -r $id]
4821 if {[catch {set gtf [open $cmd r]}]} {
4825 set treefilelist($id) {}
4826 set treeidlist($id) {}
4827 fconfigure $gtf -blocking 0
4828 filerun $gtf [list gettreeline $gtf $id]
4835 proc gettreeline {gtf id} {
4836 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4839 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4840 if {$diffids eq $nullid} {
4843 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4844 set i [string first "\t" $line]
4845 if {$i < 0} continue
4846 set sha1 [lindex $line 2]
4847 set fname [string range $line [expr {$i+1}] end]
4848 if {[string index $fname 0] eq "\""} {
4849 set fname [lindex $fname 0]
4851 lappend treeidlist($id) $sha1
4853 lappend treefilelist($id) $fname
4856 return [expr {$nl >= 1000? 2: 1}]
4860 if {$cmitmode ne "tree"} {
4861 if {![info exists diffmergeid]} {
4862 gettreediffs $diffids
4864 } elseif {$id ne $diffids} {
4873 global treefilelist treeidlist diffids nullid nullid2
4874 global ctext commentend
4876 set i [lsearch -exact $treefilelist($diffids) $f]
4878 puts "oops, $f not in list for id $diffids"
4881 if {$diffids eq $nullid} {
4882 if {[catch {set bf [open $f r]} err]} {
4883 puts "oops, can't read $f: $err"
4887 set blob [lindex $treeidlist($diffids) $i]
4888 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4889 puts "oops, error reading blob $blob: $err"
4893 fconfigure $bf -blocking 0
4894 filerun $bf [list getblobline $bf $diffids]
4895 $ctext config -state normal
4896 clear_ctext $commentend
4897 $ctext insert end "\n"
4898 $ctext insert end "$f\n" filesep
4899 $ctext config -state disabled
4900 $ctext yview $commentend
4903 proc getblobline {bf id} {
4904 global diffids cmitmode ctext
4906 if {$id ne $diffids || $cmitmode ne "tree"} {
4910 $ctext config -state normal
4912 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4913 $ctext insert end "$line\n"
4916 # delete last newline
4917 $ctext delete "end - 2c" "end - 1c"
4921 $ctext config -state disabled
4922 return [expr {$nl >= 1000? 2: 1}]
4925 proc mergediff {id l} {
4926 global diffmergeid diffopts mdifffd
4932 # this doesn't seem to actually affect anything...
4933 set env(GIT_DIFF_OPTS) $diffopts
4934 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4935 if {[catch {set mdf [open $cmd r]} err]} {
4936 error_popup "Error getting merge diffs: $err"
4939 fconfigure $mdf -blocking 0
4940 set mdifffd($id) $mdf
4941 set np [llength [lindex $parentlist $l]]
4942 filerun $mdf [list getmergediffline $mdf $id $np]
4945 proc getmergediffline {mdf id np} {
4946 global diffmergeid ctext cflist mergemax
4947 global difffilestart mdifffd
4949 $ctext conf -state normal
4951 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4952 if {![info exists diffmergeid] || $id != $diffmergeid
4953 || $mdf != $mdifffd($id)} {
4957 if {[regexp {^diff --cc (.*)} $line match fname]} {
4958 # start of a new file
4959 $ctext insert end "\n"
4960 set here [$ctext index "end - 1c"]
4961 lappend difffilestart $here
4962 add_flist [list $fname]
4963 set l [expr {(78 - [string length $fname]) / 2}]
4964 set pad [string range "----------------------------------------" 1 $l]
4965 $ctext insert end "$pad $fname $pad\n" filesep
4966 } elseif {[regexp {^@@} $line]} {
4967 $ctext insert end "$line\n" hunksep
4968 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4971 # parse the prefix - one ' ', '-' or '+' for each parent
4976 for {set j 0} {$j < $np} {incr j} {
4977 set c [string range $line $j $j]
4980 } elseif {$c == "-"} {
4982 } elseif {$c == "+"} {
4991 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4992 # line doesn't appear in result, parents in $minuses have the line
4993 set num [lindex $minuses 0]
4994 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4995 # line appears in result, parents in $pluses don't have the line
4996 lappend tags mresult
4997 set num [lindex $spaces 0]
5000 if {$num >= $mergemax} {
5005 $ctext insert end "$line\n" $tags
5008 $ctext conf -state disabled
5013 return [expr {$nr >= 1000? 2: 1}]
5016 proc startdiff {ids} {
5017 global treediffs diffids treepending diffmergeid nullid nullid2
5020 catch {unset diffmergeid}
5021 if {![info exists treediffs($ids)] ||
5022 [lsearch -exact $ids $nullid] >= 0 ||
5023 [lsearch -exact $ids $nullid2] >= 0} {
5024 if {![info exists treepending]} {
5032 proc addtocflist {ids} {
5033 global treediffs cflist
5034 add_flist $treediffs($ids)
5038 proc diffcmd {ids flags} {
5039 global nullid nullid2
5041 set i [lsearch -exact $ids $nullid]
5042 set j [lsearch -exact $ids $nullid2]
5044 if {[llength $ids] > 1 && $j < 0} {
5045 # comparing working directory with some specific revision
5046 set cmd [concat | git diff-index $flags]
5048 lappend cmd -R [lindex $ids 1]
5050 lappend cmd [lindex $ids 0]
5053 # comparing working directory with index
5054 set cmd [concat | git diff-files $flags]
5059 } elseif {$j >= 0} {
5060 set cmd [concat | git diff-index --cached $flags]
5061 if {[llength $ids] > 1} {
5062 # comparing index with specific revision
5064 lappend cmd -R [lindex $ids 1]
5066 lappend cmd [lindex $ids 0]
5069 # comparing index with HEAD
5073 set cmd [concat | git diff-tree -r $flags $ids]
5078 proc gettreediffs {ids} {
5079 global treediff treepending
5081 set treepending $ids
5083 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5084 fconfigure $gdtf -blocking 0
5085 filerun $gdtf [list gettreediffline $gdtf $ids]
5088 proc gettreediffline {gdtf ids} {
5089 global treediff treediffs treepending diffids diffmergeid
5093 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5094 set i [string first "\t" $line]
5096 set file [string range $line [expr {$i+1}] end]
5097 if {[string index $file 0] eq "\""} {
5098 set file [lindex $file 0]
5100 lappend treediff $file
5104 return [expr {$nr >= 1000? 2: 1}]
5107 set treediffs($ids) $treediff
5109 if {$cmitmode eq "tree"} {
5111 } elseif {$ids != $diffids} {
5112 if {![info exists diffmergeid]} {
5113 gettreediffs $diffids
5121 # empty string or positive integer
5122 proc diffcontextvalidate {v} {
5123 return [regexp {^(|[1-9][0-9]*)$} $v]
5126 proc diffcontextchange {n1 n2 op} {
5127 global diffcontextstring diffcontext
5129 if {[string is integer -strict $diffcontextstring]} {
5130 if {$diffcontextstring > 0} {
5131 set diffcontext $diffcontextstring
5137 proc getblobdiffs {ids} {
5138 global diffopts blobdifffd diffids env
5139 global diffinhdr treediffs
5142 set env(GIT_DIFF_OPTS) $diffopts
5143 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5144 puts "error getting diffs: $err"
5148 fconfigure $bdf -blocking 0
5149 set blobdifffd($ids) $bdf
5150 filerun $bdf [list getblobdiffline $bdf $diffids]
5153 proc setinlist {var i val} {
5156 while {[llength [set $var]] < $i} {
5159 if {[llength [set $var]] == $i} {
5166 proc makediffhdr {fname ids} {
5167 global ctext curdiffstart treediffs
5169 set i [lsearch -exact $treediffs($ids) $fname]
5171 setinlist difffilestart $i $curdiffstart
5173 set l [expr {(78 - [string length $fname]) / 2}]
5174 set pad [string range "----------------------------------------" 1 $l]
5175 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5178 proc getblobdiffline {bdf ids} {
5179 global diffids blobdifffd ctext curdiffstart
5180 global diffnexthead diffnextnote difffilestart
5181 global diffinhdr treediffs
5184 $ctext conf -state normal
5185 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5186 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5190 if {![string compare -length 11 "diff --git " $line]} {
5191 # trim off "diff --git "
5192 set line [string range $line 11 end]
5194 # start of a new file
5195 $ctext insert end "\n"
5196 set curdiffstart [$ctext index "end - 1c"]
5197 $ctext insert end "\n" filesep
5198 # If the name hasn't changed the length will be odd,
5199 # the middle char will be a space, and the two bits either
5200 # side will be a/name and b/name, or "a/name" and "b/name".
5201 # If the name has changed we'll get "rename from" and
5202 # "rename to" or "copy from" and "copy to" lines following this,
5203 # and we'll use them to get the filenames.
5204 # This complexity is necessary because spaces in the filename(s)
5205 # don't get escaped.
5206 set l [string length $line]
5207 set i [expr {$l / 2}]
5208 if {!(($l & 1) && [string index $line $i] eq " " &&
5209 [string range $line 2 [expr {$i - 1}]] eq \
5210 [string range $line [expr {$i + 3}] end])} {
5213 # unescape if quoted and chop off the a/ from the front
5214 if {[string index $line 0] eq "\""} {
5215 set fname [string range [lindex $line 0] 2 end]
5217 set fname [string range $line 2 [expr {$i - 1}]]
5219 makediffhdr $fname $ids
5221 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5222 $line match f1l f1c f2l f2c rest]} {
5223 $ctext insert end "$line\n" hunksep
5226 } elseif {$diffinhdr} {
5227 if {![string compare -length 12 "rename from " $line] ||
5228 ![string compare -length 10 "copy from " $line]} {
5229 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5230 if {[string index $fname 0] eq "\""} {
5231 set fname [lindex $fname 0]
5233 set i [lsearch -exact $treediffs($ids) $fname]
5235 setinlist difffilestart $i $curdiffstart
5237 } elseif {![string compare -length 10 $line "rename to "] ||
5238 ![string compare -length 8 $line "copy to "]} {
5239 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5240 if {[string index $fname 0] eq "\""} {
5241 set fname [lindex $fname 0]
5243 makediffhdr $fname $ids
5244 } elseif {[string compare -length 3 $line "---"] == 0} {
5247 } elseif {[string compare -length 3 $line "+++"] == 0} {
5251 $ctext insert end "$line\n" filesep
5254 set x [string range $line 0 0]
5255 if {$x == "-" || $x == "+"} {
5256 set tag [expr {$x == "+"}]
5257 $ctext insert end "$line\n" d$tag
5258 } elseif {$x == " "} {
5259 $ctext insert end "$line\n"
5261 # "\ No newline at end of file",
5262 # or something else we don't recognize
5263 $ctext insert end "$line\n" hunksep
5267 $ctext conf -state disabled
5272 return [expr {$nr >= 1000? 2: 1}]
5275 proc changediffdisp {} {
5276 global ctext diffelide
5278 $ctext tag conf d0 -elide [lindex $diffelide 0]
5279 $ctext tag conf d1 -elide [lindex $diffelide 1]
5283 global difffilestart ctext
5284 set prev [lindex $difffilestart 0]
5285 set here [$ctext index @0,0]
5286 foreach loc $difffilestart {
5287 if {[$ctext compare $loc >= $here]} {
5297 global difffilestart ctext
5298 set here [$ctext index @0,0]
5299 foreach loc $difffilestart {
5300 if {[$ctext compare $loc > $here]} {
5307 proc clear_ctext {{first 1.0}} {
5308 global ctext smarktop smarkbot
5311 set l [lindex [split $first .] 0]
5312 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5315 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5318 $ctext delete $first end
5319 if {$first eq "1.0"} {
5320 catch {unset pendinglinks}
5324 proc incrsearch {name ix op} {
5325 global ctext searchstring searchdirn
5327 $ctext tag remove found 1.0 end
5328 if {[catch {$ctext index anchor}]} {
5329 # no anchor set, use start of selection, or of visible area
5330 set sel [$ctext tag ranges sel]
5332 $ctext mark set anchor [lindex $sel 0]
5333 } elseif {$searchdirn eq "-forwards"} {
5334 $ctext mark set anchor @0,0
5336 $ctext mark set anchor @0,[winfo height $ctext]
5339 if {$searchstring ne {}} {
5340 set here [$ctext search $searchdirn -- $searchstring anchor]
5349 global sstring ctext searchstring searchdirn
5352 $sstring icursor end
5353 set searchdirn -forwards
5354 if {$searchstring ne {}} {
5355 set sel [$ctext tag ranges sel]
5357 set start "[lindex $sel 0] + 1c"
5358 } elseif {[catch {set start [$ctext index anchor]}]} {
5361 set match [$ctext search -count mlen -- $searchstring $start]
5362 $ctext tag remove sel 1.0 end
5368 set mend "$match + $mlen c"
5369 $ctext tag add sel $match $mend
5370 $ctext mark unset anchor
5374 proc dosearchback {} {
5375 global sstring ctext searchstring searchdirn
5378 $sstring icursor end
5379 set searchdirn -backwards
5380 if {$searchstring ne {}} {
5381 set sel [$ctext tag ranges sel]
5383 set start [lindex $sel 0]
5384 } elseif {[catch {set start [$ctext index anchor]}]} {
5385 set start @0,[winfo height $ctext]
5387 set match [$ctext search -backwards -count ml -- $searchstring $start]
5388 $ctext tag remove sel 1.0 end
5394 set mend "$match + $ml c"
5395 $ctext tag add sel $match $mend
5396 $ctext mark unset anchor
5400 proc searchmark {first last} {
5401 global ctext searchstring
5405 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5406 if {$match eq {}} break
5407 set mend "$match + $mlen c"
5408 $ctext tag add found $match $mend
5412 proc searchmarkvisible {doall} {
5413 global ctext smarktop smarkbot
5415 set topline [lindex [split [$ctext index @0,0] .] 0]
5416 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5417 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5418 # no overlap with previous
5419 searchmark $topline $botline
5420 set smarktop $topline
5421 set smarkbot $botline
5423 if {$topline < $smarktop} {
5424 searchmark $topline [expr {$smarktop-1}]
5425 set smarktop $topline
5427 if {$botline > $smarkbot} {
5428 searchmark [expr {$smarkbot+1}] $botline
5429 set smarkbot $botline
5434 proc scrolltext {f0 f1} {
5437 .bleft.sb set $f0 $f1
5438 if {$searchstring ne {}} {
5444 global linespc charspc canvx0 canvy0 mainfont
5445 global xspc1 xspc2 lthickness
5447 set linespc [font metrics $mainfont -linespace]
5448 set charspc [font measure $mainfont "m"]
5449 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5450 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5451 set lthickness [expr {int($linespc / 9) + 1}]
5452 set xspc1(0) $linespc
5460 set ymax [lindex [$canv cget -scrollregion] 3]
5461 if {$ymax eq {} || $ymax == 0} return
5462 set span [$canv yview]
5465 allcanvs yview moveto [lindex $span 0]
5467 if {[info exists selectedline]} {
5468 selectline $selectedline 0
5469 allcanvs yview moveto [lindex $span 0]
5473 proc incrfont {inc} {
5474 global mainfont textfont ctext canv phase cflist showrefstop
5475 global charspc tabstop
5476 global stopped entries
5478 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5479 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5481 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5482 $cflist conf -font $textfont
5483 $ctext tag conf filesep -font [concat $textfont bold]
5484 foreach e $entries {
5485 $e conf -font $mainfont
5487 if {$phase eq "getcommits"} {
5488 $canv itemconf textitems -font $mainfont
5490 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5491 $showrefstop.list conf -font $mainfont
5497 global sha1entry sha1string
5498 if {[string length $sha1string] == 40} {
5499 $sha1entry delete 0 end
5503 proc sha1change {n1 n2 op} {
5504 global sha1string currentid sha1but
5505 if {$sha1string == {}
5506 || ([info exists currentid] && $sha1string == $currentid)} {
5511 if {[$sha1but cget -state] == $state} return
5512 if {$state == "normal"} {
5513 $sha1but conf -state normal -relief raised -text "Goto: "
5515 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5519 proc gotocommit {} {
5520 global sha1string currentid commitrow tagids headids
5521 global displayorder numcommits curview
5523 if {$sha1string == {}
5524 || ([info exists currentid] && $sha1string == $currentid)} return
5525 if {[info exists tagids($sha1string)]} {
5526 set id $tagids($sha1string)
5527 } elseif {[info exists headids($sha1string)]} {
5528 set id $headids($sha1string)
5530 set id [string tolower $sha1string]
5531 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5533 foreach i $displayorder {
5534 if {[string match $id* $i]} {
5538 if {$matches ne {}} {
5539 if {[llength $matches] > 1} {
5540 error_popup "Short SHA1 id $id is ambiguous"
5543 set id [lindex $matches 0]
5547 if {[info exists commitrow($curview,$id)]} {
5548 selectline $commitrow($curview,$id) 1
5551 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5556 error_popup "$type $sha1string is not known"
5559 proc lineenter {x y id} {
5560 global hoverx hovery hoverid hovertimer
5561 global commitinfo canv
5563 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5567 if {[info exists hovertimer]} {
5568 after cancel $hovertimer
5570 set hovertimer [after 500 linehover]
5574 proc linemotion {x y id} {
5575 global hoverx hovery hoverid hovertimer
5577 if {[info exists hoverid] && $id == $hoverid} {
5580 if {[info exists hovertimer]} {
5581 after cancel $hovertimer
5583 set hovertimer [after 500 linehover]
5587 proc lineleave {id} {
5588 global hoverid hovertimer canv
5590 if {[info exists hoverid] && $id == $hoverid} {
5592 if {[info exists hovertimer]} {
5593 after cancel $hovertimer
5601 global hoverx hovery hoverid hovertimer
5602 global canv linespc lthickness
5603 global commitinfo mainfont
5605 set text [lindex $commitinfo($hoverid) 0]
5606 set ymax [lindex [$canv cget -scrollregion] 3]
5607 if {$ymax == {}} return
5608 set yfrac [lindex [$canv yview] 0]
5609 set x [expr {$hoverx + 2 * $linespc}]
5610 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5611 set x0 [expr {$x - 2 * $lthickness}]
5612 set y0 [expr {$y - 2 * $lthickness}]
5613 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5614 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5615 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5616 -fill \#ffff80 -outline black -width 1 -tags hover]
5618 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5623 proc clickisonarrow {id y} {
5626 set ranges [rowranges $id]
5627 set thresh [expr {2 * $lthickness + 6}]
5628 set n [expr {[llength $ranges] - 1}]
5629 for {set i 1} {$i < $n} {incr i} {
5630 set row [lindex $ranges $i]
5631 if {abs([yc $row] - $y) < $thresh} {
5638 proc arrowjump {id n y} {
5641 # 1 <-> 2, 3 <-> 4, etc...
5642 set n [expr {(($n - 1) ^ 1) + 1}]
5643 set row [lindex [rowranges $id] $n]
5645 set ymax [lindex [$canv cget -scrollregion] 3]
5646 if {$ymax eq {} || $ymax <= 0} return
5647 set view [$canv yview]
5648 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5649 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5653 allcanvs yview moveto $yfrac
5656 proc lineclick {x y id isnew} {
5657 global ctext commitinfo children canv thickerline curview commitrow
5659 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5664 # draw this line thicker than normal
5668 set ymax [lindex [$canv cget -scrollregion] 3]
5669 if {$ymax eq {}} return
5670 set yfrac [lindex [$canv yview] 0]
5671 set y [expr {$y + $yfrac * $ymax}]
5673 set dirn [clickisonarrow $id $y]
5675 arrowjump $id $dirn $y
5680 addtohistory [list lineclick $x $y $id 0]
5682 # fill the details pane with info about this line
5683 $ctext conf -state normal
5685 $ctext insert end "Parent:\t"
5686 $ctext insert end $id link0
5688 set info $commitinfo($id)
5689 $ctext insert end "\n\t[lindex $info 0]\n"
5690 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5691 set date [formatdate [lindex $info 2]]
5692 $ctext insert end "\tDate:\t$date\n"
5693 set kids $children($curview,$id)
5695 $ctext insert end "\nChildren:"
5697 foreach child $kids {
5699 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5700 set info $commitinfo($child)
5701 $ctext insert end "\n\t"
5702 $ctext insert end $child link$i
5703 setlink $child link$i
5704 $ctext insert end "\n\t[lindex $info 0]"
5705 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5706 set date [formatdate [lindex $info 2]]
5707 $ctext insert end "\n\tDate:\t$date\n"
5710 $ctext conf -state disabled
5714 proc normalline {} {
5716 if {[info exists thickerline]} {
5724 global commitrow curview
5725 if {[info exists commitrow($curview,$id)]} {
5726 selectline $commitrow($curview,$id) 1
5732 if {![info exists startmstime]} {
5733 set startmstime [clock clicks -milliseconds]
5735 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5738 proc rowmenu {x y id} {
5739 global rowctxmenu commitrow selectedline rowmenuid curview
5740 global nullid nullid2 fakerowmenu mainhead
5743 if {![info exists selectedline]
5744 || $commitrow($curview,$id) eq $selectedline} {
5749 if {$id ne $nullid && $id ne $nullid2} {
5750 set menu $rowctxmenu
5751 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5753 set menu $fakerowmenu
5755 $menu entryconfigure "Diff this*" -state $state
5756 $menu entryconfigure "Diff selected*" -state $state
5757 $menu entryconfigure "Make patch" -state $state
5758 tk_popup $menu $x $y
5761 proc diffvssel {dirn} {
5762 global rowmenuid selectedline displayorder
5764 if {![info exists selectedline]} return
5766 set oldid [lindex $displayorder $selectedline]
5767 set newid $rowmenuid
5769 set oldid $rowmenuid
5770 set newid [lindex $displayorder $selectedline]
5772 addtohistory [list doseldiff $oldid $newid]
5773 doseldiff $oldid $newid
5776 proc doseldiff {oldid newid} {
5780 $ctext conf -state normal
5783 $ctext insert end "From "
5784 $ctext insert end $oldid link0
5785 setlink $oldid link0
5786 $ctext insert end "\n "
5787 $ctext insert end [lindex $commitinfo($oldid) 0]
5788 $ctext insert end "\n\nTo "
5789 $ctext insert end $newid link1
5790 setlink $newid link1
5791 $ctext insert end "\n "
5792 $ctext insert end [lindex $commitinfo($newid) 0]
5793 $ctext insert end "\n"
5794 $ctext conf -state disabled
5795 $ctext tag remove found 1.0 end
5796 startdiff [list $oldid $newid]
5800 global rowmenuid currentid commitinfo patchtop patchnum
5802 if {![info exists currentid]} return
5803 set oldid $currentid
5804 set oldhead [lindex $commitinfo($oldid) 0]
5805 set newid $rowmenuid
5806 set newhead [lindex $commitinfo($newid) 0]
5809 catch {destroy $top}
5811 label $top.title -text "Generate patch"
5812 grid $top.title - -pady 10
5813 label $top.from -text "From:"
5814 entry $top.fromsha1 -width 40 -relief flat
5815 $top.fromsha1 insert 0 $oldid
5816 $top.fromsha1 conf -state readonly
5817 grid $top.from $top.fromsha1 -sticky w
5818 entry $top.fromhead -width 60 -relief flat
5819 $top.fromhead insert 0 $oldhead
5820 $top.fromhead conf -state readonly
5821 grid x $top.fromhead -sticky w
5822 label $top.to -text "To:"
5823 entry $top.tosha1 -width 40 -relief flat
5824 $top.tosha1 insert 0 $newid
5825 $top.tosha1 conf -state readonly
5826 grid $top.to $top.tosha1 -sticky w
5827 entry $top.tohead -width 60 -relief flat
5828 $top.tohead insert 0 $newhead
5829 $top.tohead conf -state readonly
5830 grid x $top.tohead -sticky w
5831 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5832 grid $top.rev x -pady 10
5833 label $top.flab -text "Output file:"
5834 entry $top.fname -width 60
5835 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5837 grid $top.flab $top.fname -sticky w
5839 button $top.buts.gen -text "Generate" -command mkpatchgo
5840 button $top.buts.can -text "Cancel" -command mkpatchcan
5841 grid $top.buts.gen $top.buts.can
5842 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5843 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5844 grid $top.buts - -pady 10 -sticky ew
5848 proc mkpatchrev {} {
5851 set oldid [$patchtop.fromsha1 get]
5852 set oldhead [$patchtop.fromhead get]
5853 set newid [$patchtop.tosha1 get]
5854 set newhead [$patchtop.tohead get]
5855 foreach e [list fromsha1 fromhead tosha1 tohead] \
5856 v [list $newid $newhead $oldid $oldhead] {
5857 $patchtop.$e conf -state normal
5858 $patchtop.$e delete 0 end
5859 $patchtop.$e insert 0 $v
5860 $patchtop.$e conf -state readonly
5865 global patchtop nullid nullid2
5867 set oldid [$patchtop.fromsha1 get]
5868 set newid [$patchtop.tosha1 get]
5869 set fname [$patchtop.fname get]
5870 set cmd [diffcmd [list $oldid $newid] -p]
5871 lappend cmd >$fname &
5872 if {[catch {eval exec $cmd} err]} {
5873 error_popup "Error creating patch: $err"
5875 catch {destroy $patchtop}
5879 proc mkpatchcan {} {
5882 catch {destroy $patchtop}
5887 global rowmenuid mktagtop commitinfo
5891 catch {destroy $top}
5893 label $top.title -text "Create tag"
5894 grid $top.title - -pady 10
5895 label $top.id -text "ID:"
5896 entry $top.sha1 -width 40 -relief flat
5897 $top.sha1 insert 0 $rowmenuid
5898 $top.sha1 conf -state readonly
5899 grid $top.id $top.sha1 -sticky w
5900 entry $top.head -width 60 -relief flat
5901 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5902 $top.head conf -state readonly
5903 grid x $top.head -sticky w
5904 label $top.tlab -text "Tag name:"
5905 entry $top.tag -width 60
5906 grid $top.tlab $top.tag -sticky w
5908 button $top.buts.gen -text "Create" -command mktaggo
5909 button $top.buts.can -text "Cancel" -command mktagcan
5910 grid $top.buts.gen $top.buts.can
5911 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5912 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5913 grid $top.buts - -pady 10 -sticky ew
5918 global mktagtop env tagids idtags
5920 set id [$mktagtop.sha1 get]
5921 set tag [$mktagtop.tag get]
5923 error_popup "No tag name specified"
5926 if {[info exists tagids($tag)]} {
5927 error_popup "Tag \"$tag\" already exists"
5932 set fname [file join $dir "refs/tags" $tag]
5933 set f [open $fname w]
5937 error_popup "Error creating tag: $err"
5941 set tagids($tag) $id
5942 lappend idtags($id) $tag
5949 proc redrawtags {id} {
5950 global canv linehtag commitrow idpos selectedline curview
5951 global mainfont canvxmax iddrawn
5953 if {![info exists commitrow($curview,$id)]} return
5954 if {![info exists iddrawn($id)]} return
5955 drawcommits $commitrow($curview,$id)
5956 $canv delete tag.$id
5957 set xt [eval drawtags $id $idpos($id)]
5958 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5959 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5960 set xr [expr {$xt + [font measure $mainfont $text]}]
5961 if {$xr > $canvxmax} {
5965 if {[info exists selectedline]
5966 && $selectedline == $commitrow($curview,$id)} {
5967 selectline $selectedline 0
5974 catch {destroy $mktagtop}
5983 proc writecommit {} {
5984 global rowmenuid wrcomtop commitinfo wrcomcmd
5986 set top .writecommit
5988 catch {destroy $top}
5990 label $top.title -text "Write commit to file"
5991 grid $top.title - -pady 10
5992 label $top.id -text "ID:"
5993 entry $top.sha1 -width 40 -relief flat
5994 $top.sha1 insert 0 $rowmenuid
5995 $top.sha1 conf -state readonly
5996 grid $top.id $top.sha1 -sticky w
5997 entry $top.head -width 60 -relief flat
5998 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5999 $top.head conf -state readonly
6000 grid x $top.head -sticky w
6001 label $top.clab -text "Command:"
6002 entry $top.cmd -width 60 -textvariable wrcomcmd
6003 grid $top.clab $top.cmd -sticky w -pady 10
6004 label $top.flab -text "Output file:"
6005 entry $top.fname -width 60
6006 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6007 grid $top.flab $top.fname -sticky w
6009 button $top.buts.gen -text "Write" -command wrcomgo
6010 button $top.buts.can -text "Cancel" -command wrcomcan
6011 grid $top.buts.gen $top.buts.can
6012 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6013 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6014 grid $top.buts - -pady 10 -sticky ew
6021 set id [$wrcomtop.sha1 get]
6022 set cmd "echo $id | [$wrcomtop.cmd get]"
6023 set fname [$wrcomtop.fname get]
6024 if {[catch {exec sh -c $cmd >$fname &} err]} {
6025 error_popup "Error writing commit: $err"
6027 catch {destroy $wrcomtop}
6034 catch {destroy $wrcomtop}
6039 global rowmenuid mkbrtop
6042 catch {destroy $top}
6044 label $top.title -text "Create new branch"
6045 grid $top.title - -pady 10
6046 label $top.id -text "ID:"
6047 entry $top.sha1 -width 40 -relief flat
6048 $top.sha1 insert 0 $rowmenuid
6049 $top.sha1 conf -state readonly
6050 grid $top.id $top.sha1 -sticky w
6051 label $top.nlab -text "Name:"
6052 entry $top.name -width 40
6053 grid $top.nlab $top.name -sticky w
6055 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6056 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6057 grid $top.buts.go $top.buts.can
6058 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6059 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6060 grid $top.buts - -pady 10 -sticky ew
6065 global headids idheads
6067 set name [$top.name get]
6068 set id [$top.sha1 get]
6070 error_popup "Please specify a name for the new branch"
6073 catch {destroy $top}
6077 exec git branch $name $id
6082 set headids($name) $id
6083 lappend idheads($id) $name
6092 proc cherrypick {} {
6093 global rowmenuid curview commitrow
6096 set oldhead [exec git rev-parse HEAD]
6097 set dheads [descheads $rowmenuid]
6098 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6099 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6100 included in branch $mainhead -- really re-apply it?"]
6105 # Unfortunately git-cherry-pick writes stuff to stderr even when
6106 # no error occurs, and exec takes that as an indication of error...
6107 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6112 set newhead [exec git rev-parse HEAD]
6113 if {$newhead eq $oldhead} {
6115 error_popup "No changes committed"
6118 addnewchild $newhead $oldhead
6119 if {[info exists commitrow($curview,$oldhead)]} {
6120 insertrow $commitrow($curview,$oldhead) $newhead
6121 if {$mainhead ne {}} {
6122 movehead $newhead $mainhead
6123 movedhead $newhead $mainhead
6132 global mainheadid mainhead rowmenuid confirm_ok resettype
6133 global showlocalchanges
6136 set w ".confirmreset"
6139 wm title $w "Confirm reset"
6140 message $w.m -text \
6141 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6142 -justify center -aspect 1000
6143 pack $w.m -side top -fill x -padx 20 -pady 20
6144 frame $w.f -relief sunken -border 2
6145 message $w.f.rt -text "Reset type:" -aspect 1000
6146 grid $w.f.rt -sticky w
6148 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6149 -text "Soft: Leave working tree and index untouched"
6150 grid $w.f.soft -sticky w
6151 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6152 -text "Mixed: Leave working tree untouched, reset index"
6153 grid $w.f.mixed -sticky w
6154 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6155 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6156 grid $w.f.hard -sticky w
6157 pack $w.f -side top -fill x
6158 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6159 pack $w.ok -side left -fill x -padx 20 -pady 20
6160 button $w.cancel -text Cancel -command "destroy $w"
6161 pack $w.cancel -side right -fill x -padx 20 -pady 20
6162 bind $w <Visibility> "grab $w; focus $w"
6164 if {!$confirm_ok} return
6165 if {[catch {set fd [open \
6166 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6170 set w ".resetprogress"
6171 filerun $fd [list readresetstat $fd $w]
6174 wm title $w "Reset progress"
6175 message $w.m -text "Reset in progress, please wait..." \
6176 -justify center -aspect 1000
6177 pack $w.m -side top -fill x -padx 20 -pady 5
6178 canvas $w.c -width 150 -height 20 -bg white
6179 $w.c create rect 0 0 0 20 -fill green -tags rect
6180 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6185 proc readresetstat {fd w} {
6186 global mainhead mainheadid showlocalchanges
6188 if {[gets $fd line] >= 0} {
6189 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6190 set x [expr {($m * 150) / $n}]
6191 $w.c coords rect 0 0 $x 20
6197 if {[catch {close $fd} err]} {
6200 set oldhead $mainheadid
6201 set newhead [exec git rev-parse HEAD]
6202 if {$newhead ne $oldhead} {
6203 movehead $newhead $mainhead
6204 movedhead $newhead $mainhead
6205 set mainheadid $newhead
6209 if {$showlocalchanges} {
6215 # context menu for a head
6216 proc headmenu {x y id head} {
6217 global headmenuid headmenuhead headctxmenu mainhead
6220 set headmenuhead $head
6222 if {$head eq $mainhead} {
6225 $headctxmenu entryconfigure 0 -state $state
6226 $headctxmenu entryconfigure 1 -state $state
6227 tk_popup $headctxmenu $x $y
6231 global headmenuid headmenuhead mainhead headids
6232 global showlocalchanges mainheadid
6234 # check the tree is clean first??
6235 set oldmainhead $mainhead
6240 exec git checkout -q $headmenuhead
6246 set mainhead $headmenuhead
6247 set mainheadid $headmenuid
6248 if {[info exists headids($oldmainhead)]} {
6249 redrawtags $headids($oldmainhead)
6251 redrawtags $headmenuid
6253 if {$showlocalchanges} {
6259 global headmenuid headmenuhead mainhead
6262 set head $headmenuhead
6264 # this check shouldn't be needed any more...
6265 if {$head eq $mainhead} {
6266 error_popup "Cannot delete the currently checked-out branch"
6269 set dheads [descheads $id]
6270 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6271 # the stuff on this branch isn't on any other branch
6272 if {![confirm_popup "The commits on branch $head aren't on any other\
6273 branch.\nReally delete branch $head?"]} return
6277 if {[catch {exec git branch -D $head} err]} {
6282 removehead $id $head
6283 removedhead $id $head
6290 # Display a list of tags and heads
6292 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6293 global bglist fglist uifont reflistfilter reflist maincursor
6296 set showrefstop $top
6297 if {[winfo exists $top]} {
6303 wm title $top "Tags and heads: [file tail [pwd]]"
6304 text $top.list -background $bgcolor -foreground $fgcolor \
6305 -selectbackground $selectbgcolor -font $mainfont \
6306 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6307 -width 30 -height 20 -cursor $maincursor \
6308 -spacing1 1 -spacing3 1 -state disabled
6309 $top.list tag configure highlight -background $selectbgcolor
6310 lappend bglist $top.list
6311 lappend fglist $top.list
6312 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6313 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6314 grid $top.list $top.ysb -sticky nsew
6315 grid $top.xsb x -sticky ew
6317 label $top.f.l -text "Filter: " -font $uifont
6318 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6319 set reflistfilter "*"
6320 trace add variable reflistfilter write reflistfilter_change
6321 pack $top.f.e -side right -fill x -expand 1
6322 pack $top.f.l -side left
6323 grid $top.f - -sticky ew -pady 2
6324 button $top.close -command [list destroy $top] -text "Close" \
6327 grid columnconfigure $top 0 -weight 1
6328 grid rowconfigure $top 0 -weight 1
6329 bind $top.list <1> {break}
6330 bind $top.list <B1-Motion> {break}
6331 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6336 proc sel_reflist {w x y} {
6337 global showrefstop reflist headids tagids otherrefids
6339 if {![winfo exists $showrefstop]} return
6340 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6341 set ref [lindex $reflist [expr {$l-1}]]
6342 set n [lindex $ref 0]
6343 switch -- [lindex $ref 1] {
6344 "H" {selbyid $headids($n)}
6345 "T" {selbyid $tagids($n)}
6346 "o" {selbyid $otherrefids($n)}
6348 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6351 proc unsel_reflist {} {
6354 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6355 $showrefstop.list tag remove highlight 0.0 end
6358 proc reflistfilter_change {n1 n2 op} {
6359 global reflistfilter
6361 after cancel refill_reflist
6362 after 200 refill_reflist
6365 proc refill_reflist {} {
6366 global reflist reflistfilter showrefstop headids tagids otherrefids
6367 global commitrow curview commitinterest
6369 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6371 foreach n [array names headids] {
6372 if {[string match $reflistfilter $n]} {
6373 if {[info exists commitrow($curview,$headids($n))]} {
6374 lappend refs [list $n H]
6376 set commitinterest($headids($n)) {run refill_reflist}
6380 foreach n [array names tagids] {
6381 if {[string match $reflistfilter $n]} {
6382 if {[info exists commitrow($curview,$tagids($n))]} {
6383 lappend refs [list $n T]
6385 set commitinterest($tagids($n)) {run refill_reflist}
6389 foreach n [array names otherrefids] {
6390 if {[string match $reflistfilter $n]} {
6391 if {[info exists commitrow($curview,$otherrefids($n))]} {
6392 lappend refs [list $n o]
6394 set commitinterest($otherrefids($n)) {run refill_reflist}
6398 set refs [lsort -index 0 $refs]
6399 if {$refs eq $reflist} return
6401 # Update the contents of $showrefstop.list according to the
6402 # differences between $reflist (old) and $refs (new)
6403 $showrefstop.list conf -state normal
6404 $showrefstop.list insert end "\n"
6407 while {$i < [llength $reflist] || $j < [llength $refs]} {
6408 if {$i < [llength $reflist]} {
6409 if {$j < [llength $refs]} {
6410 set cmp [string compare [lindex $reflist $i 0] \
6411 [lindex $refs $j 0]]
6413 set cmp [string compare [lindex $reflist $i 1] \
6414 [lindex $refs $j 1]]
6424 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6432 set l [expr {$j + 1}]
6433 $showrefstop.list image create $l.0 -align baseline \
6434 -image reficon-[lindex $refs $j 1] -padx 2
6435 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6441 # delete last newline
6442 $showrefstop.list delete end-2c end-1c
6443 $showrefstop.list conf -state disabled
6446 # Stuff for finding nearby tags
6447 proc getallcommits {} {
6448 global allcommits allids nbmp nextarc seeds
6450 if {![info exists allcommits]} {
6458 set cmd [concat | git rev-list --all --parents]
6462 set fd [open $cmd r]
6463 fconfigure $fd -blocking 0
6466 filerun $fd [list getallclines $fd]
6469 # Since most commits have 1 parent and 1 child, we group strings of
6470 # such commits into "arcs" joining branch/merge points (BMPs), which
6471 # are commits that either don't have 1 parent or don't have 1 child.
6473 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6474 # arcout(id) - outgoing arcs for BMP
6475 # arcids(a) - list of IDs on arc including end but not start
6476 # arcstart(a) - BMP ID at start of arc
6477 # arcend(a) - BMP ID at end of arc
6478 # growing(a) - arc a is still growing
6479 # arctags(a) - IDs out of arcids (excluding end) that have tags
6480 # archeads(a) - IDs out of arcids (excluding end) that have heads
6481 # The start of an arc is at the descendent end, so "incoming" means
6482 # coming from descendents, and "outgoing" means going towards ancestors.
6484 proc getallclines {fd} {
6485 global allids allparents allchildren idtags idheads nextarc nbmp
6486 global arcnos arcids arctags arcout arcend arcstart archeads growing
6487 global seeds allcommits
6490 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6491 set id [lindex $line 0]
6492 if {[info exists allparents($id)]} {
6497 set olds [lrange $line 1 end]
6498 set allparents($id) $olds
6499 if {![info exists allchildren($id)]} {
6500 set allchildren($id) {}
6505 if {[llength $olds] == 1 && [llength $a] == 1} {
6506 lappend arcids($a) $id
6507 if {[info exists idtags($id)]} {
6508 lappend arctags($a) $id
6510 if {[info exists idheads($id)]} {
6511 lappend archeads($a) $id
6513 if {[info exists allparents($olds)]} {
6514 # seen parent already
6515 if {![info exists arcout($olds)]} {
6518 lappend arcids($a) $olds
6519 set arcend($a) $olds
6522 lappend allchildren($olds) $id
6523 lappend arcnos($olds) $a
6528 foreach a $arcnos($id) {
6529 lappend arcids($a) $id
6536 lappend allchildren($p) $id
6537 set a [incr nextarc]
6538 set arcstart($a) $id
6545 if {[info exists allparents($p)]} {
6546 # seen it already, may need to make a new branch
6547 if {![info exists arcout($p)]} {
6550 lappend arcids($a) $p
6554 lappend arcnos($p) $a
6559 global cached_dheads cached_dtags cached_atags
6560 catch {unset cached_dheads}
6561 catch {unset cached_dtags}
6562 catch {unset cached_atags}
6565 return [expr {$nid >= 1000? 2: 1}]
6568 if {[incr allcommits -1] == 0} {
6575 proc recalcarc {a} {
6576 global arctags archeads arcids idtags idheads
6580 foreach id [lrange $arcids($a) 0 end-1] {
6581 if {[info exists idtags($id)]} {
6584 if {[info exists idheads($id)]} {
6589 set archeads($a) $ah
6593 global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6594 global arcstart arcend arcout allparents growing
6597 if {[llength $a] != 1} {
6598 puts "oops splitarc called but [llength $a] arcs already"
6602 set i [lsearch -exact $arcids($a) $p]
6604 puts "oops splitarc $p not in arc $a"
6607 set na [incr nextarc]
6608 if {[info exists arcend($a)]} {
6609 set arcend($na) $arcend($a)
6611 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6612 set j [lsearch -exact $arcnos($l) $a]
6613 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6615 set tail [lrange $arcids($a) [expr {$i+1}] end]
6616 set arcids($a) [lrange $arcids($a) 0 $i]
6618 set arcstart($na) $p
6620 set arcids($na) $tail
6621 if {[info exists growing($a)]} {
6628 if {[llength $arcnos($id)] == 1} {
6631 set j [lsearch -exact $arcnos($id) $a]
6632 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6636 # reconstruct tags and heads lists
6637 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6642 set archeads($na) {}
6646 # Update things for a new commit added that is a child of one
6647 # existing commit. Used when cherry-picking.
6648 proc addnewchild {id p} {
6649 global allids allparents allchildren idtags nextarc nbmp
6650 global arcnos arcids arctags arcout arcend arcstart archeads growing
6651 global seeds allcommits
6653 if {![info exists allcommits]} return
6655 set allparents($id) [list $p]
6656 set allchildren($id) {}
6660 lappend allchildren($p) $id
6661 set a [incr nextarc]
6662 set arcstart($a) $id
6665 set arcids($a) [list $p]
6667 if {![info exists arcout($p)]} {
6670 lappend arcnos($p) $a
6671 set arcout($id) [list $a]
6674 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6675 # or 0 if neither is true.
6676 proc anc_or_desc {a b} {
6677 global arcout arcstart arcend arcnos cached_isanc
6679 if {$arcnos($a) eq $arcnos($b)} {
6680 # Both are on the same arc(s); either both are the same BMP,
6681 # or if one is not a BMP, the other is also not a BMP or is
6682 # the BMP at end of the arc (and it only has 1 incoming arc).
6683 # Or both can be BMPs with no incoming arcs.
6684 if {$a eq $b || $arcnos($a) eq {}} {
6687 # assert {[llength $arcnos($a)] == 1}
6688 set arc [lindex $arcnos($a) 0]
6689 set i [lsearch -exact $arcids($arc) $a]
6690 set j [lsearch -exact $arcids($arc) $b]
6691 if {$i < 0 || $i > $j} {
6698 if {![info exists arcout($a)]} {
6699 set arc [lindex $arcnos($a) 0]
6700 if {[info exists arcend($arc)]} {
6701 set aend $arcend($arc)
6705 set a $arcstart($arc)
6709 if {![info exists arcout($b)]} {
6710 set arc [lindex $arcnos($b) 0]
6711 if {[info exists arcend($arc)]} {
6712 set bend $arcend($arc)
6716 set b $arcstart($arc)
6726 if {[info exists cached_isanc($a,$bend)]} {
6727 if {$cached_isanc($a,$bend)} {
6731 if {[info exists cached_isanc($b,$aend)]} {
6732 if {$cached_isanc($b,$aend)} {
6735 if {[info exists cached_isanc($a,$bend)]} {
6740 set todo [list $a $b]
6743 for {set i 0} {$i < [llength $todo]} {incr i} {
6744 set x [lindex $todo $i]
6745 if {$anc($x) eq {}} {
6748 foreach arc $arcnos($x) {
6749 set xd $arcstart($arc)
6751 set cached_isanc($a,$bend) 1
6752 set cached_isanc($b,$aend) 0
6754 } elseif {$xd eq $aend} {
6755 set cached_isanc($b,$aend) 1
6756 set cached_isanc($a,$bend) 0
6759 if {![info exists anc($xd)]} {
6760 set anc($xd) $anc($x)
6762 } elseif {$anc($xd) ne $anc($x)} {
6767 set cached_isanc($a,$bend) 0
6768 set cached_isanc($b,$aend) 0
6772 # This identifies whether $desc has an ancestor that is
6773 # a growing tip of the graph and which is not an ancestor of $anc
6774 # and returns 0 if so and 1 if not.
6775 # If we subsequently discover a tag on such a growing tip, and that
6776 # turns out to be a descendent of $anc (which it could, since we
6777 # don't necessarily see children before parents), then $desc
6778 # isn't a good choice to display as a descendent tag of
6779 # $anc (since it is the descendent of another tag which is
6780 # a descendent of $anc). Similarly, $anc isn't a good choice to
6781 # display as a ancestor tag of $desc.
6783 proc is_certain {desc anc} {
6784 global arcnos arcout arcstart arcend growing problems
6787 if {[llength $arcnos($anc)] == 1} {
6788 # tags on the same arc are certain
6789 if {$arcnos($desc) eq $arcnos($anc)} {
6792 if {![info exists arcout($anc)]} {
6793 # if $anc is partway along an arc, use the start of the arc instead
6794 set a [lindex $arcnos($anc) 0]
6795 set anc $arcstart($a)
6798 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6801 set a [lindex $arcnos($desc) 0]
6807 set anclist [list $x]
6811 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6812 set x [lindex $anclist $i]
6817 foreach a $arcout($x) {
6818 if {[info exists growing($a)]} {
6819 if {![info exists growanc($x)] && $dl($x)} {
6825 if {[info exists dl($y)]} {
6829 if {![info exists done($y)]} {
6832 if {[info exists growanc($x)]} {
6836 for {set k 0} {$k < [llength $xl]} {incr k} {
6837 set z [lindex $xl $k]
6838 foreach c $arcout($z) {
6839 if {[info exists arcend($c)]} {
6841 if {[info exists dl($v)] && $dl($v)} {
6843 if {![info exists done($v)]} {
6846 if {[info exists growanc($v)]} {
6856 } elseif {$y eq $anc || !$dl($x)} {
6867 foreach x [array names growanc] {
6876 proc validate_arctags {a} {
6877 global arctags idtags
6881 foreach id $arctags($a) {
6883 if {![info exists idtags($id)]} {
6884 set na [lreplace $na $i $i]
6891 proc validate_archeads {a} {
6892 global archeads idheads
6895 set na $archeads($a)
6896 foreach id $archeads($a) {
6898 if {![info exists idheads($id)]} {
6899 set na [lreplace $na $i $i]
6903 set archeads($a) $na
6906 # Return the list of IDs that have tags that are descendents of id,
6907 # ignoring IDs that are descendents of IDs already reported.
6908 proc desctags {id} {
6909 global arcnos arcstart arcids arctags idtags allparents
6910 global growing cached_dtags
6912 if {![info exists allparents($id)]} {
6915 set t1 [clock clicks -milliseconds]
6917 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6918 # part-way along an arc; check that arc first
6919 set a [lindex $arcnos($id) 0]
6920 if {$arctags($a) ne {}} {
6922 set i [lsearch -exact $arcids($a) $id]
6924 foreach t $arctags($a) {
6925 set j [lsearch -exact $arcids($a) $t]
6933 set id $arcstart($a)
6934 if {[info exists idtags($id)]} {
6938 if {[info exists cached_dtags($id)]} {
6939 return $cached_dtags($id)
6946 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6947 set id [lindex $todo $i]
6949 set ta [info exists hastaggedancestor($id)]
6953 # ignore tags on starting node
6954 if {!$ta && $i > 0} {
6955 if {[info exists idtags($id)]} {
6958 } elseif {[info exists cached_dtags($id)]} {
6959 set tagloc($id) $cached_dtags($id)
6963 foreach a $arcnos($id) {
6965 if {!$ta && $arctags($a) ne {}} {
6967 if {$arctags($a) ne {}} {
6968 lappend tagloc($id) [lindex $arctags($a) end]
6971 if {$ta || $arctags($a) ne {}} {
6972 set tomark [list $d]
6973 for {set j 0} {$j < [llength $tomark]} {incr j} {
6974 set dd [lindex $tomark $j]
6975 if {![info exists hastaggedancestor($dd)]} {
6976 if {[info exists done($dd)]} {
6977 foreach b $arcnos($dd) {
6978 lappend tomark $arcstart($b)
6980 if {[info exists tagloc($dd)]} {
6983 } elseif {[info exists queued($dd)]} {
6986 set hastaggedancestor($dd) 1
6990 if {![info exists queued($d)]} {
6993 if {![info exists hastaggedancestor($d)]} {
7000 foreach id [array names tagloc] {
7001 if {![info exists hastaggedancestor($id)]} {
7002 foreach t $tagloc($id) {
7003 if {[lsearch -exact $tags $t] < 0} {
7009 set t2 [clock clicks -milliseconds]
7012 # remove tags that are descendents of other tags
7013 for {set i 0} {$i < [llength $tags]} {incr i} {
7014 set a [lindex $tags $i]
7015 for {set j 0} {$j < $i} {incr j} {
7016 set b [lindex $tags $j]
7017 set r [anc_or_desc $a $b]
7019 set tags [lreplace $tags $j $j]
7022 } elseif {$r == -1} {
7023 set tags [lreplace $tags $i $i]
7030 if {[array names growing] ne {}} {
7031 # graph isn't finished, need to check if any tag could get
7032 # eclipsed by another tag coming later. Simply ignore any
7033 # tags that could later get eclipsed.
7036 if {[is_certain $t $origid]} {
7040 if {$tags eq $ctags} {
7041 set cached_dtags($origid) $tags
7046 set cached_dtags($origid) $tags
7048 set t3 [clock clicks -milliseconds]
7049 if {0 && $t3 - $t1 >= 100} {
7050 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7051 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7057 global arcnos arcids arcout arcend arctags idtags allparents
7058 global growing cached_atags
7060 if {![info exists allparents($id)]} {
7063 set t1 [clock clicks -milliseconds]
7065 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7066 # part-way along an arc; check that arc first
7067 set a [lindex $arcnos($id) 0]
7068 if {$arctags($a) ne {}} {
7070 set i [lsearch -exact $arcids($a) $id]
7071 foreach t $arctags($a) {
7072 set j [lsearch -exact $arcids($a) $t]
7078 if {![info exists arcend($a)]} {
7082 if {[info exists idtags($id)]} {
7086 if {[info exists cached_atags($id)]} {
7087 return $cached_atags($id)
7095 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7096 set id [lindex $todo $i]
7098 set td [info exists hastaggeddescendent($id)]
7102 # ignore tags on starting node
7103 if {!$td && $i > 0} {
7104 if {[info exists idtags($id)]} {
7107 } elseif {[info exists cached_atags($id)]} {
7108 set tagloc($id) $cached_atags($id)
7112 foreach a $arcout($id) {
7113 if {!$td && $arctags($a) ne {}} {
7115 if {$arctags($a) ne {}} {
7116 lappend tagloc($id) [lindex $arctags($a) 0]
7119 if {![info exists arcend($a)]} continue
7121 if {$td || $arctags($a) ne {}} {
7122 set tomark [list $d]
7123 for {set j 0} {$j < [llength $tomark]} {incr j} {
7124 set dd [lindex $tomark $j]
7125 if {![info exists hastaggeddescendent($dd)]} {
7126 if {[info exists done($dd)]} {
7127 foreach b $arcout($dd) {
7128 if {[info exists arcend($b)]} {
7129 lappend tomark $arcend($b)
7132 if {[info exists tagloc($dd)]} {
7135 } elseif {[info exists queued($dd)]} {
7138 set hastaggeddescendent($dd) 1
7142 if {![info exists queued($d)]} {
7145 if {![info exists hastaggeddescendent($d)]} {
7151 set t2 [clock clicks -milliseconds]
7154 foreach id [array names tagloc] {
7155 if {![info exists hastaggeddescendent($id)]} {
7156 foreach t $tagloc($id) {
7157 if {[lsearch -exact $tags $t] < 0} {
7164 # remove tags that are ancestors of other tags
7165 for {set i 0} {$i < [llength $tags]} {incr i} {
7166 set a [lindex $tags $i]
7167 for {set j 0} {$j < $i} {incr j} {
7168 set b [lindex $tags $j]
7169 set r [anc_or_desc $a $b]
7171 set tags [lreplace $tags $j $j]
7174 } elseif {$r == 1} {
7175 set tags [lreplace $tags $i $i]
7182 if {[array names growing] ne {}} {
7183 # graph isn't finished, need to check if any tag could get
7184 # eclipsed by another tag coming later. Simply ignore any
7185 # tags that could later get eclipsed.
7188 if {[is_certain $origid $t]} {
7192 if {$tags eq $ctags} {
7193 set cached_atags($origid) $tags
7198 set cached_atags($origid) $tags
7200 set t3 [clock clicks -milliseconds]
7201 if {0 && $t3 - $t1 >= 100} {
7202 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7203 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7208 # Return the list of IDs that have heads that are descendents of id,
7209 # including id itself if it has a head.
7210 proc descheads {id} {
7211 global arcnos arcstart arcids archeads idheads cached_dheads
7214 if {![info exists allparents($id)]} {
7218 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7219 # part-way along an arc; check it first
7220 set a [lindex $arcnos($id) 0]
7221 if {$archeads($a) ne {}} {
7222 validate_archeads $a
7223 set i [lsearch -exact $arcids($a) $id]
7224 foreach t $archeads($a) {
7225 set j [lsearch -exact $arcids($a) $t]
7230 set id $arcstart($a)
7236 for {set i 0} {$i < [llength $todo]} {incr i} {
7237 set id [lindex $todo $i]
7238 if {[info exists cached_dheads($id)]} {
7239 set ret [concat $ret $cached_dheads($id)]
7241 if {[info exists idheads($id)]} {
7244 foreach a $arcnos($id) {
7245 if {$archeads($a) ne {}} {
7246 validate_archeads $a
7247 if {$archeads($a) ne {}} {
7248 set ret [concat $ret $archeads($a)]
7252 if {![info exists seen($d)]} {
7259 set ret [lsort -unique $ret]
7260 set cached_dheads($origid) $ret
7261 return [concat $ret $aret]
7264 proc addedtag {id} {
7265 global arcnos arcout cached_dtags cached_atags
7267 if {![info exists arcnos($id)]} return
7268 if {![info exists arcout($id)]} {
7269 recalcarc [lindex $arcnos($id) 0]
7271 catch {unset cached_dtags}
7272 catch {unset cached_atags}
7275 proc addedhead {hid head} {
7276 global arcnos arcout cached_dheads
7278 if {![info exists arcnos($hid)]} return
7279 if {![info exists arcout($hid)]} {
7280 recalcarc [lindex $arcnos($hid) 0]
7282 catch {unset cached_dheads}
7285 proc removedhead {hid head} {
7286 global cached_dheads
7288 catch {unset cached_dheads}
7291 proc movedhead {hid head} {
7292 global arcnos arcout cached_dheads
7294 if {![info exists arcnos($hid)]} return
7295 if {![info exists arcout($hid)]} {
7296 recalcarc [lindex $arcnos($hid) 0]
7298 catch {unset cached_dheads}
7301 proc changedrefs {} {
7302 global cached_dheads cached_dtags cached_atags
7303 global arctags archeads arcnos arcout idheads idtags
7305 foreach id [concat [array names idheads] [array names idtags]] {
7306 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7307 set a [lindex $arcnos($id) 0]
7308 if {![info exists donearc($a)]} {
7314 catch {unset cached_dtags}
7315 catch {unset cached_atags}
7316 catch {unset cached_dheads}
7319 proc rereadrefs {} {
7320 global idtags idheads idotherrefs mainhead
7322 set refids [concat [array names idtags] \
7323 [array names idheads] [array names idotherrefs]]
7324 foreach id $refids {
7325 if {![info exists ref($id)]} {
7326 set ref($id) [listrefs $id]
7329 set oldmainhead $mainhead
7332 set refids [lsort -unique [concat $refids [array names idtags] \
7333 [array names idheads] [array names idotherrefs]]]
7334 foreach id $refids {
7335 set v [listrefs $id]
7336 if {![info exists ref($id)] || $ref($id) != $v ||
7337 ($id eq $oldmainhead && $id ne $mainhead) ||
7338 ($id eq $mainhead && $id ne $oldmainhead)} {
7345 proc listrefs {id} {
7346 global idtags idheads idotherrefs
7349 if {[info exists idtags($id)]} {
7353 if {[info exists idheads($id)]} {
7357 if {[info exists idotherrefs($id)]} {
7358 set z $idotherrefs($id)
7360 return [list $x $y $z]
7363 proc showtag {tag isnew} {
7364 global ctext tagcontents tagids linknum tagobjid
7367 addtohistory [list showtag $tag 0]
7369 $ctext conf -state normal
7372 if {![info exists tagcontents($tag)]} {
7374 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7377 if {[info exists tagcontents($tag)]} {
7378 set text $tagcontents($tag)
7380 set text "Tag: $tag\nId: $tagids($tag)"
7382 appendwithlinks $text {}
7383 $ctext conf -state disabled
7395 global maxwidth maxgraphpct diffopts
7396 global oldprefs prefstop showneartags showlocalchanges
7397 global bgcolor fgcolor ctext diffcolors selectbgcolor
7398 global uifont tabstop
7402 if {[winfo exists $top]} {
7406 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7407 set oldprefs($v) [set $v]
7410 wm title $top "Gitk preferences"
7411 label $top.ldisp -text "Commit list display options"
7412 $top.ldisp configure -font $uifont
7413 grid $top.ldisp - -sticky w -pady 10
7414 label $top.spacer -text " "
7415 label $top.maxwidthl -text "Maximum graph width (lines)" \
7417 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7418 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7419 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7421 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7422 grid x $top.maxpctl $top.maxpct -sticky w
7423 frame $top.showlocal
7424 label $top.showlocal.l -text "Show local changes" -font optionfont
7425 checkbutton $top.showlocal.b -variable showlocalchanges
7426 pack $top.showlocal.b $top.showlocal.l -side left
7427 grid x $top.showlocal -sticky w
7429 label $top.ddisp -text "Diff display options"
7430 $top.ddisp configure -font $uifont
7431 grid $top.ddisp - -sticky w -pady 10
7432 label $top.diffoptl -text "Options for diff program" \
7434 entry $top.diffopt -width 20 -textvariable diffopts
7435 grid x $top.diffoptl $top.diffopt -sticky w
7437 label $top.ntag.l -text "Display nearby tags" -font optionfont
7438 checkbutton $top.ntag.b -variable showneartags
7439 pack $top.ntag.b $top.ntag.l -side left
7440 grid x $top.ntag -sticky w
7441 label $top.tabstopl -text "tabstop" -font optionfont
7442 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7443 grid x $top.tabstopl $top.tabstop -sticky w
7445 label $top.cdisp -text "Colors: press to choose"
7446 $top.cdisp configure -font $uifont
7447 grid $top.cdisp - -sticky w -pady 10
7448 label $top.bg -padx 40 -relief sunk -background $bgcolor
7449 button $top.bgbut -text "Background" -font optionfont \
7450 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7451 grid x $top.bgbut $top.bg -sticky w
7452 label $top.fg -padx 40 -relief sunk -background $fgcolor
7453 button $top.fgbut -text "Foreground" -font optionfont \
7454 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7455 grid x $top.fgbut $top.fg -sticky w
7456 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7457 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7458 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7459 [list $ctext tag conf d0 -foreground]]
7460 grid x $top.diffoldbut $top.diffold -sticky w
7461 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7462 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7463 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7464 [list $ctext tag conf d1 -foreground]]
7465 grid x $top.diffnewbut $top.diffnew -sticky w
7466 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7467 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7468 -command [list choosecolor diffcolors 2 $top.hunksep \
7469 "diff hunk header" \
7470 [list $ctext tag conf hunksep -foreground]]
7471 grid x $top.hunksepbut $top.hunksep -sticky w
7472 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7473 button $top.selbgbut -text "Select bg" -font optionfont \
7474 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7475 grid x $top.selbgbut $top.selbgsep -sticky w
7478 button $top.buts.ok -text "OK" -command prefsok -default active
7479 $top.buts.ok configure -font $uifont
7480 button $top.buts.can -text "Cancel" -command prefscan -default normal
7481 $top.buts.can configure -font $uifont
7482 grid $top.buts.ok $top.buts.can
7483 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7484 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7485 grid $top.buts - - -pady 10 -sticky ew
7486 bind $top <Visibility> "focus $top.buts.ok"
7489 proc choosecolor {v vi w x cmd} {
7492 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7493 -title "Gitk: choose color for $x"]
7494 if {$c eq {}} return
7495 $w conf -background $c
7501 global bglist cflist
7503 $w configure -selectbackground $c
7505 $cflist tag configure highlight \
7506 -background [$cflist cget -selectbackground]
7507 allcanvs itemconf secsel -fill $c
7514 $w conf -background $c
7522 $w conf -foreground $c
7524 allcanvs itemconf text -fill $c
7525 $canv itemconf circle -outline $c
7529 global maxwidth maxgraphpct diffopts
7530 global oldprefs prefstop showneartags showlocalchanges
7532 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7533 set $v $oldprefs($v)
7535 catch {destroy $prefstop}
7540 global maxwidth maxgraphpct
7541 global oldprefs prefstop showneartags showlocalchanges
7542 global charspc ctext tabstop
7544 catch {destroy $prefstop}
7546 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7547 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7548 if {$showlocalchanges} {
7554 if {$maxwidth != $oldprefs(maxwidth)
7555 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7557 } elseif {$showneartags != $oldprefs(showneartags)} {
7562 proc formatdate {d} {
7563 global datetimeformat
7565 set d [clock format $d -format $datetimeformat]
7570 # This list of encoding names and aliases is distilled from
7571 # http://www.iana.org/assignments/character-sets.
7572 # Not all of them are supported by Tcl.
7573 set encoding_aliases {
7574 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7575 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7576 { ISO-10646-UTF-1 csISO10646UTF1 }
7577 { ISO_646.basic:1983 ref csISO646basic1983 }
7578 { INVARIANT csINVARIANT }
7579 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7580 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7581 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7582 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7583 { NATS-DANO iso-ir-9-1 csNATSDANO }
7584 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7585 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7586 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7587 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7588 { ISO-2022-KR csISO2022KR }
7590 { ISO-2022-JP csISO2022JP }
7591 { ISO-2022-JP-2 csISO2022JP2 }
7592 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7594 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7595 { IT iso-ir-15 ISO646-IT csISO15Italian }
7596 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7597 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7598 { greek7-old iso-ir-18 csISO18Greek7Old }
7599 { latin-greek iso-ir-19 csISO19LatinGreek }
7600 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7601 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7602 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7603 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7604 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7605 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7606 { INIS iso-ir-49 csISO49INIS }
7607 { INIS-8 iso-ir-50 csISO50INIS8 }
7608 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7609 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7610 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7611 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7612 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7613 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7615 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7616 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7617 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7618 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7619 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7620 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7621 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7622 { greek7 iso-ir-88 csISO88Greek7 }
7623 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7624 { iso-ir-90 csISO90 }
7625 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7626 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7627 csISO92JISC62991984b }
7628 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7629 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7630 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7631 csISO95JIS62291984handadd }
7632 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7633 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7634 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7635 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7637 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7638 { T.61-7bit iso-ir-102 csISO102T617bit }
7639 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7640 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7641 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7642 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7643 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7644 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7645 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7646 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7647 arabic csISOLatinArabic }
7648 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7649 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7650 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7651 greek greek8 csISOLatinGreek }
7652 { T.101-G2 iso-ir-128 csISO128T101G2 }
7653 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7655 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7656 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7657 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7658 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7659 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7660 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7661 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7662 csISOLatinCyrillic }
7663 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7664 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7665 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7666 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7667 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7668 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7669 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7670 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7671 { ISO_10367-box iso-ir-155 csISO10367Box }
7672 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7673 { latin-lap lap iso-ir-158 csISO158Lap }
7674 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7675 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7678 { JIS_X0201 X0201 csHalfWidthKatakana }
7679 { KSC5636 ISO646-KR csKSC5636 }
7680 { ISO-10646-UCS-2 csUnicode }
7681 { ISO-10646-UCS-4 csUCS4 }
7682 { DEC-MCS dec csDECMCS }
7683 { hp-roman8 roman8 r8 csHPRoman8 }
7684 { macintosh mac csMacintosh }
7685 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7687 { IBM038 EBCDIC-INT cp038 csIBM038 }
7688 { IBM273 CP273 csIBM273 }
7689 { IBM274 EBCDIC-BE CP274 csIBM274 }
7690 { IBM275 EBCDIC-BR cp275 csIBM275 }
7691 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7692 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7693 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7694 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7695 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7696 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7697 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7698 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7699 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7700 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7701 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7702 { IBM437 cp437 437 csPC8CodePage437 }
7703 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7704 { IBM775 cp775 csPC775Baltic }
7705 { IBM850 cp850 850 csPC850Multilingual }
7706 { IBM851 cp851 851 csIBM851 }
7707 { IBM852 cp852 852 csPCp852 }
7708 { IBM855 cp855 855 csIBM855 }
7709 { IBM857 cp857 857 csIBM857 }
7710 { IBM860 cp860 860 csIBM860 }
7711 { IBM861 cp861 861 cp-is csIBM861 }
7712 { IBM862 cp862 862 csPC862LatinHebrew }
7713 { IBM863 cp863 863 csIBM863 }
7714 { IBM864 cp864 csIBM864 }
7715 { IBM865 cp865 865 csIBM865 }
7716 { IBM866 cp866 866 csIBM866 }
7717 { IBM868 CP868 cp-ar csIBM868 }
7718 { IBM869 cp869 869 cp-gr csIBM869 }
7719 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7720 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7721 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7722 { IBM891 cp891 csIBM891 }
7723 { IBM903 cp903 csIBM903 }
7724 { IBM904 cp904 904 csIBBM904 }
7725 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7726 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7727 { IBM1026 CP1026 csIBM1026 }
7728 { EBCDIC-AT-DE csIBMEBCDICATDE }
7729 { EBCDIC-AT-DE-A csEBCDICATDEA }
7730 { EBCDIC-CA-FR csEBCDICCAFR }
7731 { EBCDIC-DK-NO csEBCDICDKNO }
7732 { EBCDIC-DK-NO-A csEBCDICDKNOA }
7733 { EBCDIC-FI-SE csEBCDICFISE }
7734 { EBCDIC-FI-SE-A csEBCDICFISEA }
7735 { EBCDIC-FR csEBCDICFR }
7736 { EBCDIC-IT csEBCDICIT }
7737 { EBCDIC-PT csEBCDICPT }
7738 { EBCDIC-ES csEBCDICES }
7739 { EBCDIC-ES-A csEBCDICESA }
7740 { EBCDIC-ES-S csEBCDICESS }
7741 { EBCDIC-UK csEBCDICUK }
7742 { EBCDIC-US csEBCDICUS }
7743 { UNKNOWN-8BIT csUnknown8BiT }
7744 { MNEMONIC csMnemonic }
7749 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7750 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7751 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7752 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7753 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7754 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7755 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7756 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7757 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7758 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7759 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7760 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7761 { IBM1047 IBM-1047 }
7762 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7763 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7764 { UNICODE-1-1 csUnicode11 }
7767 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7768 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7770 { ISO-8859-15 ISO_8859-15 Latin-9 }
7771 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7772 { GBK CP936 MS936 windows-936 }
7773 { JIS_Encoding csJISEncoding }
7774 { Shift_JIS MS_Kanji csShiftJIS }
7775 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7777 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7778 { ISO-10646-UCS-Basic csUnicodeASCII }
7779 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7780 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7781 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7782 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7783 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7784 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7785 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7786 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7787 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7788 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7789 { Adobe-Standard-Encoding csAdobeStandardEncoding }
7790 { Ventura-US csVenturaUS }
7791 { Ventura-International csVenturaInternational }
7792 { PC8-Danish-Norwegian csPC8DanishNorwegian }
7793 { PC8-Turkish csPC8Turkish }
7794 { IBM-Symbols csIBMSymbols }
7795 { IBM-Thai csIBMThai }
7796 { HP-Legal csHPLegal }
7797 { HP-Pi-font csHPPiFont }
7798 { HP-Math8 csHPMath8 }
7799 { Adobe-Symbol-Encoding csHPPSMath }
7800 { HP-DeskTop csHPDesktop }
7801 { Ventura-Math csVenturaMath }
7802 { Microsoft-Publishing csMicrosoftPublishing }
7803 { Windows-31J csWindows31J }
7808 proc tcl_encoding {enc} {
7809 global encoding_aliases
7810 set names [encoding names]
7811 set lcnames [string tolower $names]
7812 set enc [string tolower $enc]
7813 set i [lsearch -exact $lcnames $enc]
7815 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7816 if {[regsub {^iso[-_]} $enc iso encx]} {
7817 set i [lsearch -exact $lcnames $encx]
7821 foreach l $encoding_aliases {
7822 set ll [string tolower $l]
7823 if {[lsearch -exact $ll $enc] < 0} continue
7824 # look through the aliases for one that tcl knows about
7826 set i [lsearch -exact $lcnames $e]
7828 if {[regsub {^iso[-_]} $e iso ex]} {
7829 set i [lsearch -exact $lcnames $ex]
7838 return [lindex $names $i]
7845 set diffopts "-U 5 -p"
7846 set wrcomcmd "git diff-tree --stdin -p --pretty"
7850 set gitencoding [exec git config --get i18n.commitencoding]
7852 if {$gitencoding == ""} {
7853 set gitencoding "utf-8"
7855 set tclencoding [tcl_encoding $gitencoding]
7856 if {$tclencoding == {}} {
7857 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7860 set mainfont {Helvetica 9}
7861 set textfont {Courier 9}
7862 set uifont {Helvetica 9 bold}
7864 set findmergefiles 0
7872 set cmitmode "patch"
7873 set wrapcomment "none"
7877 set showlocalchanges 1
7878 set datetimeformat "%Y-%m-%d %H:%M:%S"
7880 set colors {green red blue magenta darkgrey brown orange}
7883 set diffcolors {red "#00a000" blue}
7885 set selectbgcolor gray85
7887 catch {source ~/.gitk}
7889 font create optionfont -family sans-serif -size -12
7891 # check that we can find a .git directory somewhere...
7892 if {[catch {set gitdir [gitdir]}]} {
7893 show_error {} . "Cannot find a git repository here."
7896 if {![file isdirectory $gitdir]} {
7897 show_error {} . "Cannot find the git directory \"$gitdir\"."
7902 set cmdline_files {}
7907 "-d" { set datemode 1 }
7909 set cmdline_files [lrange $argv [expr {$i + 1}] end]
7913 lappend revtreeargs $arg
7919 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7920 # no -- on command line, but some arguments (other than -d)
7922 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7923 set cmdline_files [split $f "\n"]
7924 set n [llength $cmdline_files]
7925 set revtreeargs [lrange $revtreeargs 0 end-$n]
7926 # Unfortunately git rev-parse doesn't produce an error when
7927 # something is both a revision and a filename. To be consistent
7928 # with git log and git rev-list, check revtreeargs for filenames.
7929 foreach arg $revtreeargs {
7930 if {[file exists $arg]} {
7931 show_error {} . "Ambiguous argument '$arg': both revision\
7937 # unfortunately we get both stdout and stderr in $err,
7938 # so look for "fatal:".
7939 set i [string first "fatal:" $err]
7941 set err [string range $err [expr {$i + 6}] end]
7943 show_error {} . "Bad arguments to gitk:\n$err"
7948 set nullid "0000000000000000000000000000000000000000"
7949 set nullid2 "0000000000000000000000000000000000000001"
7957 set highlight_paths {}
7958 set searchdirn -forwards
7962 set markingmatches 0
7963 set linkentercount 0
7964 set need_redisplay 0
7970 set selectedhlview None
7979 set lookingforhead 0
7985 # wait for the window to become visible
7987 wm title . "[file tail $argv0]: [file tail [pwd]]"
7990 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7991 # create a view for the files/dirs specified on the command line
7995 set viewname(1) "Command line"
7996 set viewfiles(1) $cmdline_files
7997 set viewargs(1) $revtreeargs
8000 .bar.view entryconf Edit* -state normal
8001 .bar.view entryconf Delete* -state normal
8004 if {[info exists permviews]} {
8005 foreach v $permviews {
8008 set viewname($n) [lindex $v 0]
8009 set viewfiles($n) [lindex $v 1]
8010 set viewargs($n) [lindex $v 2]