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 viewcomplete vnextroot
86 global lookingforhead showlocalchanges
88 set startmsecs
[clock clicks
-milliseconds]
89 set commitidx
($view) 0
90 set viewcomplete
($view) 0
91 set vnextroot
($view) 0
92 set order
"--topo-order"
94 set order
"--date-order"
97 set fd
[open
[concat | git log
-z --pretty=raw
$order --parents \
98 --boundary $viewargs($view) "--" $viewfiles($view)] r
]
100 error_popup
"Error executing git rev-list: $err"
103 set commfd
($view) $fd
104 set leftover
($view) {}
105 set lookingforhead
$showlocalchanges
106 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
107 if {$tclencoding != {}} {
108 fconfigure
$fd -encoding $tclencoding
110 filerun
$fd [list getcommitlines
$fd $view]
114 proc stop_rev_list
{} {
115 global commfd curview
117 if {![info exists commfd
($curview)]} return
118 set fd
$commfd($curview)
124 unset commfd
($curview)
128 global phase canv mainfont curview
132 start_rev_list
$curview
133 show_status
"Reading commits..."
136 # This makes a string representation of a positive integer which
137 # sorts as a string in numerical order
140 return [format
"%x" $n]
141 } elseif
{$n < 256} {
142 return [format
"x%.2x" $n]
143 } elseif
{$n < 65536} {
144 return [format
"y%.4x" $n]
146 return [format
"z%.8x" $n]
149 proc getcommitlines
{fd view
} {
151 global leftover commfd
152 global displayorder commitidx viewcomplete commitrow commitdata
153 global parentlist children curview hlview
154 global vparentlist vdisporder vcmitlisted
155 global ordertok vnextroot idpending
157 set stuff
[read $fd 500000]
158 # git log doesn't terminate the last commit with a null...
159 if {$stuff == {} && $leftover($view) ne
{} && [eof
$fd]} {
166 # Check if we have seen any ids listed as parents that haven't
167 # appeared in the list
168 foreach vid
[array names idpending
"$view,*"] {
169 # should only get here if git log is buggy
170 set id
[lindex
[split $vid ","] 1]
171 set commitrow
($vid) $commitidx($view)
172 incr commitidx
($view)
173 if {$view == $curview} {
174 lappend parentlist
{}
175 lappend displayorder
$id
176 lappend commitlisted
0
178 lappend vparentlist
($view) {}
179 lappend vdisporder
($view) $id
180 lappend vcmitlisted
($view) 0
183 set viewcomplete
($view) 1
187 # set it blocking so we wait for the process to terminate
188 fconfigure
$fd -blocking 1
189 if {[catch
{close
$fd} err
]} {
191 if {$view != $curview} {
192 set fv
" for the \"$viewname($view)\" view"
194 if {[string range
$err 0 4] == "usage"} {
195 set err
"Gitk: error reading commits$fv:\
196 bad arguments to git rev-list."
197 if {$viewname($view) eq
"Command line"} {
199 " (Note: arguments to gitk are passed to git rev-list\
200 to allow selection of commits to be displayed.)"
203 set err
"Error reading commits$fv: $err"
207 if {$view == $curview} {
208 run chewcommits
$view
215 set i
[string first
"\0" $stuff $start]
217 append leftover
($view) [string range
$stuff $start end
]
221 set cmit
$leftover($view)
222 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
223 set leftover
($view) {}
225 set cmit
[string range
$stuff $start [expr {$i - 1}]]
227 set start
[expr {$i + 1}]
228 set j
[string first
"\n" $cmit]
231 if {$j >= 0 && [string match
"commit *" $cmit]} {
232 set ids
[string range
$cmit 7 [expr {$j - 1}]]
233 if {[string match
{[-<>]*} $ids]} {
234 switch
-- [string index
$ids 0] {
239 set ids
[string range
$ids 1 end
]
243 if {[string length
$id] != 40} {
251 if {[string length
$shortcmit] > 80} {
252 set shortcmit
"[string range $shortcmit 0 80]..."
254 error_popup
"Can't parse git log output: {$shortcmit}"
257 set id
[lindex
$ids 0]
258 if {![info exists ordertok
($view,$id)]} {
259 set otok
"o[strrep $vnextroot($view)]"
260 incr vnextroot
($view)
261 set ordertok
($view,$id) $otok
263 set otok
$ordertok($view,$id)
264 unset idpending
($view,$id)
267 set olds
[lrange
$ids 1 end
]
268 if {[llength
$olds] == 1} {
269 set p
[lindex
$olds 0]
270 lappend children
($view,$p) $id
271 if {![info exists ordertok
($view,$p)]} {
272 set ordertok
($view,$p) $ordertok($view,$id)
273 set idpending
($view,$p) 1
278 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
279 lappend children
($view,$p) $id
281 if {![info exists ordertok
($view,$p)]} {
282 set ordertok
($view,$p) "$otok[strrep $i]]"
283 set idpending
($view,$p) 1
291 if {![info exists children
($view,$id)]} {
292 set children
($view,$id) {}
294 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
295 set commitrow
($view,$id) $commitidx($view)
296 incr commitidx
($view)
297 if {$view == $curview} {
298 lappend parentlist
$olds
299 lappend displayorder
$id
300 lappend commitlisted
$listed
302 lappend vparentlist
($view) $olds
303 lappend vdisporder
($view) $id
304 lappend vcmitlisted
($view) $listed
309 run chewcommits
$view
314 proc chewcommits
{view
} {
315 global curview hlview viewcomplete
316 global selectedline pending_select
318 if {$view == $curview} {
320 if {$viewcomplete($view)} {
321 global displayorder commitidx phase
322 global numcommits startmsecs
324 if {[info exists pending_select
]} {
325 set row
[first_real_row
]
328 if {$commitidx($curview) > 0} {
329 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
330 #puts "overall $ms ms for $numcommits commits"
332 show_status
"No commits selected"
338 if {[info exists hlview
] && $view == $hlview} {
344 proc readcommit
{id
} {
345 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
346 parsecommit
$id $contents 0
349 proc updatecommits
{} {
350 global viewdata curview phase displayorder ordertok idpending
351 global children commitrow selectedline thickerline showneartags
358 foreach id
$displayorder {
359 catch
{unset children
($n,$id)}
360 catch
{unset commitrow
($n,$id)}
361 catch
{unset ordertok
($n,$id)}
363 foreach vid
[array names idpending
"$n,*"] {
364 unset idpending
($vid)
367 catch
{unset selectedline
}
368 catch
{unset thickerline
}
369 catch
{unset viewdata
($n)}
378 proc parsecommit
{id contents listed
} {
379 global commitinfo cdate
388 set hdrend
[string first
"\n\n" $contents]
390 # should never happen...
391 set hdrend
[string length
$contents]
393 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
394 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
395 foreach line
[split $header "\n"] {
396 set tag
[lindex
$line 0]
397 if {$tag == "author"} {
398 set audate
[lindex
$line end-1
]
399 set auname
[lrange
$line 1 end-2
]
400 } elseif
{$tag == "committer"} {
401 set comdate
[lindex
$line end-1
]
402 set comname
[lrange
$line 1 end-2
]
406 # take the first non-blank line of the comment as the headline
407 set headline
[string trimleft
$comment]
408 set i
[string first
"\n" $headline]
410 set headline
[string range
$headline 0 $i]
412 set headline
[string trimright
$headline]
413 set i
[string first
"\r" $headline]
415 set headline
[string trimright
[string range
$headline 0 $i]]
418 # git rev-list indents the comment by 4 spaces;
419 # if we got this via git cat-file, add the indentation
421 foreach line
[split $comment "\n"] {
422 append newcomment
" "
423 append newcomment
$line
424 append newcomment
"\n"
426 set comment
$newcomment
428 if {$comdate != {}} {
429 set cdate
($id) $comdate
431 set commitinfo
($id) [list
$headline $auname $audate \
432 $comname $comdate $comment]
435 proc getcommit
{id
} {
436 global commitdata commitinfo
438 if {[info exists commitdata
($id)]} {
439 parsecommit
$id $commitdata($id) 1
442 if {![info exists commitinfo
($id)]} {
443 set commitinfo
($id) {"No commit information available"}
450 global tagids idtags headids idheads tagobjid
451 global otherrefids idotherrefs mainhead mainheadid
453 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
456 set refd
[open
[list | git show-ref
-d] r
]
457 while {[gets
$refd line
] >= 0} {
458 if {[string index
$line 40] ne
" "} continue
459 set id
[string range
$line 0 39]
460 set ref
[string range
$line 41 end
]
461 if {![string match
"refs/*" $ref]} continue
462 set name
[string range
$ref 5 end
]
463 if {[string match
"remotes/*" $name]} {
464 if {![string match
"*/HEAD" $name]} {
465 set headids
($name) $id
466 lappend idheads
($id) $name
468 } elseif
{[string match
"heads/*" $name]} {
469 set name
[string range
$name 6 end
]
470 set headids
($name) $id
471 lappend idheads
($id) $name
472 } elseif
{[string match
"tags/*" $name]} {
473 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
474 # which is what we want since the former is the commit ID
475 set name
[string range
$name 5 end
]
476 if {[string match
"*^{}" $name]} {
477 set name
[string range
$name 0 end-3
]
479 set tagobjid
($name) $id
481 set tagids
($name) $id
482 lappend idtags
($id) $name
484 set otherrefids
($name) $id
485 lappend idotherrefs
($id) $name
492 set thehead
[exec git symbolic-ref HEAD
]
493 if {[string match
"refs/heads/*" $thehead]} {
494 set mainhead
[string range
$thehead 11 end
]
495 if {[info exists headids
($mainhead)]} {
496 set mainheadid
$headids($mainhead)
502 # skip over fake commits
503 proc first_real_row
{} {
504 global nullid nullid2 displayorder numcommits
506 for {set row
0} {$row < $numcommits} {incr row
} {
507 set id
[lindex
$displayorder $row]
508 if {$id ne
$nullid && $id ne
$nullid2} {
515 # update things for a head moved to a child of its previous location
516 proc movehead
{id name
} {
517 global headids idheads
519 removehead
$headids($name) $name
520 set headids
($name) $id
521 lappend idheads
($id) $name
524 # update things when a head has been removed
525 proc removehead
{id name
} {
526 global headids idheads
528 if {$idheads($id) eq
$name} {
531 set i
[lsearch
-exact $idheads($id) $name]
533 set idheads
($id) [lreplace
$idheads($id) $i $i]
539 proc show_error
{w top msg
} {
540 message
$w.m
-text $msg -justify center
-aspect 400
541 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
542 button
$w.ok
-text OK
-command "destroy $top"
543 pack
$w.ok
-side bottom
-fill x
544 bind $top <Visibility
> "grab $top; focus $top"
545 bind $top <Key-Return
> "destroy $top"
549 proc error_popup msg
{
553 show_error
$w $w $msg
556 proc confirm_popup msg
{
562 message
$w.m
-text $msg -justify center
-aspect 400
563 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
564 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
565 pack
$w.ok
-side left
-fill x
566 button
$w.cancel
-text Cancel
-command "destroy $w"
567 pack
$w.cancel
-side right
-fill x
568 bind $w <Visibility
> "grab $w; focus $w"
574 global canv canv2 canv3 linespc charspc ctext cflist
575 global textfont mainfont uifont tabstop
576 global findtype findtypemenu findloc findstring fstring geometry
577 global entries sha1entry sha1string sha1but
578 global diffcontextstring diffcontext
579 global maincursor textcursor curtextcursor
580 global rowctxmenu fakerowmenu mergemax wrapcomment
581 global highlight_files gdttype
582 global searchstring sstring
583 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
587 .bar add cascade
-label "File" -menu .bar.
file
588 .bar configure
-font $uifont
590 .bar.
file add
command -label "Update" -command updatecommits
591 .bar.
file add
command -label "Reread references" -command rereadrefs
592 .bar.
file add
command -label "List references" -command showrefs
593 .bar.
file add
command -label "Quit" -command doquit
594 .bar.
file configure
-font $uifont
596 .bar add cascade
-label "Edit" -menu .bar.edit
597 .bar.edit add
command -label "Preferences" -command doprefs
598 .bar.edit configure
-font $uifont
600 menu .bar.view
-font $uifont
601 .bar add cascade
-label "View" -menu .bar.view
602 .bar.view add
command -label "New view..." -command {newview
0}
603 .bar.view add
command -label "Edit view..." -command editview \
605 .bar.view add
command -label "Delete view" -command delview
-state disabled
606 .bar.view add separator
607 .bar.view add radiobutton
-label "All files" -command {showview
0} \
608 -variable selectedview
-value 0
611 .bar add cascade
-label "Help" -menu .bar.
help
612 .bar.
help add
command -label "About gitk" -command about
613 .bar.
help add
command -label "Key bindings" -command keys
614 .bar.
help configure
-font $uifont
615 . configure
-menu .bar
617 # the gui has upper and lower half, parts of a paned window.
618 panedwindow .ctop
-orient vertical
620 # possibly use assumed geometry
621 if {![info exists geometry
(pwsash0
)]} {
622 set geometry
(topheight
) [expr {15 * $linespc}]
623 set geometry
(topwidth
) [expr {80 * $charspc}]
624 set geometry
(botheight
) [expr {15 * $linespc}]
625 set geometry
(botwidth
) [expr {50 * $charspc}]
626 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
627 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
630 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
631 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
633 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
635 # create three canvases
636 set cscroll .tf.histframe.csb
637 set canv .tf.histframe.pwclist.canv
639 -selectbackground $selectbgcolor \
640 -background $bgcolor -bd 0 \
641 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
642 .tf.histframe.pwclist add
$canv
643 set canv2 .tf.histframe.pwclist.canv2
645 -selectbackground $selectbgcolor \
646 -background $bgcolor -bd 0 -yscrollincr $linespc
647 .tf.histframe.pwclist add
$canv2
648 set canv3 .tf.histframe.pwclist.canv3
650 -selectbackground $selectbgcolor \
651 -background $bgcolor -bd 0 -yscrollincr $linespc
652 .tf.histframe.pwclist add
$canv3
653 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
654 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
656 # a scroll bar to rule them
657 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
658 pack
$cscroll -side right
-fill y
659 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
660 lappend bglist
$canv $canv2 $canv3
661 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
663 # we have two button bars at bottom of top frame. Bar 1
665 frame .tf.lbar
-height 15
667 set sha1entry .tf.bar.sha1
668 set entries
$sha1entry
669 set sha1but .tf.bar.sha1label
670 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
671 -command gotocommit
-width 8 -font $uifont
672 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
673 pack .tf.bar.sha1label
-side left
674 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
675 trace add variable sha1string
write sha1change
676 pack
$sha1entry -side left
-pady 2
678 image create bitmap bm-left
-data {
679 #define left_width 16
680 #define left_height 16
681 static unsigned char left_bits
[] = {
682 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
683 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
684 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
686 image create bitmap bm-right
-data {
687 #define right_width 16
688 #define right_height 16
689 static unsigned char right_bits
[] = {
690 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
691 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
692 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
694 button .tf.bar.leftbut
-image bm-left
-command goback \
695 -state disabled
-width 26
696 pack .tf.bar.leftbut
-side left
-fill y
697 button .tf.bar.rightbut
-image bm-right
-command goforw \
698 -state disabled
-width 26
699 pack .tf.bar.rightbut
-side left
-fill y
701 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
702 pack .tf.bar.findbut
-side left
704 set fstring .tf.bar.findstring
705 lappend entries
$fstring
706 entry
$fstring -width 30 -font $textfont -textvariable findstring
707 trace add variable findstring
write find_change
708 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
710 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
711 findtype Exact IgnCase Regexp
]
712 trace add variable findtype
write find_change
713 .tf.bar.findtype configure
-font $uifont
714 .tf.bar.findtype.menu configure
-font $uifont
715 set findloc
"All fields"
716 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
717 Comments Author Committer
718 trace add variable findloc
write find_change
719 .tf.bar.findloc configure
-font $uifont
720 .tf.bar.findloc.menu configure
-font $uifont
721 pack .tf.bar.findloc
-side right
722 pack .tf.bar.findtype
-side right
724 # build up the bottom bar of upper window
725 label .tf.lbar.flabel
-text "Highlight: Commits " \
727 pack .tf.lbar.flabel
-side left
-fill y
728 set gdttype
"touching paths:"
729 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
730 "adding/removing string:"]
731 trace add variable gdttype
write hfiles_change
732 $gm conf
-font $uifont
733 .tf.lbar.gdttype conf
-font $uifont
734 pack .tf.lbar.gdttype
-side left
-fill y
735 entry .tf.lbar.fent
-width 25 -font $textfont \
736 -textvariable highlight_files
737 trace add variable highlight_files
write hfiles_change
738 lappend entries .tf.lbar.fent
739 pack .tf.lbar.fent
-side left
-fill x
-expand 1
740 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
741 pack .tf.lbar.vlabel
-side left
-fill y
742 global viewhlmenu selectedhlview
743 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
744 $viewhlmenu entryconf None
-command delvhighlight
745 $viewhlmenu conf
-font $uifont
746 .tf.lbar.vhl conf
-font $uifont
747 pack .tf.lbar.vhl
-side left
-fill y
748 label .tf.lbar.rlabel
-text " OR " -font $uifont
749 pack .tf.lbar.rlabel
-side left
-fill y
750 global highlight_related
751 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
752 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
753 $m conf
-font $uifont
754 .tf.lbar.relm conf
-font $uifont
755 trace add variable highlight_related
write vrel_change
756 pack .tf.lbar.relm
-side left
-fill y
758 # Finish putting the upper half of the viewer together
759 pack .tf.lbar
-in .tf
-side bottom
-fill x
760 pack .tf.bar
-in .tf
-side bottom
-fill x
761 pack .tf.histframe
-fill both
-side top
-expand 1
763 .ctop paneconfigure .tf
-height $geometry(topheight
)
764 .ctop paneconfigure .tf
-width $geometry(topwidth
)
766 # now build up the bottom
767 panedwindow .pwbottom
-orient horizontal
769 # lower left, a text box over search bar, scroll bar to the right
770 # if we know window height, then that will set the lower text height, otherwise
771 # we set lower text height which will drive window height
772 if {[info exists geometry
(main
)]} {
773 frame .bleft
-width $geometry(botwidth
)
775 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
780 button .bleft.top.search
-text "Search" -command dosearch \
782 pack .bleft.top.search
-side left
-padx 5
783 set sstring .bleft.top.sstring
784 entry
$sstring -width 20 -font $textfont -textvariable searchstring
785 lappend entries
$sstring
786 trace add variable searchstring
write incrsearch
787 pack
$sstring -side left
-expand 1 -fill x
788 radiobutton .bleft.mid.
diff -text "Diff" \
789 -command changediffdisp
-variable diffelide
-value {0 0}
790 radiobutton .bleft.mid.old
-text "Old version" \
791 -command changediffdisp
-variable diffelide
-value {0 1}
792 radiobutton .bleft.mid.new
-text "New version" \
793 -command changediffdisp
-variable diffelide
-value {1 0}
794 label .bleft.mid.labeldiffcontext
-text " Lines of context: " \
796 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
797 spinbox .bleft.mid.diffcontext
-width 5 -font $textfont \
798 -from 1 -increment 1 -to 10000000 \
799 -validate all
-validatecommand "diffcontextvalidate %P" \
800 -textvariable diffcontextstring
801 .bleft.mid.diffcontext
set $diffcontext
802 trace add variable diffcontextstring
write diffcontextchange
803 lappend entries .bleft.mid.diffcontext
804 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
805 set ctext .bleft.ctext
806 text
$ctext -background $bgcolor -foreground $fgcolor \
807 -tabs "[expr {$tabstop * $charspc}]" \
808 -state disabled
-font $textfont \
809 -yscrollcommand scrolltext
-wrap none
810 scrollbar .bleft.sb
-command "$ctext yview"
811 pack .bleft.top
-side top
-fill x
812 pack .bleft.mid
-side top
-fill x
813 pack .bleft.sb
-side right
-fill y
814 pack
$ctext -side left
-fill both
-expand 1
815 lappend bglist
$ctext
816 lappend fglist
$ctext
818 $ctext tag conf comment
-wrap $wrapcomment
819 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
820 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
821 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
822 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
823 $ctext tag conf m0
-fore red
824 $ctext tag conf m1
-fore blue
825 $ctext tag conf m2
-fore green
826 $ctext tag conf m3
-fore purple
827 $ctext tag conf
m4 -fore brown
828 $ctext tag conf m5
-fore "#009090"
829 $ctext tag conf m6
-fore magenta
830 $ctext tag conf m7
-fore "#808000"
831 $ctext tag conf m8
-fore "#009000"
832 $ctext tag conf m9
-fore "#ff0080"
833 $ctext tag conf m10
-fore cyan
834 $ctext tag conf m11
-fore "#b07070"
835 $ctext tag conf m12
-fore "#70b0f0"
836 $ctext tag conf m13
-fore "#70f0b0"
837 $ctext tag conf m14
-fore "#f0b070"
838 $ctext tag conf m15
-fore "#ff70b0"
839 $ctext tag conf mmax
-fore darkgrey
841 $ctext tag conf mresult
-font [concat
$textfont bold
]
842 $ctext tag conf msep
-font [concat
$textfont bold
]
843 $ctext tag conf found
-back yellow
846 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
851 radiobutton .bright.mode.
patch -text "Patch" \
852 -command reselectline
-variable cmitmode
-value "patch"
853 .bright.mode.
patch configure
-font $uifont
854 radiobutton .bright.mode.tree
-text "Tree" \
855 -command reselectline
-variable cmitmode
-value "tree"
856 .bright.mode.tree configure
-font $uifont
857 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
858 pack .bright.mode
-side top
-fill x
859 set cflist .bright.cfiles
860 set indent
[font measure
$mainfont "nn"]
862 -selectbackground $selectbgcolor \
863 -background $bgcolor -foreground $fgcolor \
865 -tabs [list
$indent [expr {2 * $indent}]] \
866 -yscrollcommand ".bright.sb set" \
867 -cursor [. cget
-cursor] \
868 -spacing1 1 -spacing3 1
869 lappend bglist
$cflist
870 lappend fglist
$cflist
871 scrollbar .bright.sb
-command "$cflist yview"
872 pack .bright.sb
-side right
-fill y
873 pack
$cflist -side left
-fill both
-expand 1
874 $cflist tag configure highlight \
875 -background [$cflist cget
-selectbackground]
876 $cflist tag configure bold
-font [concat
$mainfont bold
]
878 .pwbottom add .bright
881 # restore window position if known
882 if {[info exists geometry
(main
)]} {
883 wm geometry .
"$geometry(main)"
886 if {[tk windowingsystem
] eq
{aqua
}} {
892 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
893 pack .ctop
-fill both
-expand 1
894 bindall
<1> {selcanvline
%W
%x
%y
}
895 #bindall <B1-Motion> {selcanvline %W %x %y}
896 if {[tk windowingsystem
] == "win32"} {
897 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
898 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
900 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
901 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
903 bindall
<2> "canvscan mark %W %x %y"
904 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
905 bindkey
<Home
> selfirstline
906 bindkey
<End
> sellastline
907 bind .
<Key-Up
> "selnextline -1"
908 bind .
<Key-Down
> "selnextline 1"
909 bind .
<Shift-Key-Up
> "next_highlight -1"
910 bind .
<Shift-Key-Down
> "next_highlight 1"
911 bindkey
<Key-Right
> "goforw"
912 bindkey
<Key-Left
> "goback"
913 bind .
<Key-Prior
> "selnextpage -1"
914 bind .
<Key-Next
> "selnextpage 1"
915 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
916 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
917 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
918 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
919 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
920 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
921 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
922 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
923 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
924 bindkey p
"selnextline -1"
925 bindkey n
"selnextline 1"
928 bindkey i
"selnextline -1"
929 bindkey k
"selnextline 1"
932 bindkey b
"$ctext yview scroll -1 pages"
933 bindkey d
"$ctext yview scroll 18 units"
934 bindkey u
"$ctext yview scroll -18 units"
935 bindkey
/ {findnext
1}
936 bindkey
<Key-Return
> {findnext
0}
939 bindkey
<F5
> updatecommits
940 bind .
<$M1B-q> doquit
941 bind .
<$M1B-f> dofind
942 bind .
<$M1B-g> {findnext
0}
943 bind .
<$M1B-r> dosearchback
944 bind .
<$M1B-s> dosearch
945 bind .
<$M1B-equal> {incrfont
1}
946 bind .
<$M1B-KP_Add> {incrfont
1}
947 bind .
<$M1B-minus> {incrfont
-1}
948 bind .
<$M1B-KP_Subtract> {incrfont
-1}
949 wm protocol . WM_DELETE_WINDOW doquit
950 bind .
<Button-1
> "click %W"
951 bind $fstring <Key-Return
> dofind
952 bind $sha1entry <Key-Return
> gotocommit
953 bind $sha1entry <<PasteSelection>> clearsha1
954 bind $cflist <1> {sel_flist %W %x %y; break}
955 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
956 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
957 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
959 set maincursor [. cget -cursor]
960 set textcursor [$ctext cget -cursor]
961 set curtextcursor $textcursor
963 set rowctxmenu .rowctxmenu
964 menu $rowctxmenu -tearoff 0
965 $rowctxmenu add command -label "Diff this -> selected" \
966 -command {diffvssel 0}
967 $rowctxmenu add command -label "Diff selected -> this" \
968 -command {diffvssel 1}
969 $rowctxmenu add command -label "Make patch" -command mkpatch
970 $rowctxmenu add command -label "Create tag" -command mktag
971 $rowctxmenu add command -label "Write commit to file" -command writecommit
972 $rowctxmenu add command -label "Create new branch" -command mkbranch
973 $rowctxmenu add command -label "Cherry-pick this commit" \
975 $rowctxmenu add command -label "Reset HEAD branch to here" \
978 set fakerowmenu .fakerowmenu
979 menu $fakerowmenu -tearoff 0
980 $fakerowmenu add command -label "Diff this -> selected" \
981 -command {diffvssel 0}
982 $fakerowmenu add command -label "Diff selected -> this" \
983 -command {diffvssel 1}
984 $fakerowmenu add command -label "Make patch" -command mkpatch
985 # $fakerowmenu add command -label "Commit" -command {mkcommit 0}
986 # $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
987 # $fakerowmenu add command -label "Revert local changes" -command revertlocal
989 set headctxmenu .headctxmenu
990 menu $headctxmenu -tearoff 0
991 $headctxmenu add command -label "Check out this branch" \
993 $headctxmenu add command -label "Remove this branch" \
997 set flist_menu .flistctxmenu
998 menu $flist_menu -tearoff 0
999 $flist_menu add command -label "Highlight this too" \
1000 -command {flist_hl 0}
1001 $flist_menu add command -label "Highlight this only" \
1002 -command {flist_hl 1}
1005 # Windows sends all mouse wheel events to the current focused window, not
1006 # the one where the mouse hovers, so bind those events here and redirect
1007 # to the correct window
1008 proc windows_mousewheel_redirector {W X Y D} {
1009 global canv canv2 canv3
1010 set w [winfo containing -displayof $W $X $Y]
1012 set u [expr {$D < 0 ? 5 : -5}]
1013 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1014 allcanvs yview scroll $u units
1017 $w yview scroll $u units
1023 # mouse-2 makes all windows scan vertically, but only the one
1024 # the cursor is in scans horizontally
1025 proc canvscan {op w x y} {
1026 global canv canv2 canv3
1027 foreach c [list $canv $canv2 $canv3] {
1036 proc scrollcanv {cscroll f0 f1} {
1037 $cscroll set $f0 $f1
1042 # when we make a key binding for the toplevel, make sure
1043 # it doesn't get triggered when that key is pressed in the
1044 # find string entry widget.
1045 proc bindkey {ev script} {
1048 set escript [bind Entry $ev]
1049 if {$escript == {}} {
1050 set escript [bind Entry <Key>]
1052 foreach e $entries {
1053 bind $e $ev "$escript; break"
1057 # set the focus back to the toplevel for any click outside
1060 global ctext entries
1061 foreach e [concat $entries $ctext] {
1062 if {$w == $e} return
1067 proc savestuff {w} {
1068 global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1069 global stuffsaved findmergefiles maxgraphpct
1070 global maxwidth showneartags showlocalchanges
1071 global viewname viewfiles viewargs viewperm nextviewnum
1072 global cmitmode wrapcomment datetimeformat
1073 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1075 if {$stuffsaved} return
1076 if {![winfo viewable .]} return
1078 set f [open "~/.gitk-new" w]
1079 puts $f [list set mainfont $mainfont]
1080 puts $f [list set textfont $textfont]
1081 puts $f [list set uifont $uifont]
1082 puts $f [list set tabstop $tabstop]
1083 puts $f [list set findmergefiles $findmergefiles]
1084 puts $f [list set maxgraphpct $maxgraphpct]
1085 puts $f [list set maxwidth $maxwidth]
1086 puts $f [list set cmitmode $cmitmode]
1087 puts $f [list set wrapcomment $wrapcomment]
1088 puts $f [list set showneartags $showneartags]
1089 puts $f [list set showlocalchanges $showlocalchanges]
1090 puts $f [list set datetimeformat $datetimeformat]
1091 puts $f [list set bgcolor $bgcolor]
1092 puts $f [list set fgcolor $fgcolor]
1093 puts $f [list set colors $colors]
1094 puts $f [list set diffcolors $diffcolors]
1095 puts $f [list set diffcontext $diffcontext]
1096 puts $f [list set selectbgcolor $selectbgcolor]
1098 puts $f "set geometry(main) [wm geometry .]"
1099 puts $f "set geometry(topwidth) [winfo width .tf]"
1100 puts $f "set geometry(topheight) [winfo height .tf]"
1101 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1102 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1103 puts $f "set geometry(botwidth) [winfo width .bleft]"
1104 puts $f "set geometry(botheight) [winfo height .bleft]"
1106 puts -nonewline $f "set permviews {"
1107 for {set v 0} {$v < $nextviewnum} {incr v} {
1108 if {$viewperm($v)} {
1109 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1114 file rename -force "~/.gitk-new" "~/.gitk"
1119 proc resizeclistpanes {win w} {
1121 if {[info exists oldwidth($win)]} {
1122 set s0 [$win sash coord 0]
1123 set s1 [$win sash coord 1]
1125 set sash0 [expr {int($w/2 - 2)}]
1126 set sash1 [expr {int($w*5/6 - 2)}]
1128 set factor [expr {1.0 * $w / $oldwidth($win)}]
1129 set sash0 [expr {int($factor * [lindex $s0 0])}]
1130 set sash1 [expr {int($factor * [lindex $s1 0])}]
1134 if {$sash1 < $sash0 + 20} {
1135 set sash1 [expr {$sash0 + 20}]
1137 if {$sash1 > $w - 10} {
1138 set sash1 [expr {$w - 10}]
1139 if {$sash0 > $sash1 - 20} {
1140 set sash0 [expr {$sash1 - 20}]
1144 $win sash place 0 $sash0 [lindex $s0 1]
1145 $win sash place 1 $sash1 [lindex $s1 1]
1147 set oldwidth($win) $w
1150 proc resizecdetpanes {win w} {
1152 if {[info exists oldwidth($win)]} {
1153 set s0 [$win sash coord 0]
1155 set sash0 [expr {int($w*3/4 - 2)}]
1157 set factor [expr {1.0 * $w / $oldwidth($win)}]
1158 set sash0 [expr {int($factor * [lindex $s0 0])}]
1162 if {$sash0 > $w - 15} {
1163 set sash0 [expr {$w - 15}]
1166 $win sash place 0 $sash0 [lindex $s0 1]
1168 set oldwidth($win) $w
1171 proc allcanvs args {
1172 global canv canv2 canv3
1178 proc bindall {event action} {
1179 global canv canv2 canv3
1180 bind $canv $event $action
1181 bind $canv2 $event $action
1182 bind $canv3 $event $action
1188 if {[winfo exists $w]} {
1193 wm title $w "About gitk"
1194 message $w.m -text {
1195 Gitk - a commit viewer for git
1197 Copyright © 2005-2006 Paul Mackerras
1199 Use and redistribute under the terms of the GNU General Public License} \
1200 -justify center -aspect 400 -border 2 -bg white -relief groove
1201 pack $w.m -side top -fill x -padx 2 -pady 2
1202 $w.m configure -font $uifont
1203 button $w.ok -text Close -command "destroy $w" -default active
1204 pack $w.ok -side bottom
1205 $w.ok configure -font $uifont
1206 bind $w <Visibility> "focus $w.ok"
1207 bind $w <Key-Escape> "destroy $w"
1208 bind $w <Key-Return> "destroy $w"
1214 if {[winfo exists $w]} {
1218 if {[tk windowingsystem] eq {aqua}} {
1224 wm title $w "Gitk key bindings"
1225 message $w.m -text "
1229 <Home> Move to first commit
1230 <End> Move to last commit
1231 <Up>, p, i Move up one commit
1232 <Down>, n, k Move down one commit
1233 <Left>, z, j Go back in history list
1234 <Right>, x, l Go forward in history list
1235 <PageUp> Move up one page in commit list
1236 <PageDown> Move down one page in commit list
1237 <$M1T-Home> Scroll to top of commit list
1238 <$M1T-End> Scroll to bottom of commit list
1239 <$M1T-Up> Scroll commit list up one line
1240 <$M1T-Down> Scroll commit list down one line
1241 <$M1T-PageUp> Scroll commit list up one page
1242 <$M1T-PageDown> Scroll commit list down one page
1243 <Shift-Up> Move to previous highlighted line
1244 <Shift-Down> Move to next highlighted line
1245 <Delete>, b Scroll diff view up one page
1246 <Backspace> Scroll diff view up one page
1247 <Space> Scroll diff view down one page
1248 u Scroll diff view up 18 lines
1249 d Scroll diff view down 18 lines
1251 <$M1T-G> Move to next find hit
1252 <Return> Move to next find hit
1253 / Move to next find hit, or redo find
1254 ? Move to previous find hit
1255 f Scroll diff view to next file
1256 <$M1T-S> Search for next hit in diff view
1257 <$M1T-R> Search for previous hit in diff view
1258 <$M1T-KP+> Increase font size
1259 <$M1T-plus> Increase font size
1260 <$M1T-KP-> Decrease font size
1261 <$M1T-minus> Decrease font size
1264 -justify left -bg white -border 2 -relief groove
1265 pack $w.m -side top -fill both -padx 2 -pady 2
1266 $w.m configure -font $uifont
1267 button $w.ok -text Close -command "destroy $w" -default active
1268 pack $w.ok -side bottom
1269 $w.ok configure -font $uifont
1270 bind $w <Visibility> "focus $w.ok"
1271 bind $w <Key-Escape> "destroy $w"
1272 bind $w <Key-Return> "destroy $w"
1275 # Procedures for manipulating the file list window at the
1276 # bottom right of the overall window.
1278 proc treeview {w l openlevs} {
1279 global treecontents treediropen treeheight treeparent treeindex
1289 set treecontents() {}
1290 $w conf -state normal
1292 while {[string range $f 0 $prefixend] ne $prefix} {
1293 if {$lev <= $openlevs} {
1294 $w mark set e:$treeindex($prefix) "end -1c"
1295 $w mark gravity e:$treeindex($prefix) left
1297 set treeheight($prefix) $ht
1298 incr ht [lindex $htstack end]
1299 set htstack [lreplace $htstack end end]
1300 set prefixend [lindex $prefendstack end]
1301 set prefendstack [lreplace $prefendstack end end]
1302 set prefix [string range $prefix 0 $prefixend]
1305 set tail [string range $f [expr {$prefixend+1}] end]
1306 while {[set slash [string first "/" $tail]] >= 0} {
1309 lappend prefendstack $prefixend
1310 incr prefixend [expr {$slash + 1}]
1311 set d [string range $tail 0 $slash]
1312 lappend treecontents($prefix) $d
1313 set oldprefix $prefix
1315 set treecontents($prefix) {}
1316 set treeindex($prefix) [incr ix]
1317 set treeparent($prefix) $oldprefix
1318 set tail [string range $tail [expr {$slash+1}] end]
1319 if {$lev <= $openlevs} {
1321 set treediropen($prefix) [expr {$lev < $openlevs}]
1322 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1323 $w mark set d:$ix "end -1c"
1324 $w mark gravity d:$ix left
1326 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1328 $w image create end -align center -image $bm -padx 1 \
1330 $w insert end $d [highlight_tag $prefix]
1331 $w mark set s:$ix "end -1c"
1332 $w mark gravity s:$ix left
1337 if {$lev <= $openlevs} {
1340 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1342 $w insert end $tail [highlight_tag $f]
1344 lappend treecontents($prefix) $tail
1347 while {$htstack ne {}} {
1348 set treeheight($prefix) $ht
1349 incr ht [lindex $htstack end]
1350 set htstack [lreplace $htstack end end]
1351 set prefixend [lindex $prefendstack end]
1352 set prefendstack [lreplace $prefendstack end end]
1353 set prefix [string range $prefix 0 $prefixend]
1355 $w conf -state disabled
1358 proc linetoelt {l} {
1359 global treeheight treecontents
1364 foreach e $treecontents($prefix) {
1369 if {[string index $e end] eq "/"} {
1370 set n $treeheight($prefix$e)
1382 proc highlight_tree {y prefix} {
1383 global treeheight treecontents cflist
1385 foreach e $treecontents($prefix) {
1387 if {[highlight_tag $path] ne {}} {
1388 $cflist tag add bold $y.0 "$y.0 lineend"
1391 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1392 set y [highlight_tree $y $path]
1398 proc treeclosedir {w dir} {
1399 global treediropen treeheight treeparent treeindex
1401 set ix $treeindex($dir)
1402 $w conf -state normal
1403 $w delete s:$ix e:$ix
1404 set treediropen($dir) 0
1405 $w image configure a:$ix -image tri-rt
1406 $w conf -state disabled
1407 set n [expr {1 - $treeheight($dir)}]
1408 while {$dir ne {}} {
1409 incr treeheight($dir) $n
1410 set dir $treeparent($dir)
1414 proc treeopendir {w dir} {
1415 global treediropen treeheight treeparent treecontents treeindex
1417 set ix $treeindex($dir)
1418 $w conf -state normal
1419 $w image configure a:$ix -image tri-dn
1420 $w mark set e:$ix s:$ix
1421 $w mark gravity e:$ix right
1424 set n [llength $treecontents($dir)]
1425 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1428 incr treeheight($x) $n
1430 foreach e $treecontents($dir) {
1432 if {[string index $e end] eq "/"} {
1433 set iy $treeindex($de)
1434 $w mark set d:$iy e:$ix
1435 $w mark gravity d:$iy left
1436 $w insert e:$ix $str
1437 set treediropen($de) 0
1438 $w image create e:$ix -align center -image tri-rt -padx 1 \
1440 $w insert e:$ix $e [highlight_tag $de]
1441 $w mark set s:$iy e:$ix
1442 $w mark gravity s:$iy left
1443 set treeheight($de) 1
1445 $w insert e:$ix $str
1446 $w insert e:$ix $e [highlight_tag $de]
1449 $w mark gravity e:$ix left
1450 $w conf -state disabled
1451 set treediropen($dir) 1
1452 set top [lindex [split [$w index @0,0] .] 0]
1453 set ht [$w cget -height]
1454 set l [lindex [split [$w index s:$ix] .] 0]
1457 } elseif {$l + $n + 1 > $top + $ht} {
1458 set top [expr {$l + $n + 2 - $ht}]
1466 proc treeclick {w x y} {
1467 global treediropen cmitmode ctext cflist cflist_top
1469 if {$cmitmode ne "tree"} return
1470 if {![info exists cflist_top]} return
1471 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1472 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1473 $cflist tag add highlight $l.0 "$l.0 lineend"
1479 set e [linetoelt $l]
1480 if {[string index $e end] ne "/"} {
1482 } elseif {$treediropen($e)} {
1489 proc setfilelist {id} {
1490 global treefilelist cflist
1492 treeview $cflist $treefilelist($id) 0
1495 image create bitmap tri-rt -background black -foreground blue -data {
1496 #define tri-rt_width 13
1497 #define tri-rt_height 13
1498 static unsigned char tri-rt_bits[] = {
1499 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1500 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1503 #define tri-rt-mask_width 13
1504 #define tri-rt-mask_height 13
1505 static unsigned char tri-rt-mask_bits[] = {
1506 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1507 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1510 image create bitmap tri-dn -background black -foreground blue -data {
1511 #define tri-dn_width 13
1512 #define tri-dn_height 13
1513 static unsigned char tri-dn_bits[] = {
1514 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1515 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1518 #define tri-dn-mask_width 13
1519 #define tri-dn-mask_height 13
1520 static unsigned char tri-dn-mask_bits[] = {
1521 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1522 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1526 image create bitmap reficon-T -background black -foreground yellow -data {
1527 #define tagicon_width 13
1528 #define tagicon_height 9
1529 static unsigned char tagicon_bits[] = {
1530 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1531 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1533 #define tagicon-mask_width 13
1534 #define tagicon-mask_height 9
1535 static unsigned char tagicon-mask_bits[] = {
1536 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1537 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1540 #define headicon_width 13
1541 #define headicon_height 9
1542 static unsigned char headicon_bits[] = {
1543 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1544 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1547 #define headicon-mask_width 13
1548 #define headicon-mask_height 9
1549 static unsigned char headicon-mask_bits[] = {
1550 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1551 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1553 image create bitmap reficon-H -background black -foreground green \
1554 -data $rectdata -maskdata $rectmask
1555 image create bitmap reficon-o -background black -foreground "#ddddff" \
1556 -data $rectdata -maskdata $rectmask
1558 proc init_flist {first} {
1559 global cflist cflist_top selectedline difffilestart
1561 $cflist conf -state normal
1562 $cflist delete 0.0 end
1564 $cflist insert end $first
1566 $cflist tag add highlight 1.0 "1.0 lineend"
1568 catch {unset cflist_top}
1570 $cflist conf -state disabled
1571 set difffilestart {}
1574 proc highlight_tag {f} {
1575 global highlight_paths
1577 foreach p $highlight_paths {
1578 if {[string match $p $f]} {
1585 proc highlight_filelist {} {
1586 global cmitmode cflist
1588 $cflist conf -state normal
1589 if {$cmitmode ne "tree"} {
1590 set end [lindex [split [$cflist index end] .] 0]
1591 for {set l 2} {$l < $end} {incr l} {
1592 set line [$cflist get $l.0 "$l.0 lineend"]
1593 if {[highlight_tag $line] ne {}} {
1594 $cflist tag add bold $l.0 "$l.0 lineend"
1600 $cflist conf -state disabled
1603 proc unhighlight_filelist {} {
1606 $cflist conf -state normal
1607 $cflist tag remove bold 1.0 end
1608 $cflist conf -state disabled
1611 proc add_flist {fl} {
1614 $cflist conf -state normal
1616 $cflist insert end "\n"
1617 $cflist insert end $f [highlight_tag $f]
1619 $cflist conf -state disabled
1622 proc sel_flist {w x y} {
1623 global ctext difffilestart cflist cflist_top cmitmode
1625 if {$cmitmode eq "tree"} return
1626 if {![info exists cflist_top]} return
1627 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1628 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1629 $cflist tag add highlight $l.0 "$l.0 lineend"
1634 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1638 proc pop_flist_menu {w X Y x y} {
1639 global ctext cflist cmitmode flist_menu flist_menu_file
1640 global treediffs diffids
1642 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1644 if {$cmitmode eq "tree"} {
1645 set e [linetoelt $l]
1646 if {[string index $e end] eq "/"} return
1648 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1650 set flist_menu_file $e
1651 tk_popup $flist_menu $X $Y
1654 proc flist_hl {only} {
1655 global flist_menu_file highlight_files
1657 set x [shellquote $flist_menu_file]
1658 if {$only || $highlight_files eq {}} {
1659 set highlight_files $x
1661 append highlight_files " " $x
1665 # Functions for adding and removing shell-type quoting
1667 proc shellquote {str} {
1668 if {![string match "*\['\"\\ \t]*" $str]} {
1671 if {![string match "*\['\"\\]*" $str]} {
1674 if {![string match "*'*" $str]} {
1677 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1680 proc shellarglist {l} {
1686 append str [shellquote $a]
1691 proc shelldequote {str} {
1696 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1697 append ret [string range $str $used end]
1698 set used [string length $str]
1701 set first [lindex $first 0]
1702 set ch [string index $str $first]
1703 if {$first > $used} {
1704 append ret [string range $str $used [expr {$first - 1}]]
1707 if {$ch eq " " || $ch eq "\t"} break
1710 set first [string first "'" $str $used]
1712 error "unmatched single-quote"
1714 append ret [string range $str $used [expr {$first - 1}]]
1719 if {$used >= [string length $str]} {
1720 error "trailing backslash"
1722 append ret [string index $str $used]
1727 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1728 error "unmatched double-quote"
1730 set first [lindex $first 0]
1731 set ch [string index $str $first]
1732 if {$first > $used} {
1733 append ret [string range $str $used [expr {$first - 1}]]
1736 if {$ch eq "\""} break
1738 append ret [string index $str $used]
1742 return [list $used $ret]
1745 proc shellsplit {str} {
1748 set str [string trimleft $str]
1749 if {$str eq {}} break
1750 set dq [shelldequote $str]
1751 set n [lindex $dq 0]
1752 set word [lindex $dq 1]
1753 set str [string range $str $n end]
1759 # Code to implement multiple views
1761 proc newview {ishighlight} {
1762 global nextviewnum newviewname newviewperm uifont newishighlight
1763 global newviewargs revtreeargs
1765 set newishighlight $ishighlight
1767 if {[winfo exists $top]} {
1771 set newviewname($nextviewnum) "View $nextviewnum"
1772 set newviewperm($nextviewnum) 0
1773 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1774 vieweditor $top $nextviewnum "Gitk view definition"
1779 global viewname viewperm newviewname newviewperm
1780 global viewargs newviewargs
1782 set top .gitkvedit-$curview
1783 if {[winfo exists $top]} {
1787 set newviewname($curview) $viewname($curview)
1788 set newviewperm($curview) $viewperm($curview)
1789 set newviewargs($curview) [shellarglist $viewargs($curview)]
1790 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1793 proc vieweditor {top n title} {
1794 global newviewname newviewperm viewfiles
1798 wm title $top $title
1799 label $top.nl -text "Name" -font $uifont
1800 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1801 grid $top.nl $top.name -sticky w -pady 5
1802 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1804 grid $top.perm - -pady 5 -sticky w
1805 message $top.al -aspect 1000 -font $uifont \
1806 -text "Commits to include (arguments to git rev-list):"
1807 grid $top.al - -sticky w -pady 5
1808 entry $top.args -width 50 -textvariable newviewargs($n) \
1809 -background white -font $uifont
1810 grid $top.args - -sticky ew -padx 5
1811 message $top.l -aspect 1000 -font $uifont \
1812 -text "Enter files and directories to include, one per line:"
1813 grid $top.l - -sticky w
1814 text $top.t -width 40 -height 10 -background white -font $uifont
1815 if {[info exists viewfiles($n)]} {
1816 foreach f $viewfiles($n) {
1817 $top.t insert end $f
1818 $top.t insert end "\n"
1820 $top.t delete {end - 1c} end
1821 $top.t mark set insert 0.0
1823 grid $top.t - -sticky ew -padx 5
1825 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1827 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1829 grid $top.buts.ok $top.buts.can
1830 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1831 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1832 grid $top.buts - -pady 10 -sticky ew
1836 proc doviewmenu {m first cmd op argv} {
1837 set nmenu [$m index end]
1838 for {set i $first} {$i <= $nmenu} {incr i} {
1839 if {[$m entrycget $i -command] eq $cmd} {
1840 eval $m $op $i $argv
1846 proc allviewmenus {n op args} {
1849 doviewmenu .bar.view 5 [list showview $n] $op $args
1850 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1853 proc newviewok {top n} {
1854 global nextviewnum newviewperm newviewname newishighlight
1855 global viewname viewfiles viewperm selectedview curview
1856 global viewargs newviewargs viewhlmenu
1859 set newargs [shellsplit $newviewargs($n)]
1861 error_popup "Error in commit selection arguments: $err"
1867 foreach f [split [$top.t get 0.0 end] "\n"] {
1868 set ft [string trim $f]
1873 if {![info exists viewfiles($n)]} {
1874 # creating a new view
1876 set viewname($n) $newviewname($n)
1877 set viewperm($n) $newviewperm($n)
1878 set viewfiles($n) $files
1879 set viewargs($n) $newargs
1881 if {!$newishighlight} {
1884 run addvhighlight $n
1887 # editing an existing view
1888 set viewperm($n) $newviewperm($n)
1889 if {$newviewname($n) ne $viewname($n)} {
1890 set viewname($n) $newviewname($n)
1891 doviewmenu .bar.view 5 [list showview $n] \
1892 entryconf [list -label $viewname($n)]
1893 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1894 entryconf [list -label $viewname($n) -value $viewname($n)]
1896 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1897 set viewfiles($n) $files
1898 set viewargs($n) $newargs
1899 if {$curview == $n} {
1904 catch {destroy $top}
1908 global curview viewdata viewperm hlview selectedhlview
1910 if {$curview == 0} return
1911 if {[info exists hlview] && $hlview == $curview} {
1912 set selectedhlview None
1915 allviewmenus $curview delete
1916 set viewdata($curview) {}
1917 set viewperm($curview) 0
1921 proc addviewmenu {n} {
1922 global viewname viewhlmenu
1924 .bar.view add radiobutton -label $viewname($n) \
1925 -command [list showview $n] -variable selectedview -value $n
1926 $viewhlmenu add radiobutton -label $viewname($n) \
1927 -command [list addvhighlight $n] -variable selectedhlview
1930 proc flatten {var} {
1934 foreach i [array names $var] {
1935 lappend ret $i [set $var\($i\)]
1940 proc unflatten {var l} {
1950 global curview viewdata viewfiles
1951 global displayorder parentlist rowidlist rowisopt rowfinal
1952 global colormap rowtextx commitrow nextcolor canvxmax
1953 global numcommits commitlisted
1954 global selectedline currentid canv canvy0
1956 global pending_select phase
1959 global selectedview selectfirst
1960 global vparentlist vdisporder vcmitlisted
1961 global hlview selectedhlview commitinterest
1963 if {$n == $curview} return
1965 if {[info exists selectedline]} {
1966 set selid $currentid
1967 set y [yc $selectedline]
1968 set ymax [lindex [$canv cget -scrollregion] 3]
1969 set span [$canv yview]
1970 set ytop [expr {[lindex $span 0] * $ymax}]
1971 set ybot [expr {[lindex $span 1] * $ymax}]
1972 if {$ytop < $y && $y < $ybot} {
1973 set yscreen [expr {$y - $ytop}]
1975 set yscreen [expr {($ybot - $ytop) / 2}]
1977 } elseif {[info exists pending_select]} {
1978 set selid $pending_select
1979 unset pending_select
1983 if {$curview >= 0} {
1984 set vparentlist($curview) $parentlist
1985 set vdisporder($curview) $displayorder
1986 set vcmitlisted($curview) $commitlisted
1988 ![info exists viewdata($curview)] ||
1989 [lindex $viewdata($curview) 0] ne {}} {
1990 set viewdata($curview) \
1991 [list $phase $rowidlist $rowisopt $rowfinal]
1994 catch {unset treediffs}
1996 if {[info exists hlview] && $hlview == $n} {
1998 set selectedhlview None
2000 catch {unset commitinterest}
2004 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2005 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2008 if {![info exists viewdata($n)]} {
2010 set pending_select $selid
2017 set phase [lindex $v 0]
2018 set displayorder $vdisporder($n)
2019 set parentlist $vparentlist($n)
2020 set commitlisted $vcmitlisted($n)
2021 set rowidlist [lindex $v 1]
2022 set rowisopt [lindex $v 2]
2023 set rowfinal [lindex $v 3]
2024 set numcommits $commitidx($n)
2026 catch {unset colormap}
2027 catch {unset rowtextx}
2029 set canvxmax [$canv cget -width]
2036 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2037 set row $commitrow($n,$selid)
2038 # try to get the selected row in the same position on the screen
2039 set ymax [lindex [$canv cget -scrollregion] 3]
2040 set ytop [expr {[yc $row] - $yscreen}]
2044 set yf [expr {$ytop * 1.0 / $ymax}]
2046 allcanvs yview moveto $yf
2050 } elseif {$selid ne {}} {
2051 set pending_select $selid
2053 set row [first_real_row]
2054 if {$row < $numcommits} {
2061 if {$phase eq "getcommits"} {
2062 show_status "Reading commits..."
2065 } elseif {$numcommits == 0} {
2066 show_status "No commits selected"
2070 # Stuff relating to the highlighting facility
2072 proc ishighlighted {row} {
2073 global vhighlights fhighlights nhighlights rhighlights
2075 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2076 return $nhighlights($row)
2078 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2079 return $vhighlights($row)
2081 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2082 return $fhighlights($row)
2084 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2085 return $rhighlights($row)
2090 proc bolden {row font} {
2091 global canv linehtag selectedline boldrows
2093 lappend boldrows $row
2094 $canv itemconf $linehtag($row) -font $font
2095 if {[info exists selectedline] && $row == $selectedline} {
2097 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2098 -outline {{}} -tags secsel \
2099 -fill [$canv cget -selectbackground]]
2104 proc bolden_name {row font} {
2105 global canv2 linentag selectedline boldnamerows
2107 lappend boldnamerows $row
2108 $canv2 itemconf $linentag($row) -font $font
2109 if {[info exists selectedline] && $row == $selectedline} {
2110 $canv2 delete secsel
2111 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2112 -outline {{}} -tags secsel \
2113 -fill [$canv2 cget -selectbackground]]
2119 global mainfont boldrows
2122 foreach row $boldrows {
2123 if {![ishighlighted $row]} {
2124 bolden $row $mainfont
2126 lappend stillbold $row
2129 set boldrows $stillbold
2132 proc addvhighlight {n} {
2133 global hlview curview viewdata vhl_done vhighlights commitidx
2135 if {[info exists hlview]} {
2139 if {$n != $curview && ![info exists viewdata($n)]} {
2140 set viewdata($n) [list getcommits {{}} 0 0 0]
2141 set vparentlist($n) {}
2142 set vdisporder($n) {}
2143 set vcmitlisted($n) {}
2146 set vhl_done $commitidx($hlview)
2147 if {$vhl_done > 0} {
2152 proc delvhighlight {} {
2153 global hlview vhighlights
2155 if {![info exists hlview]} return
2157 catch {unset vhighlights}
2161 proc vhighlightmore {} {
2162 global hlview vhl_done commitidx vhighlights
2163 global displayorder vdisporder curview mainfont
2165 set font [concat $mainfont bold]
2166 set max $commitidx($hlview)
2167 if {$hlview == $curview} {
2168 set disp $displayorder
2170 set disp $vdisporder($hlview)
2172 set vr [visiblerows]
2173 set r0 [lindex $vr 0]
2174 set r1 [lindex $vr 1]
2175 for {set i $vhl_done} {$i < $max} {incr i} {
2176 set id [lindex $disp $i]
2177 if {[info exists commitrow($curview,$id)]} {
2178 set row $commitrow($curview,$id)
2179 if {$r0 <= $row && $row <= $r1} {
2180 if {![highlighted $row]} {
2183 set vhighlights($row) 1
2190 proc askvhighlight {row id} {
2191 global hlview vhighlights commitrow iddrawn mainfont
2193 if {[info exists commitrow($hlview,$id)]} {
2194 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2195 bolden $row [concat $mainfont bold]
2197 set vhighlights($row) 1
2199 set vhighlights($row) 0
2203 proc hfiles_change {name ix op} {
2204 global highlight_files filehighlight fhighlights fh_serial
2205 global mainfont highlight_paths
2207 if {[info exists filehighlight]} {
2208 # delete previous highlights
2209 catch {close $filehighlight}
2211 catch {unset fhighlights}
2213 unhighlight_filelist
2215 set highlight_paths {}
2216 after cancel do_file_hl $fh_serial
2218 if {$highlight_files ne {}} {
2219 after 300 do_file_hl $fh_serial
2223 proc makepatterns {l} {
2226 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2227 if {[string index $ee end] eq "/"} {
2237 proc do_file_hl {serial} {
2238 global highlight_files filehighlight highlight_paths gdttype fhl_list
2240 if {$gdttype eq "touching paths:"} {
2241 if {[catch {set paths [shellsplit $highlight_files]}]} return
2242 set highlight_paths [makepatterns $paths]
2244 set gdtargs [concat -- $paths]
2246 set gdtargs [list "-S$highlight_files"]
2248 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2249 set filehighlight [open $cmd r+]
2250 fconfigure $filehighlight -blocking 0
2251 filerun $filehighlight readfhighlight
2257 proc flushhighlights {} {
2258 global filehighlight fhl_list
2260 if {[info exists filehighlight]} {
2262 puts $filehighlight ""
2263 flush $filehighlight
2267 proc askfilehighlight {row id} {
2268 global filehighlight fhighlights fhl_list
2270 lappend fhl_list $id
2271 set fhighlights($row) -1
2272 puts $filehighlight $id
2275 proc readfhighlight {} {
2276 global filehighlight fhighlights commitrow curview mainfont iddrawn
2279 if {![info exists filehighlight]} {
2283 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2284 set line [string trim $line]
2285 set i [lsearch -exact $fhl_list $line]
2286 if {$i < 0} continue
2287 for {set j 0} {$j < $i} {incr j} {
2288 set id [lindex $fhl_list $j]
2289 if {[info exists commitrow($curview,$id)]} {
2290 set fhighlights($commitrow($curview,$id)) 0
2293 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2294 if {$line eq {}} continue
2295 if {![info exists commitrow($curview,$line)]} continue
2296 set row $commitrow($curview,$line)
2297 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2298 bolden $row [concat $mainfont bold]
2300 set fhighlights($row) 1
2302 if {[eof $filehighlight]} {
2304 puts "oops, git diff-tree died"
2305 catch {close $filehighlight}
2313 proc find_change {name ix op} {
2314 global nhighlights mainfont boldnamerows
2315 global findstring findpattern findtype
2317 # delete previous highlights, if any
2318 foreach row $boldnamerows {
2319 bolden_name $row $mainfont
2322 catch {unset nhighlights}
2325 if {$findtype ne "Regexp"} {
2326 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2328 set findpattern "*$e*"
2333 proc doesmatch {f} {
2334 global findtype findstring findpattern
2336 if {$findtype eq "Regexp"} {
2337 return [regexp $findstring $f]
2338 } elseif {$findtype eq "IgnCase"} {
2339 return [string match -nocase $findpattern $f]
2341 return [string match $findpattern $f]
2345 proc askfindhighlight {row id} {
2346 global nhighlights commitinfo iddrawn mainfont
2348 global markingmatches
2350 if {![info exists commitinfo($id)]} {
2353 set info $commitinfo($id)
2355 set fldtypes {Headline Author Date Committer CDate Comments}
2356 foreach f $info ty $fldtypes {
2357 if {($findloc eq "All fields" || $findloc eq $ty) &&
2359 if {$ty eq "Author"} {
2366 if {$isbold && [info exists iddrawn($id)]} {
2367 set f [concat $mainfont bold]
2368 if {![ishighlighted $row]} {
2374 if {$markingmatches} {
2375 markrowmatches $row $id
2378 set nhighlights($row) $isbold
2381 proc markrowmatches {row id} {
2382 global canv canv2 linehtag linentag commitinfo findloc
2384 set headline [lindex $commitinfo($id) 0]
2385 set author [lindex $commitinfo($id) 1]
2386 $canv delete match$row
2387 $canv2 delete match$row
2388 if {$findloc eq "All fields" || $findloc eq "Headline"} {
2389 set m [findmatches $headline]
2391 markmatches $canv $row $headline $linehtag($row) $m \
2392 [$canv itemcget $linehtag($row) -font] $row
2395 if {$findloc eq "All fields" || $findloc eq "Author"} {
2396 set m [findmatches $author]
2398 markmatches $canv2 $row $author $linentag($row) $m \
2399 [$canv2 itemcget $linentag($row) -font] $row
2404 proc vrel_change {name ix op} {
2405 global highlight_related
2408 if {$highlight_related ne "None"} {
2413 # prepare for testing whether commits are descendents or ancestors of a
2414 proc rhighlight_sel {a} {
2415 global descendent desc_todo ancestor anc_todo
2416 global highlight_related rhighlights
2418 catch {unset descendent}
2419 set desc_todo [list $a]
2420 catch {unset ancestor}
2421 set anc_todo [list $a]
2422 if {$highlight_related ne "None"} {
2428 proc rhighlight_none {} {
2431 catch {unset rhighlights}
2435 proc is_descendent {a} {
2436 global curview children commitrow descendent desc_todo
2439 set la $commitrow($v,$a)
2443 for {set i 0} {$i < [llength $todo]} {incr i} {
2444 set do [lindex $todo $i]
2445 if {$commitrow($v,$do) < $la} {
2446 lappend leftover $do
2449 foreach nk $children($v,$do) {
2450 if {![info exists descendent($nk)]} {
2451 set descendent($nk) 1
2459 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2463 set descendent($a) 0
2464 set desc_todo $leftover
2467 proc is_ancestor {a} {
2468 global curview parentlist commitrow ancestor anc_todo
2471 set la $commitrow($v,$a)
2475 for {set i 0} {$i < [llength $todo]} {incr i} {
2476 set do [lindex $todo $i]
2477 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2478 lappend leftover $do
2481 foreach np [lindex $parentlist $commitrow($v,$do)] {
2482 if {![info exists ancestor($np)]} {
2491 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2496 set anc_todo $leftover
2499 proc askrelhighlight {row id} {
2500 global descendent highlight_related iddrawn mainfont rhighlights
2501 global selectedline ancestor
2503 if {![info exists selectedline]} return
2505 if {$highlight_related eq "Descendent" ||
2506 $highlight_related eq "Not descendent"} {
2507 if {![info exists descendent($id)]} {
2510 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2513 } elseif {$highlight_related eq "Ancestor" ||
2514 $highlight_related eq "Not ancestor"} {
2515 if {![info exists ancestor($id)]} {
2518 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2522 if {[info exists iddrawn($id)]} {
2523 if {$isbold && ![ishighlighted $row]} {
2524 bolden $row [concat $mainfont bold]
2527 set rhighlights($row) $isbold
2530 proc next_hlcont {} {
2531 global fhl_row fhl_dirn displayorder numcommits
2532 global vhighlights fhighlights nhighlights rhighlights
2533 global hlview filehighlight findstring highlight_related
2535 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2538 if {$row < 0 || $row >= $numcommits} {
2543 set id [lindex $displayorder $row]
2544 if {[info exists hlview]} {
2545 if {![info exists vhighlights($row)]} {
2546 askvhighlight $row $id
2548 if {$vhighlights($row) > 0} break
2550 if {$findstring ne {}} {
2551 if {![info exists nhighlights($row)]} {
2552 askfindhighlight $row $id
2554 if {$nhighlights($row) > 0} break
2556 if {$highlight_related ne "None"} {
2557 if {![info exists rhighlights($row)]} {
2558 askrelhighlight $row $id
2560 if {$rhighlights($row) > 0} break
2562 if {[info exists filehighlight]} {
2563 if {![info exists fhighlights($row)]} {
2564 # ask for a few more while we're at it...
2566 for {set n 0} {$n < 100} {incr n} {
2567 if {![info exists fhighlights($r)]} {
2568 askfilehighlight $r [lindex $displayorder $r]
2571 if {$r < 0 || $r >= $numcommits} break
2575 if {$fhighlights($row) < 0} {
2579 if {$fhighlights($row) > 0} break
2587 proc next_highlight {dirn} {
2588 global selectedline fhl_row fhl_dirn
2589 global hlview filehighlight findstring highlight_related
2591 if {![info exists selectedline]} return
2592 if {!([info exists hlview] || $findstring ne {} ||
2593 $highlight_related ne "None" || [info exists filehighlight])} return
2594 set fhl_row [expr {$selectedline + $dirn}]
2599 proc cancel_next_highlight {} {
2605 # Graph layout functions
2607 proc shortids {ids} {
2610 if {[llength $id] > 1} {
2611 lappend res [shortids $id]
2612 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2613 lappend res [string range $id 0 7]
2624 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2625 if {($n & $mask) != 0} {
2626 set ret [concat $ret $o]
2628 set o [concat $o $o]
2633 # Work out where id should go in idlist so that order-token
2634 # values increase from left to right
2635 proc idcol {idlist id {i 0}} {
2636 global ordertok curview
2638 set t $ordertok($curview,$id)
2639 if {$i >= [llength $idlist] ||
2640 $t < $ordertok($curview,[lindex $idlist $i])} {
2641 if {$i > [llength $idlist]} {
2642 set i [llength $idlist]
2644 while {[incr i -1] >= 0 &&
2645 $t < $ordertok($curview,[lindex $idlist $i])} {}
2648 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2649 while {[incr i] < [llength $idlist] &&
2650 $t >= $ordertok($curview,[lindex $idlist $i])} {}
2656 proc initlayout {} {
2657 global rowidlist rowisopt rowfinal displayorder commitlisted
2658 global numcommits canvxmax canv
2661 global colormap rowtextx
2672 set canvxmax [$canv cget -width]
2673 catch {unset colormap}
2674 catch {unset rowtextx}
2678 proc setcanvscroll {} {
2679 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2681 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2682 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2683 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2684 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2687 proc visiblerows {} {
2688 global canv numcommits linespc
2690 set ymax [lindex [$canv cget -scrollregion] 3]
2691 if {$ymax eq {} || $ymax == 0} return
2693 set y0 [expr {int([lindex $f 0] * $ymax)}]
2694 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2698 set y1 [expr {int([lindex $f 1] * $ymax)}]
2699 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2700 if {$r1 >= $numcommits} {
2701 set r1 [expr {$numcommits - 1}]
2703 return [list $r0 $r1]
2706 proc layoutmore {} {
2707 global commitidx viewcomplete numcommits
2708 global uparrowlen downarrowlen mingaplen curview
2710 set show $commitidx($curview)
2711 if {$show > $numcommits} {
2712 showstuff $show $viewcomplete($curview)
2716 proc showstuff {canshow last} {
2717 global numcommits commitrow pending_select selectedline curview
2718 global lookingforhead mainheadid displayorder selectfirst
2719 global lastscrollset commitinterest
2721 if {$numcommits == 0} {
2723 set phase "incrdraw"
2726 for {set l $numcommits} {$l < $canshow} {incr l} {
2727 set id [lindex $displayorder $l]
2728 if {[info exists commitinterest($id)]} {
2729 foreach script $commitinterest($id) {
2730 eval [string map [list "%I" $id] $script]
2732 unset commitinterest($id)
2736 set prev $numcommits
2737 set numcommits $canshow
2738 set t [clock clicks -milliseconds]
2739 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2740 set lastscrollset $t
2743 set rows [visiblerows]
2744 set r1 [lindex $rows 1]
2745 if {$r1 >= $canshow} {
2746 set r1 [expr {$canshow - 1}]
2751 if {[info exists pending_select] &&
2752 [info exists commitrow($curview,$pending_select)] &&
2753 $commitrow($curview,$pending_select) < $numcommits} {
2754 selectline $commitrow($curview,$pending_select) 1
2757 if {[info exists selectedline] || [info exists pending_select]} {
2760 set l [first_real_row]
2765 if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2766 && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2767 set lookingforhead 0
2772 proc doshowlocalchanges {} {
2773 global lookingforhead curview mainheadid phase commitrow
2775 if {[info exists commitrow($curview,$mainheadid)] &&
2776 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2778 } elseif {$phase ne {}} {
2779 set lookingforhead 1
2783 proc dohidelocalchanges {} {
2784 global lookingforhead localfrow localirow lserial
2786 set lookingforhead 0
2787 if {$localfrow >= 0} {
2788 removerow $localfrow
2790 if {$localirow > 0} {
2794 if {$localirow >= 0} {
2795 removerow $localirow
2801 # spawn off a process to do git diff-index --cached HEAD
2802 proc dodiffindex {} {
2803 global localirow localfrow lserial
2808 set fd [open "|git diff-index --cached HEAD" r]
2809 fconfigure $fd -blocking 0
2810 filerun $fd [list readdiffindex $fd $lserial]
2813 proc readdiffindex {fd serial} {
2814 global localirow commitrow mainheadid nullid2 curview
2815 global commitinfo commitdata lserial
2818 if {[gets $fd line] < 0} {
2824 # we only need to see one line and we don't really care what it says...
2827 # now see if there are any local changes not checked in to the index
2828 if {$serial == $lserial} {
2829 set fd [open "|git diff-files" r]
2830 fconfigure $fd -blocking 0
2831 filerun $fd [list readdifffiles $fd $serial]
2834 if {$isdiff && $serial == $lserial && $localirow == -1} {
2835 # add the line for the changes in the index to the graph
2836 set localirow $commitrow($curview,$mainheadid)
2837 set hl "Local changes checked in to index but not committed"
2838 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2839 set commitdata($nullid2) "\n $hl\n"
2840 insertrow $localirow $nullid2
2845 proc readdifffiles {fd serial} {
2846 global localirow localfrow commitrow mainheadid nullid curview
2847 global commitinfo commitdata lserial
2850 if {[gets $fd line] < 0} {
2856 # we only need to see one line and we don't really care what it says...
2859 if {$isdiff && $serial == $lserial && $localfrow == -1} {
2860 # add the line for the local diff to the graph
2861 if {$localirow >= 0} {
2862 set localfrow $localirow
2865 set localfrow $commitrow($curview,$mainheadid)
2867 set hl "Local uncommitted changes, not checked in to index"
2868 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2869 set commitdata($nullid) "\n $hl\n"
2870 insertrow $localfrow $nullid
2875 proc nextuse {id row} {
2876 global commitrow curview children
2878 if {[info exists children($curview,$id)]} {
2879 foreach kid $children($curview,$id) {
2880 if {![info exists commitrow($curview,$kid)]} {
2883 if {$commitrow($curview,$kid) > $row} {
2884 return $commitrow($curview,$kid)
2888 if {[info exists commitrow($curview,$id)]} {
2889 return $commitrow($curview,$id)
2894 proc prevuse {id row} {
2895 global commitrow curview children
2898 if {[info exists children($curview,$id)]} {
2899 foreach kid $children($curview,$id) {
2900 if {![info exists commitrow($curview,$kid)]} break
2901 if {$commitrow($curview,$kid) < $row} {
2902 set ret $commitrow($curview,$kid)
2909 proc make_idlist {row} {
2910 global displayorder parentlist uparrowlen downarrowlen mingaplen
2911 global commitidx curview ordertok children commitrow
2913 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2917 set ra [expr {$row - $downarrowlen}]
2921 set rb [expr {$row + $uparrowlen}]
2922 if {$rb > $commitidx($curview)} {
2923 set rb $commitidx($curview)
2926 for {} {$r < $ra} {incr r} {
2927 set nextid [lindex $displayorder [expr {$r + 1}]]
2928 foreach p [lindex $parentlist $r] {
2929 if {$p eq $nextid} continue
2930 set rn [nextuse $p $r]
2932 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2933 lappend ids [list $ordertok($curview,$p) $p]
2937 for {} {$r < $row} {incr r} {
2938 set nextid [lindex $displayorder [expr {$r + 1}]]
2939 foreach p [lindex $parentlist $r] {
2940 if {$p eq $nextid} continue
2941 set rn [nextuse $p $r]
2942 if {$rn < 0 || $rn >= $row} {
2943 lappend ids [list $ordertok($curview,$p) $p]
2947 set id [lindex $displayorder $row]
2948 lappend ids [list $ordertok($curview,$id) $id]
2950 foreach p [lindex $parentlist $r] {
2951 set firstkid [lindex $children($curview,$p) 0]
2952 if {$commitrow($curview,$firstkid) < $row} {
2953 lappend ids [list $ordertok($curview,$p) $p]
2957 set id [lindex $displayorder $r]
2959 set firstkid [lindex $children($curview,$id) 0]
2960 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
2961 lappend ids [list $ordertok($curview,$id) $id]
2966 foreach idx [lsort -unique $ids] {
2967 lappend idlist [lindex $idx 1]
2972 proc rowsequal {a b} {
2973 while {[set i [lsearch -exact $a {}]] >= 0} {
2974 set a [lreplace $a $i $i]
2976 while {[set i [lsearch -exact $b {}]] >= 0} {
2977 set b [lreplace $b $i $i]
2979 return [expr {$a eq $b}]
2982 proc makeupline {id row rend col} {
2983 global rowidlist uparrowlen downarrowlen mingaplen
2985 for {set r $rend} {1} {set r $rstart} {
2986 set rstart [prevuse $id $r]
2987 if {$rstart < 0} return
2988 if {$rstart < $row} break
2990 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
2991 set rstart [expr {$rend - $uparrowlen - 1}]
2993 for {set r $rstart} {[incr r] <= $row} {} {
2994 set idlist [lindex $rowidlist $r]
2995 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
2996 set col [idcol $idlist $id $col]
2997 lset rowidlist $r [linsert $idlist $col $id]
3003 proc layoutrows {row endrow} {
3004 global rowidlist rowisopt rowfinal displayorder
3005 global uparrowlen downarrowlen maxwidth mingaplen
3006 global children parentlist
3007 global commitidx viewcomplete curview commitrow
3011 foreach id [lindex $rowidlist [expr {$row - 1}]] {
3017 for {} {$row < $endrow} {incr row} {
3018 set rm1 [expr {$row - 1}]
3019 if {$rm1 < 0 || [lindex $rowidlist $rm1] eq {}} {
3020 set idlist [make_idlist $row]
3023 set id [lindex $displayorder $rm1]
3024 set final [lindex $rowfinal $rm1]
3025 set col [lsearch -exact $idlist $id]
3026 set idlist [lreplace $idlist $col $col]
3027 foreach p [lindex $parentlist $rm1] {
3028 if {[lsearch -exact $idlist $p] < 0} {
3029 set col [idcol $idlist $p $col]
3030 set idlist [linsert $idlist $col $p]
3031 # if not the first child, we have to insert a line going up
3032 if {$id ne [lindex $children($curview,$p) 0]} {
3033 makeupline $p $rm1 $row $col
3037 set id [lindex $displayorder $row]
3038 if {$row > $downarrowlen} {
3039 set termrow [expr {$row - $downarrowlen - 1}]
3040 foreach p [lindex $parentlist $termrow] {
3041 set i [lsearch -exact $idlist $p]
3042 if {$i < 0} continue
3043 set nr [nextuse $p $termrow]
3044 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3045 set idlist [lreplace $idlist $i $i]
3049 set col [lsearch -exact $idlist $id]
3051 set col [idcol $idlist $id]
3052 set idlist [linsert $idlist $col $id]
3053 if {$children($curview,$id) ne {}} {
3054 makeupline $id $rm1 $row $col
3057 set r [expr {$row + $uparrowlen - 1}]
3058 if {$r < $commitidx($curview)} {
3060 foreach p [lindex $parentlist $r] {
3061 if {[lsearch -exact $idlist $p] >= 0} continue
3062 set fk [lindex $children($curview,$p) 0]
3063 if {$commitrow($curview,$fk) < $row} {
3064 set x [idcol $idlist $p $x]
3065 set idlist [linsert $idlist $x $p]
3068 if {[incr r] < $commitidx($curview)} {
3069 set p [lindex $displayorder $r]
3070 if {[lsearch -exact $idlist $p] < 0} {
3071 set fk [lindex $children($curview,$p) 0]
3072 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3073 set x [idcol $idlist $p $x]
3074 set idlist [linsert $idlist $x $p]
3080 if {$final && !$viewcomplete($curview) &&
3081 $row + $uparrowlen + $mingaplen + $downarrowlen
3082 >= $commitidx($curview)} {
3085 set l [llength $rowidlist]
3087 lappend rowidlist $idlist
3089 lappend rowfinal $final
3090 } elseif {$row < $l} {
3091 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3092 lset rowidlist $row $idlist
3093 lset rowfinal $row $final
3097 set pad [ntimes [expr {$row - $l}] {}]
3098 set rowidlist [concat $rowidlist $pad]
3099 lappend rowidlist $idlist
3100 set rowfinal [concat $rowfinal $pad]
3101 lappend rowfinal $final
3102 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3108 proc changedrow {row} {
3109 global displayorder iddrawn rowisopt need_redisplay
3111 set l [llength $rowisopt]
3113 lset rowisopt $row 0
3114 if {$row + 1 < $l} {
3115 lset rowisopt [expr {$row + 1}] 0
3116 if {$row + 2 < $l} {
3117 lset rowisopt [expr {$row + 2}] 0
3121 set id [lindex $displayorder $row]
3122 if {[info exists iddrawn($id)]} {
3123 set need_redisplay 1
3127 proc insert_pad {row col npad} {
3130 set pad [ntimes $npad {}]
3131 set idlist [lindex $rowidlist $row]
3132 set bef [lrange $idlist 0 [expr {$col - 1}]]
3133 set aft [lrange $idlist $col end]
3134 set i [lsearch -exact $aft {}]
3136 set aft [lreplace $aft $i $i]
3138 lset rowidlist $row [concat $bef $pad $aft]
3142 proc optimize_rows {row col endrow} {
3143 global rowidlist rowisopt displayorder curview children
3148 for {} {$row < $endrow} {incr row; set col 0} {
3149 if {[lindex $rowisopt $row]} continue
3151 set y0 [expr {$row - 1}]
3152 set ym [expr {$row - 2}]
3153 set idlist [lindex $rowidlist $row]
3154 set previdlist [lindex $rowidlist $y0]
3155 if {$idlist eq {} || $previdlist eq {}} continue
3157 set pprevidlist [lindex $rowidlist $ym]
3158 if {$pprevidlist eq {}} continue
3164 for {} {$col < [llength $idlist]} {incr col} {
3165 set id [lindex $idlist $col]
3166 if {[lindex $previdlist $col] eq $id} continue
3171 set x0 [lsearch -exact $previdlist $id]
3172 if {$x0 < 0} continue
3173 set z [expr {$x0 - $col}]
3177 set xm [lsearch -exact $pprevidlist $id]
3179 set z0 [expr {$xm - $x0}]
3183 # if row y0 is the first child of $id then it's not an arrow
3184 if {[lindex $children($curview,$id) 0] ne
3185 [lindex $displayorder $y0]} {
3189 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3190 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3193 # Looking at lines from this row to the previous row,
3194 # make them go straight up if they end in an arrow on
3195 # the previous row; otherwise make them go straight up
3197 if {$z < -1 || ($z < 0 && $isarrow)} {
3198 # Line currently goes left too much;
3199 # insert pads in the previous row, then optimize it
3200 set npad [expr {-1 - $z + $isarrow}]
3201 insert_pad $y0 $x0 $npad
3203 optimize_rows $y0 $x0 $row
3205 set previdlist [lindex $rowidlist $y0]
3206 set x0 [lsearch -exact $previdlist $id]
3207 set z [expr {$x0 - $col}]
3209 set pprevidlist [lindex $rowidlist $ym]
3210 set xm [lsearch -exact $pprevidlist $id]
3211 set z0 [expr {$xm - $x0}]
3213 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3214 # Line currently goes right too much;
3215 # insert pads in this line
3216 set npad [expr {$z - 1 + $isarrow}]
3217 insert_pad $row $col $npad
3218 set idlist [lindex $rowidlist $row]
3220 set z [expr {$x0 - $col}]
3223 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3224 # this line links to its first child on row $row-2
3225 set id [lindex $displayorder $ym]
3226 set xc [lsearch -exact $pprevidlist $id]
3228 set z0 [expr {$xc - $x0}]
3231 # avoid lines jigging left then immediately right
3232 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3233 insert_pad $y0 $x0 1
3235 optimize_rows $y0 $x0 $row
3236 set previdlist [lindex $rowidlist $y0]
3240 # Find the first column that doesn't have a line going right
3241 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3242 set id [lindex $idlist $col]
3243 if {$id eq {}} break
3244 set x0 [lsearch -exact $previdlist $id]
3246 # check if this is the link to the first child
3247 set kid [lindex $displayorder $y0]
3248 if {[lindex $children($curview,$id) 0] eq $kid} {
3249 # it is, work out offset to child
3250 set x0 [lsearch -exact $previdlist $kid]
3253 if {$x0 <= $col} break
3255 # Insert a pad at that column as long as it has a line and
3256 # isn't the last column
3257 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3258 set idlist [linsert $idlist $col {}]
3259 lset rowidlist $row $idlist
3267 global canvx0 linespc
3268 return [expr {$canvx0 + $col * $linespc}]
3272 global canvy0 linespc
3273 return [expr {$canvy0 + $row * $linespc}]
3276 proc linewidth {id} {
3277 global thickerline lthickness
3280 if {[info exists thickerline] && $id eq $thickerline} {
3281 set wid [expr {2 * $lthickness}]
3286 proc rowranges {id} {
3287 global commitrow curview children uparrowlen downarrowlen
3290 set kids $children($curview,$id)
3296 foreach child $kids {
3297 if {![info exists commitrow($curview,$child)]} break
3298 set row $commitrow($curview,$child)
3299 if {![info exists prev]} {
3300 lappend ret [expr {$row + 1}]
3302 if {$row <= $prevrow} {
3303 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3305 # see if the line extends the whole way from prevrow to row
3306 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3307 [lsearch -exact [lindex $rowidlist \
3308 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3309 # it doesn't, see where it ends
3310 set r [expr {$prevrow + $downarrowlen}]
3311 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3312 while {[incr r -1] > $prevrow &&
3313 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3315 while {[incr r] <= $row &&
3316 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3320 # see where it starts up again
3321 set r [expr {$row - $uparrowlen}]
3322 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3323 while {[incr r] < $row &&
3324 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3326 while {[incr r -1] >= $prevrow &&
3327 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3333 if {$child eq $id} {
3342 proc drawlineseg {id row endrow arrowlow} {
3343 global rowidlist displayorder iddrawn linesegs
3344 global canv colormap linespc curview maxlinelen parentlist
3346 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3347 set le [expr {$row + 1}]
3350 set c [lsearch -exact [lindex $rowidlist $le] $id]
3356 set x [lindex $displayorder $le]
3361 if {[info exists iddrawn($x)] || $le == $endrow} {
3362 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3378 if {[info exists linesegs($id)]} {
3379 set lines $linesegs($id)
3381 set r0 [lindex $li 0]
3383 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3393 set li [lindex $lines [expr {$i-1}]]
3394 set r1 [lindex $li 1]
3395 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3400 set x [lindex $cols [expr {$le - $row}]]
3401 set xp [lindex $cols [expr {$le - 1 - $row}]]
3402 set dir [expr {$xp - $x}]
3404 set ith [lindex $lines $i 2]
3405 set coords [$canv coords $ith]
3406 set ah [$canv itemcget $ith -arrow]
3407 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3408 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3409 if {$x2 ne {} && $x - $x2 == $dir} {
3410 set coords [lrange $coords 0 end-2]
3413 set coords [list [xc $le $x] [yc $le]]
3416 set itl [lindex $lines [expr {$i-1}] 2]
3417 set al [$canv itemcget $itl -arrow]
3418 set arrowlow [expr {$al eq "last" || $al eq "both"}]
3419 } elseif {$arrowlow} {
3420 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3421 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3425 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3426 for {set y $le} {[incr y -1] > $row} {} {
3428 set xp [lindex $cols [expr {$y - 1 - $row}]]
3429 set ndir [expr {$xp - $x}]
3430 if {$dir != $ndir || $xp < 0} {
3431 lappend coords [xc $y $x] [yc $y]
3437 # join parent line to first child
3438 set ch [lindex $displayorder $row]
3439 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3441 puts "oops: drawlineseg: child $ch not on row $row"
3442 } elseif {$xc != $x} {
3443 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3444 set d [expr {int(0.5 * $linespc)}]
3447 set x2 [expr {$x1 - $d}]
3449 set x2 [expr {$x1 + $d}]
3452 set y1 [expr {$y2 + $d}]
3453 lappend coords $x1 $y1 $x2 $y2
3454 } elseif {$xc < $x - 1} {
3455 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3456 } elseif {$xc > $x + 1} {
3457 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3461 lappend coords [xc $row $x] [yc $row]
3463 set xn [xc $row $xp]
3465 lappend coords $xn $yn
3469 set t [$canv create line $coords -width [linewidth $id] \
3470 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3473 set lines [linsert $lines $i [list $row $le $t]]
3475 $canv coords $ith $coords
3476 if {$arrow ne $ah} {
3477 $canv itemconf $ith -arrow $arrow
3479 lset lines $i 0 $row
3482 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3483 set ndir [expr {$xo - $xp}]
3484 set clow [$canv coords $itl]
3485 if {$dir == $ndir} {
3486 set clow [lrange $clow 2 end]
3488 set coords [concat $coords $clow]
3490 lset lines [expr {$i-1}] 1 $le
3492 # coalesce two pieces
3494 set b [lindex $lines [expr {$i-1}] 0]
3495 set e [lindex $lines $i 1]
3496 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3498 $canv coords $itl $coords
3499 if {$arrow ne $al} {
3500 $canv itemconf $itl -arrow $arrow
3504 set linesegs($id) $lines
3508 proc drawparentlinks {id row} {
3509 global rowidlist canv colormap curview parentlist
3510 global idpos linespc
3512 set rowids [lindex $rowidlist $row]
3513 set col [lsearch -exact $rowids $id]
3514 if {$col < 0} return
3515 set olds [lindex $parentlist $row]
3516 set row2 [expr {$row + 1}]
3517 set x [xc $row $col]
3520 set d [expr {int(0.5 * $linespc)}]
3521 set ymid [expr {$y + $d}]
3522 set ids [lindex $rowidlist $row2]
3523 # rmx = right-most X coord used
3526 set i [lsearch -exact $ids $p]
3528 puts "oops, parent $p of $id not in list"
3531 set x2 [xc $row2 $i]
3535 set j [lsearch -exact $rowids $p]
3537 # drawlineseg will do this one for us
3541 # should handle duplicated parents here...
3542 set coords [list $x $y]
3544 # if attaching to a vertical segment, draw a smaller
3545 # slant for visual distinctness
3548 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3550 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3552 } elseif {$i < $col && $i < $j} {
3553 # segment slants towards us already
3554 lappend coords [xc $row $j] $y
3556 if {$i < $col - 1} {
3557 lappend coords [expr {$x2 + $linespc}] $y
3558 } elseif {$i > $col + 1} {
3559 lappend coords [expr {$x2 - $linespc}] $y
3561 lappend coords $x2 $y2
3564 lappend coords $x2 $y2
3566 set t [$canv create line $coords -width [linewidth $p] \
3567 -fill $colormap($p) -tags lines.$p]
3571 if {$rmx > [lindex $idpos($id) 1]} {
3572 lset idpos($id) 1 $rmx
3577 proc drawlines {id} {
3580 $canv itemconf lines.$id -width [linewidth $id]
3583 proc drawcmittext {id row col} {
3584 global linespc canv canv2 canv3 canvy0 fgcolor curview
3585 global commitlisted commitinfo rowidlist parentlist
3586 global rowtextx idpos idtags idheads idotherrefs
3587 global linehtag linentag linedtag selectedline
3588 global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3590 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3591 set listed [lindex $commitlisted $row]
3592 if {$id eq $nullid} {
3594 } elseif {$id eq $nullid2} {
3597 set ofill [expr {$listed != 0? "blue": "white"}]
3599 set x [xc $row $col]
3601 set orad [expr {$linespc / 3}]
3603 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3604 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3605 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3606 } elseif {$listed == 2} {
3607 # triangle pointing left for left-side commits
3608 set t [$canv create polygon \
3609 [expr {$x - $orad}] $y \
3610 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3611 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3612 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3614 # triangle pointing right for right-side commits
3615 set t [$canv create polygon \
3616 [expr {$x + $orad - 1}] $y \
3617 [expr {$x - $orad}] [expr {$y - $orad}] \
3618 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3619 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3622 $canv bind $t <1> {selcanvline {} %x %y}
3623 set rmx [llength [lindex $rowidlist $row]]
3624 set olds [lindex $parentlist $row]
3626 set nextids [lindex $rowidlist [expr {$row + 1}]]
3628 set i [lsearch -exact $nextids $p]
3634 set xt [xc $row $rmx]
3635 set rowtextx($row) $xt
3636 set idpos($id) [list $x $xt $y]
3637 if {[info exists idtags($id)] || [info exists idheads($id)]
3638 || [info exists idotherrefs($id)]} {
3639 set xt [drawtags $id $x $xt $y]
3641 set headline [lindex $commitinfo($id) 0]
3642 set name [lindex $commitinfo($id) 1]
3643 set date [lindex $commitinfo($id) 2]
3644 set date [formatdate $date]
3647 set isbold [ishighlighted $row]
3649 lappend boldrows $row
3652 lappend boldnamerows $row
3656 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3657 -text $headline -font $font -tags text]
3658 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3659 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3660 -text $name -font $nfont -tags text]
3661 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3662 -text $date -font $mainfont -tags text]
3663 if {[info exists selectedline] && $selectedline == $row} {
3666 set xr [expr {$xt + [font measure $mainfont $headline]}]
3667 if {$xr > $canvxmax} {
3673 proc drawcmitrow {row} {
3674 global displayorder rowidlist nrows_drawn
3675 global iddrawn markingmatches
3676 global commitinfo parentlist numcommits
3677 global filehighlight fhighlights findstring nhighlights
3678 global hlview vhighlights
3679 global highlight_related rhighlights
3681 if {$row >= $numcommits} return
3683 set id [lindex $displayorder $row]
3684 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3685 askvhighlight $row $id
3687 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3688 askfilehighlight $row $id
3690 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3691 askfindhighlight $row $id
3693 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3694 askrelhighlight $row $id
3696 if {![info exists iddrawn($id)]} {
3697 set col [lsearch -exact [lindex $rowidlist $row] $id]
3699 puts "oops, row $row id $id not in list"
3702 if {![info exists commitinfo($id)]} {
3706 drawcmittext $id $row $col
3710 if {$markingmatches} {
3711 markrowmatches $row $id
3715 proc drawcommits {row {endrow {}}} {
3716 global numcommits iddrawn displayorder curview need_redisplay
3717 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3722 if {$endrow eq {}} {
3725 if {$endrow >= $numcommits} {
3726 set endrow [expr {$numcommits - 1}]
3729 set rl1 [expr {$row - $downarrowlen - 3}]
3733 set ro1 [expr {$row - 3}]
3737 set r2 [expr {$endrow + $uparrowlen + 3}]
3738 if {$r2 > $numcommits} {
3741 for {set r $rl1} {$r < $r2} {incr r} {
3742 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3746 set rl1 [expr {$r + 1}]
3752 optimize_rows $ro1 0 $r2
3753 if {$need_redisplay || $nrows_drawn > 2000} {
3758 # make the lines join to already-drawn rows either side
3759 set r [expr {$row - 1}]
3760 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3763 set er [expr {$endrow + 1}]
3764 if {$er >= $numcommits ||
3765 ![info exists iddrawn([lindex $displayorder $er])]} {
3768 for {} {$r <= $er} {incr r} {
3769 set id [lindex $displayorder $r]
3770 set wasdrawn [info exists iddrawn($id)]
3772 if {$r == $er} break
3773 set nextid [lindex $displayorder [expr {$r + 1}]]
3774 if {$wasdrawn && [info exists iddrawn($nextid)]} {
3775 catch {unset prevlines}
3778 drawparentlinks $id $r
3780 if {[info exists lineends($r)]} {
3781 foreach lid $lineends($r) {
3782 unset prevlines($lid)
3785 set rowids [lindex $rowidlist $r]
3786 foreach lid $rowids {
3787 if {$lid eq {}} continue
3789 # see if this is the first child of any of its parents
3790 foreach p [lindex $parentlist $r] {
3791 if {[lsearch -exact $rowids $p] < 0} {
3792 # make this line extend up to the child
3793 set le [drawlineseg $p $r $er 0]
3794 lappend lineends($le) $p
3798 } elseif {![info exists prevlines($lid)]} {
3799 set le [drawlineseg $lid $r $er 1]
3800 lappend lineends($le) $lid
3801 set prevlines($lid) 1
3807 proc drawfrac {f0 f1} {
3810 set ymax [lindex [$canv cget -scrollregion] 3]
3811 if {$ymax eq {} || $ymax == 0} return
3812 set y0 [expr {int($f0 * $ymax)}]
3813 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3814 set y1 [expr {int($f1 * $ymax)}]
3815 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3816 drawcommits $row $endrow
3819 proc drawvisible {} {
3821 eval drawfrac [$canv yview]
3824 proc clear_display {} {
3825 global iddrawn linesegs need_redisplay nrows_drawn
3826 global vhighlights fhighlights nhighlights rhighlights
3829 catch {unset iddrawn}
3830 catch {unset linesegs}
3831 catch {unset vhighlights}
3832 catch {unset fhighlights}
3833 catch {unset nhighlights}
3834 catch {unset rhighlights}
3835 set need_redisplay 0
3839 proc findcrossings {id} {
3840 global rowidlist parentlist numcommits displayorder
3844 foreach {s e} [rowranges $id] {
3845 if {$e >= $numcommits} {
3846 set e [expr {$numcommits - 1}]
3848 if {$e <= $s} continue
3849 for {set row $e} {[incr row -1] >= $s} {} {
3850 set x [lsearch -exact [lindex $rowidlist $row] $id]
3852 set olds [lindex $parentlist $row]
3853 set kid [lindex $displayorder $row]
3854 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3855 if {$kidx < 0} continue
3856 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3858 set px [lsearch -exact $nextrow $p]
3859 if {$px < 0} continue
3860 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3861 if {[lsearch -exact $ccross $p] >= 0} continue
3862 if {$x == $px + ($kidx < $px? -1: 1)} {
3864 } elseif {[lsearch -exact $cross $p] < 0} {
3871 return [concat $ccross {{}} $cross]
3874 proc assigncolor {id} {
3875 global colormap colors nextcolor
3876 global commitrow parentlist children children curview
3878 if {[info exists colormap($id)]} return
3879 set ncolors [llength $colors]
3880 if {[info exists children($curview,$id)]} {
3881 set kids $children($curview,$id)
3885 if {[llength $kids] == 1} {
3886 set child [lindex $kids 0]
3887 if {[info exists colormap($child)]
3888 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3889 set colormap($id) $colormap($child)
3895 foreach x [findcrossings $id] {
3897 # delimiter between corner crossings and other crossings
3898 if {[llength $badcolors] >= $ncolors - 1} break
3899 set origbad $badcolors
3901 if {[info exists colormap($x)]
3902 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3903 lappend badcolors $colormap($x)
3906 if {[llength $badcolors] >= $ncolors} {
3907 set badcolors $origbad
3909 set origbad $badcolors
3910 if {[llength $badcolors] < $ncolors - 1} {
3911 foreach child $kids {
3912 if {[info exists colormap($child)]
3913 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3914 lappend badcolors $colormap($child)
3916 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3917 if {[info exists colormap($p)]
3918 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3919 lappend badcolors $colormap($p)
3923 if {[llength $badcolors] >= $ncolors} {
3924 set badcolors $origbad
3927 for {set i 0} {$i <= $ncolors} {incr i} {
3928 set c [lindex $colors $nextcolor]
3929 if {[incr nextcolor] >= $ncolors} {
3932 if {[lsearch -exact $badcolors $c]} break
3934 set colormap($id) $c
3937 proc bindline {t id} {
3940 $canv bind $t <Enter> "lineenter %x %y $id"
3941 $canv bind $t <Motion> "linemotion %x %y $id"
3942 $canv bind $t <Leave> "lineleave $id"
3943 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3946 proc drawtags {id x xt y1} {
3947 global idtags idheads idotherrefs mainhead
3948 global linespc lthickness
3949 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3954 if {[info exists idtags($id)]} {
3955 set marks $idtags($id)
3956 set ntags [llength $marks]
3958 if {[info exists idheads($id)]} {
3959 set marks [concat $marks $idheads($id)]
3960 set nheads [llength $idheads($id)]
3962 if {[info exists idotherrefs($id)]} {
3963 set marks [concat $marks $idotherrefs($id)]
3969 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3970 set yt [expr {$y1 - 0.5 * $linespc}]
3971 set yb [expr {$yt + $linespc - 1}]
3975 foreach tag $marks {
3977 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3978 set wid [font measure [concat $mainfont bold] $tag]
3980 set wid [font measure $mainfont $tag]
3984 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3986 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3987 -width $lthickness -fill black -tags tag.$id]
3989 foreach tag $marks x $xvals wid $wvals {
3990 set xl [expr {$x + $delta}]
3991 set xr [expr {$x + $delta + $wid + $lthickness}]
3993 if {[incr ntags -1] >= 0} {
3995 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3996 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3997 -width 1 -outline black -fill yellow -tags tag.$id]
3998 $canv bind $t <1> [list showtag $tag 1]
3999 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4001 # draw a head or other ref
4002 if {[incr nheads -1] >= 0} {
4004 if {$tag eq $mainhead} {
4010 set xl [expr {$xl - $delta/2}]
4011 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4012 -width 1 -outline black -fill $col -tags tag.$id
4013 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4014 set rwid [font measure $mainfont $remoteprefix]
4015 set xi [expr {$x + 1}]
4016 set yti [expr {$yt + 1}]
4017 set xri [expr {$x + $rwid}]
4018 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4019 -width 0 -fill "#ffddaa" -tags tag.$id
4022 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4023 -font $font -tags [list tag.$id text]]
4025 $canv bind $t <1> [list showtag $tag 1]
4026 } elseif {$nheads >= 0} {
4027 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4033 proc xcoord {i level ln} {
4034 global canvx0 xspc1 xspc2
4036 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4037 if {$i > 0 && $i == $level} {
4038 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4039 } elseif {$i > $level} {
4040 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4045 proc show_status {msg} {
4046 global canv mainfont fgcolor
4049 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
4050 -tags text -fill $fgcolor
4053 # Insert a new commit as the child of the commit on row $row.
4054 # The new commit will be displayed on row $row and the commits
4055 # on that row and below will move down one row.
4056 proc insertrow {row newcmit} {
4057 global displayorder parentlist commitlisted children
4058 global commitrow curview rowidlist rowisopt numcommits
4060 global selectedline commitidx ordertok
4062 if {$row >= $numcommits} {
4063 puts "oops, inserting new row $row but only have $numcommits rows"
4066 set p [lindex $displayorder $row]
4067 set displayorder [linsert $displayorder $row $newcmit]
4068 set parentlist [linsert $parentlist $row $p]
4069 set kids $children($curview,$p)
4070 lappend kids $newcmit
4071 set children($curview,$p) $kids
4072 set children($curview,$newcmit) {}
4073 set commitlisted [linsert $commitlisted $row 1]
4074 set l [llength $displayorder]
4075 for {set r $row} {$r < $l} {incr r} {
4076 set id [lindex $displayorder $r]
4077 set commitrow($curview,$id) $r
4079 incr commitidx($curview)
4080 set ordertok($curview,$newcmit) $ordertok($curview,$p)
4082 set idlist [lindex $rowidlist $row]
4083 if {[llength $kids] == 1} {
4084 set col [lsearch -exact $idlist $p]
4085 lset idlist $col $newcmit
4087 set col [llength $idlist]
4088 lappend idlist $newcmit
4090 set rowidlist [linsert $rowidlist $row $idlist]
4091 set rowisopt [linsert $rowisopt $row 0]
4095 if {[info exists selectedline] && $selectedline >= $row} {
4101 # Remove a commit that was inserted with insertrow on row $row.
4102 proc removerow {row} {
4103 global displayorder parentlist commitlisted children
4104 global commitrow curview rowidlist rowisopt numcommits
4106 global linesegends selectedline commitidx
4108 if {$row >= $numcommits} {
4109 puts "oops, removing row $row but only have $numcommits rows"
4112 set rp1 [expr {$row + 1}]
4113 set id [lindex $displayorder $row]
4114 set p [lindex $parentlist $row]
4115 set displayorder [lreplace $displayorder $row $row]
4116 set parentlist [lreplace $parentlist $row $row]
4117 set commitlisted [lreplace $commitlisted $row $row]
4118 set kids $children($curview,$p)
4119 set i [lsearch -exact $kids $id]
4121 set kids [lreplace $kids $i $i]
4122 set children($curview,$p) $kids
4124 set l [llength $displayorder]
4125 for {set r $row} {$r < $l} {incr r} {
4126 set id [lindex $displayorder $r]
4127 set commitrow($curview,$id) $r
4129 incr commitidx($curview) -1
4131 set rowidlist [lreplace $rowidlist $row $row]
4132 set rowisopt [lreplace $rowisopt $row $row]
4136 if {[info exists selectedline] && $selectedline > $row} {
4137 incr selectedline -1
4142 # Don't change the text pane cursor if it is currently the hand cursor,
4143 # showing that we are over a sha1 ID link.
4144 proc settextcursor {c} {
4145 global ctext curtextcursor
4147 if {[$ctext cget -cursor] == $curtextcursor} {
4148 $ctext config -cursor $c
4150 set curtextcursor $c
4153 proc nowbusy {what} {
4156 if {[array names isbusy] eq {}} {
4157 . config -cursor watch
4163 proc notbusy {what} {
4164 global isbusy maincursor textcursor
4166 catch {unset isbusy($what)}
4167 if {[array names isbusy] eq {}} {
4168 . config -cursor $maincursor
4169 settextcursor $textcursor
4173 proc findmatches {f} {
4174 global findtype findstring
4175 if {$findtype == "Regexp"} {
4176 set matches [regexp -indices -all -inline $findstring $f]
4179 if {$findtype == "IgnCase"} {
4180 set f [string tolower $f]
4181 set fs [string tolower $fs]
4185 set l [string length $fs]
4186 while {[set j [string first $fs $f $i]] >= 0} {
4187 lappend matches [list $j [expr {$j+$l-1}]]
4188 set i [expr {$j + $l}]
4194 proc dofind {{rev 0}} {
4195 global findstring findstartline findcurline selectedline numcommits
4198 cancel_next_highlight
4200 if {$findstring eq {} || $numcommits == 0} return
4201 if {![info exists selectedline]} {
4202 set findstartline [lindex [visiblerows] $rev]
4204 set findstartline $selectedline
4206 set findcurline $findstartline
4211 if {$findcurline == 0} {
4212 set findcurline $numcommits
4219 proc findnext {restart} {
4221 if {![info exists findcurline]} {
4235 if {![info exists findcurline]} {
4244 global commitdata commitinfo numcommits findstring findpattern findloc
4245 global findstartline findcurline displayorder
4247 set fldtypes {Headline Author Date Committer CDate Comments}
4248 set l [expr {$findcurline + 1}]
4249 if {$l >= $numcommits} {
4252 if {$l <= $findstartline} {
4253 set lim [expr {$findstartline + 1}]
4257 if {$lim - $l > 500} {
4258 set lim [expr {$l + 500}]
4261 for {} {$l < $lim} {incr l} {
4262 set id [lindex $displayorder $l]
4263 # shouldn't happen unless git log doesn't give all the commits...
4264 if {![info exists commitdata($id)]} continue
4265 if {![doesmatch $commitdata($id)]} continue
4266 if {![info exists commitinfo($id)]} {
4269 set info $commitinfo($id)
4270 foreach f $info ty $fldtypes {
4271 if {($findloc eq "All fields" || $findloc eq $ty) &&
4279 if {$l == $findstartline + 1} {
4285 set findcurline [expr {$l - 1}]
4289 proc findmorerev {} {
4290 global commitdata commitinfo numcommits findstring findpattern findloc
4291 global findstartline findcurline displayorder
4293 set fldtypes {Headline Author Date Committer CDate Comments}
4299 if {$l >= $findstartline} {
4300 set lim [expr {$findstartline - 1}]
4304 if {$l - $lim > 500} {
4305 set lim [expr {$l - 500}]
4308 for {} {$l > $lim} {incr l -1} {
4309 set id [lindex $displayorder $l]
4310 if {![info exists commitdata($id)]} continue
4311 if {![doesmatch $commitdata($id)]} continue
4312 if {![info exists commitinfo($id)]} {
4315 set info $commitinfo($id)
4316 foreach f $info ty $fldtypes {
4317 if {($findloc eq "All fields" || $findloc eq $ty) &&
4331 set findcurline [expr {$l + 1}]
4335 proc findselectline {l} {
4336 global findloc commentend ctext findcurline markingmatches
4338 set markingmatches 1
4341 if {$findloc == "All fields" || $findloc == "Comments"} {
4342 # highlight the matches in the comments
4343 set f [$ctext get 1.0 $commentend]
4344 set matches [findmatches $f]
4345 foreach match $matches {
4346 set start [lindex $match 0]
4347 set end [expr {[lindex $match 1] + 1}]
4348 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4354 # mark the bits of a headline or author that match a find string
4355 proc markmatches {canv l str tag matches font row} {
4358 set bbox [$canv bbox $tag]
4359 set x0 [lindex $bbox 0]
4360 set y0 [lindex $bbox 1]
4361 set y1 [lindex $bbox 3]
4362 foreach match $matches {
4363 set start [lindex $match 0]
4364 set end [lindex $match 1]
4365 if {$start > $end} continue
4366 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4367 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4368 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4369 [expr {$x0+$xlen+2}] $y1 \
4370 -outline {} -tags [list match$l matches] -fill yellow]
4372 if {[info exists selectedline] && $row == $selectedline} {
4373 $canv raise $t secsel
4378 proc unmarkmatches {} {
4379 global findids markingmatches findcurline
4381 allcanvs delete matches
4382 catch {unset findids}
4383 set markingmatches 0
4384 catch {unset findcurline}
4387 proc selcanvline {w x y} {
4388 global canv canvy0 ctext linespc
4390 set ymax [lindex [$canv cget -scrollregion] 3]
4391 if {$ymax == {}} return
4392 set yfrac [lindex [$canv yview] 0]
4393 set y [expr {$y + $yfrac * $ymax}]
4394 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4399 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4405 proc commit_descriptor {p} {
4407 if {![info exists commitinfo($p)]} {
4411 if {[llength $commitinfo($p)] > 1} {
4412 set l [lindex $commitinfo($p) 0]
4417 # append some text to the ctext widget, and make any SHA1 ID
4418 # that we know about be a clickable link.
4419 proc appendwithlinks {text tags} {
4420 global ctext commitrow linknum curview pendinglinks
4422 set start [$ctext index "end - 1c"]
4423 $ctext insert end $text $tags
4424 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4428 set linkid [string range $text $s $e]
4430 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4431 setlink $linkid link$linknum
4436 proc setlink {id lk} {
4437 global curview commitrow ctext pendinglinks commitinterest
4439 if {[info exists commitrow($curview,$id)]} {
4440 $ctext tag conf $lk -foreground blue -underline 1
4441 $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4442 $ctext tag bind $lk <Enter> {linkcursor %W 1}
4443 $ctext tag bind $lk <Leave> {linkcursor %W -1}
4445 lappend pendinglinks($id) $lk
4446 lappend commitinterest($id) {makelink %I}
4450 proc makelink {id} {
4453 if {![info exists pendinglinks($id)]} return
4454 foreach lk $pendinglinks($id) {
4457 unset pendinglinks($id)
4460 proc linkcursor {w inc} {
4461 global linkentercount curtextcursor
4463 if {[incr linkentercount $inc] > 0} {
4464 $w configure -cursor hand2
4466 $w configure -cursor $curtextcursor
4467 if {$linkentercount < 0} {
4468 set linkentercount 0
4473 proc viewnextline {dir} {
4477 set ymax [lindex [$canv cget -scrollregion] 3]
4478 set wnow [$canv yview]
4479 set wtop [expr {[lindex $wnow 0] * $ymax}]
4480 set newtop [expr {$wtop + $dir * $linespc}]
4483 } elseif {$newtop > $ymax} {
4486 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4489 # add a list of tag or branch names at position pos
4490 # returns the number of names inserted
4491 proc appendrefs {pos ids var} {
4492 global ctext commitrow linknum curview $var maxrefs
4494 if {[catch {$ctext index $pos}]} {
4497 $ctext conf -state normal
4498 $ctext delete $pos "$pos lineend"
4501 foreach tag [set $var\($id\)] {
4502 lappend tags [list $tag $id]
4505 if {[llength $tags] > $maxrefs} {
4506 $ctext insert $pos "many ([llength $tags])"
4508 set tags [lsort -index 0 -decreasing $tags]
4511 set id [lindex $ti 1]
4514 $ctext tag delete $lk
4515 $ctext insert $pos $sep
4516 $ctext insert $pos [lindex $ti 0] $lk
4521 $ctext conf -state disabled
4522 return [llength $tags]
4525 # called when we have finished computing the nearby tags
4526 proc dispneartags {delay} {
4527 global selectedline currentid showneartags tagphase
4529 if {![info exists selectedline] || !$showneartags} return
4530 after cancel dispnexttag
4532 after 200 dispnexttag
4535 after idle dispnexttag
4540 proc dispnexttag {} {
4541 global selectedline currentid showneartags tagphase ctext
4543 if {![info exists selectedline] || !$showneartags} return
4544 switch -- $tagphase {
4546 set dtags [desctags $currentid]
4548 appendrefs precedes $dtags idtags
4552 set atags [anctags $currentid]
4554 appendrefs follows $atags idtags
4558 set dheads [descheads $currentid]
4559 if {$dheads ne {}} {
4560 if {[appendrefs branch $dheads idheads] > 1
4561 && [$ctext get "branch -3c"] eq "h"} {
4562 # turn "Branch" into "Branches"
4563 $ctext conf -state normal
4564 $ctext insert "branch -2c" "es"
4565 $ctext conf -state disabled
4570 if {[incr tagphase] <= 2} {
4571 after idle dispnexttag
4575 proc make_secsel {l} {
4576 global linehtag linentag linedtag canv canv2 canv3
4578 if {![info exists linehtag($l)]} return
4580 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4581 -tags secsel -fill [$canv cget -selectbackground]]
4583 $canv2 delete secsel
4584 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4585 -tags secsel -fill [$canv2 cget -selectbackground]]
4587 $canv3 delete secsel
4588 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4589 -tags secsel -fill [$canv3 cget -selectbackground]]
4593 proc selectline {l isnew} {
4594 global canv ctext commitinfo selectedline
4596 global canvy0 linespc parentlist children curview
4597 global currentid sha1entry
4598 global commentend idtags linknum
4599 global mergemax numcommits pending_select
4600 global cmitmode showneartags allcommits
4602 catch {unset pending_select}
4605 cancel_next_highlight
4607 if {$l < 0 || $l >= $numcommits} return
4608 set y [expr {$canvy0 + $l * $linespc}]
4609 set ymax [lindex [$canv cget -scrollregion] 3]
4610 set ytop [expr {$y - $linespc - 1}]
4611 set ybot [expr {$y + $linespc + 1}]
4612 set wnow [$canv yview]
4613 set wtop [expr {[lindex $wnow 0] * $ymax}]
4614 set wbot [expr {[lindex $wnow 1] * $ymax}]
4615 set wh [expr {$wbot - $wtop}]
4617 if {$ytop < $wtop} {
4618 if {$ybot < $wtop} {
4619 set newtop [expr {$y - $wh / 2.0}]
4622 if {$newtop > $wtop - $linespc} {
4623 set newtop [expr {$wtop - $linespc}]
4626 } elseif {$ybot > $wbot} {
4627 if {$ytop > $wbot} {
4628 set newtop [expr {$y - $wh / 2.0}]
4630 set newtop [expr {$ybot - $wh}]
4631 if {$newtop < $wtop + $linespc} {
4632 set newtop [expr {$wtop + $linespc}]
4636 if {$newtop != $wtop} {
4640 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4647 addtohistory [list selectline $l 0]
4652 set id [lindex $displayorder $l]
4654 $sha1entry delete 0 end
4655 $sha1entry insert 0 $id
4656 $sha1entry selection from 0
4657 $sha1entry selection to end
4660 $ctext conf -state normal
4663 set info $commitinfo($id)
4664 set date [formatdate [lindex $info 2]]
4665 $ctext insert end "Author: [lindex $info 1] $date\n"
4666 set date [formatdate [lindex $info 4]]
4667 $ctext insert end "Committer: [lindex $info 3] $date\n"
4668 if {[info exists idtags($id)]} {
4669 $ctext insert end "Tags:"
4670 foreach tag $idtags($id) {
4671 $ctext insert end " $tag"
4673 $ctext insert end "\n"
4677 set olds [lindex $parentlist $l]
4678 if {[llength $olds] > 1} {
4681 if {$np >= $mergemax} {
4686 $ctext insert end "Parent: " $tag
4687 appendwithlinks [commit_descriptor $p] {}
4692 append headers "Parent: [commit_descriptor $p]"
4696 foreach c $children($curview,$id) {
4697 append headers "Child: [commit_descriptor $c]"
4700 # make anything that looks like a SHA1 ID be a clickable link
4701 appendwithlinks $headers {}
4702 if {$showneartags} {
4703 if {![info exists allcommits]} {
4706 $ctext insert end "Branch: "
4707 $ctext mark set branch "end -1c"
4708 $ctext mark gravity branch left
4709 $ctext insert end "\nFollows: "
4710 $ctext mark set follows "end -1c"
4711 $ctext mark gravity follows left
4712 $ctext insert end "\nPrecedes: "
4713 $ctext mark set precedes "end -1c"
4714 $ctext mark gravity precedes left
4715 $ctext insert end "\n"
4718 $ctext insert end "\n"
4719 set comment [lindex $info 5]
4720 if {[string first "\r" $comment] >= 0} {
4721 set comment [string map {"\r" "\n "} $comment]
4723 appendwithlinks $comment {comment}
4725 $ctext tag remove found 1.0 end
4726 $ctext conf -state disabled
4727 set commentend [$ctext index "end - 1c"]
4729 init_flist "Comments"
4730 if {$cmitmode eq "tree"} {
4732 } elseif {[llength $olds] <= 1} {
4739 proc selfirstline {} {
4744 proc sellastline {} {
4747 set l [expr {$numcommits - 1}]
4751 proc selnextline {dir} {
4754 if {![info exists selectedline]} return
4755 set l [expr {$selectedline + $dir}]
4760 proc selnextpage {dir} {
4761 global canv linespc selectedline numcommits
4763 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4767 allcanvs yview scroll [expr {$dir * $lpp}] units
4769 if {![info exists selectedline]} return
4770 set l [expr {$selectedline + $dir * $lpp}]
4773 } elseif {$l >= $numcommits} {
4774 set l [expr $numcommits - 1]
4780 proc unselectline {} {
4781 global selectedline currentid
4783 catch {unset selectedline}
4784 catch {unset currentid}
4785 allcanvs delete secsel
4787 cancel_next_highlight
4790 proc reselectline {} {
4793 if {[info exists selectedline]} {
4794 selectline $selectedline 0
4798 proc addtohistory {cmd} {
4799 global history historyindex curview
4801 set elt [list $curview $cmd]
4802 if {$historyindex > 0
4803 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4807 if {$historyindex < [llength $history]} {
4808 set history [lreplace $history $historyindex end $elt]
4810 lappend history $elt
4813 if {$historyindex > 1} {
4814 .tf.bar.leftbut conf -state normal
4816 .tf.bar.leftbut conf -state disabled
4818 .tf.bar.rightbut conf -state disabled
4824 set view [lindex $elt 0]
4825 set cmd [lindex $elt 1]
4826 if {$curview != $view} {
4833 global history historyindex
4836 if {$historyindex > 1} {
4837 incr historyindex -1
4838 godo [lindex $history [expr {$historyindex - 1}]]
4839 .tf.bar.rightbut conf -state normal
4841 if {$historyindex <= 1} {
4842 .tf.bar.leftbut conf -state disabled
4847 global history historyindex
4850 if {$historyindex < [llength $history]} {
4851 set cmd [lindex $history $historyindex]
4854 .tf.bar.leftbut conf -state normal
4856 if {$historyindex >= [llength $history]} {
4857 .tf.bar.rightbut conf -state disabled
4862 global treefilelist treeidlist diffids diffmergeid treepending
4863 global nullid nullid2
4866 catch {unset diffmergeid}
4867 if {![info exists treefilelist($id)]} {
4868 if {![info exists treepending]} {
4869 if {$id eq $nullid} {
4870 set cmd [list | git ls-files]
4871 } elseif {$id eq $nullid2} {
4872 set cmd [list | git ls-files --stage -t]
4874 set cmd [list | git ls-tree -r $id]
4876 if {[catch {set gtf [open $cmd r]}]} {
4880 set treefilelist($id) {}
4881 set treeidlist($id) {}
4882 fconfigure $gtf -blocking 0
4883 filerun $gtf [list gettreeline $gtf $id]
4890 proc gettreeline {gtf id} {
4891 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4894 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4895 if {$diffids eq $nullid} {
4898 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4899 set i [string first "\t" $line]
4900 if {$i < 0} continue
4901 set sha1 [lindex $line 2]
4902 set fname [string range $line [expr {$i+1}] end]
4903 if {[string index $fname 0] eq "\""} {
4904 set fname [lindex $fname 0]
4906 lappend treeidlist($id) $sha1
4908 lappend treefilelist($id) $fname
4911 return [expr {$nl >= 1000? 2: 1}]
4915 if {$cmitmode ne "tree"} {
4916 if {![info exists diffmergeid]} {
4917 gettreediffs $diffids
4919 } elseif {$id ne $diffids} {
4928 global treefilelist treeidlist diffids nullid nullid2
4929 global ctext commentend
4931 set i [lsearch -exact $treefilelist($diffids) $f]
4933 puts "oops, $f not in list for id $diffids"
4936 if {$diffids eq $nullid} {
4937 if {[catch {set bf [open $f r]} err]} {
4938 puts "oops, can't read $f: $err"
4942 set blob [lindex $treeidlist($diffids) $i]
4943 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4944 puts "oops, error reading blob $blob: $err"
4948 fconfigure $bf -blocking 0
4949 filerun $bf [list getblobline $bf $diffids]
4950 $ctext config -state normal
4951 clear_ctext $commentend
4952 $ctext insert end "\n"
4953 $ctext insert end "$f\n" filesep
4954 $ctext config -state disabled
4955 $ctext yview $commentend
4958 proc getblobline {bf id} {
4959 global diffids cmitmode ctext
4961 if {$id ne $diffids || $cmitmode ne "tree"} {
4965 $ctext config -state normal
4967 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4968 $ctext insert end "$line\n"
4971 # delete last newline
4972 $ctext delete "end - 2c" "end - 1c"
4976 $ctext config -state disabled
4977 return [expr {$nl >= 1000? 2: 1}]
4980 proc mergediff {id l} {
4981 global diffmergeid diffopts mdifffd
4987 # this doesn't seem to actually affect anything...
4988 set env(GIT_DIFF_OPTS) $diffopts
4989 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4990 if {[catch {set mdf [open $cmd r]} err]} {
4991 error_popup "Error getting merge diffs: $err"
4994 fconfigure $mdf -blocking 0
4995 set mdifffd($id) $mdf
4996 set np [llength [lindex $parentlist $l]]
4997 filerun $mdf [list getmergediffline $mdf $id $np]
5000 proc getmergediffline {mdf id np} {
5001 global diffmergeid ctext cflist mergemax
5002 global difffilestart mdifffd
5004 $ctext conf -state normal
5006 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5007 if {![info exists diffmergeid] || $id != $diffmergeid
5008 || $mdf != $mdifffd($id)} {
5012 if {[regexp {^diff --cc (.*)} $line match fname]} {
5013 # start of a new file
5014 $ctext insert end "\n"
5015 set here [$ctext index "end - 1c"]
5016 lappend difffilestart $here
5017 add_flist [list $fname]
5018 set l [expr {(78 - [string length $fname]) / 2}]
5019 set pad [string range "----------------------------------------" 1 $l]
5020 $ctext insert end "$pad $fname $pad\n" filesep
5021 } elseif {[regexp {^@@} $line]} {
5022 $ctext insert end "$line\n" hunksep
5023 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5026 # parse the prefix - one ' ', '-' or '+' for each parent
5031 for {set j 0} {$j < $np} {incr j} {
5032 set c [string range $line $j $j]
5035 } elseif {$c == "-"} {
5037 } elseif {$c == "+"} {
5046 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5047 # line doesn't appear in result, parents in $minuses have the line
5048 set num [lindex $minuses 0]
5049 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5050 # line appears in result, parents in $pluses don't have the line
5051 lappend tags mresult
5052 set num [lindex $spaces 0]
5055 if {$num >= $mergemax} {
5060 $ctext insert end "$line\n" $tags
5063 $ctext conf -state disabled
5068 return [expr {$nr >= 1000? 2: 1}]
5071 proc startdiff {ids} {
5072 global treediffs diffids treepending diffmergeid nullid nullid2
5075 catch {unset diffmergeid}
5076 if {![info exists treediffs($ids)] ||
5077 [lsearch -exact $ids $nullid] >= 0 ||
5078 [lsearch -exact $ids $nullid2] >= 0} {
5079 if {![info exists treepending]} {
5087 proc addtocflist {ids} {
5088 global treediffs cflist
5089 add_flist $treediffs($ids)
5093 proc diffcmd {ids flags} {
5094 global nullid nullid2
5096 set i [lsearch -exact $ids $nullid]
5097 set j [lsearch -exact $ids $nullid2]
5099 if {[llength $ids] > 1 && $j < 0} {
5100 # comparing working directory with some specific revision
5101 set cmd [concat | git diff-index $flags]
5103 lappend cmd -R [lindex $ids 1]
5105 lappend cmd [lindex $ids 0]
5108 # comparing working directory with index
5109 set cmd [concat | git diff-files $flags]
5114 } elseif {$j >= 0} {
5115 set cmd [concat | git diff-index --cached $flags]
5116 if {[llength $ids] > 1} {
5117 # comparing index with specific revision
5119 lappend cmd -R [lindex $ids 1]
5121 lappend cmd [lindex $ids 0]
5124 # comparing index with HEAD
5128 set cmd [concat | git diff-tree -r $flags $ids]
5133 proc gettreediffs {ids} {
5134 global treediff treepending
5136 set treepending $ids
5138 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5139 fconfigure $gdtf -blocking 0
5140 filerun $gdtf [list gettreediffline $gdtf $ids]
5143 proc gettreediffline {gdtf ids} {
5144 global treediff treediffs treepending diffids diffmergeid
5148 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5149 set i [string first "\t" $line]
5151 set file [string range $line [expr {$i+1}] end]
5152 if {[string index $file 0] eq "\""} {
5153 set file [lindex $file 0]
5155 lappend treediff $file
5159 return [expr {$nr >= 1000? 2: 1}]
5162 set treediffs($ids) $treediff
5164 if {$cmitmode eq "tree"} {
5166 } elseif {$ids != $diffids} {
5167 if {![info exists diffmergeid]} {
5168 gettreediffs $diffids
5176 # empty string or positive integer
5177 proc diffcontextvalidate {v} {
5178 return [regexp {^(|[1-9][0-9]*)$} $v]
5181 proc diffcontextchange {n1 n2 op} {
5182 global diffcontextstring diffcontext
5184 if {[string is integer -strict $diffcontextstring]} {
5185 if {$diffcontextstring > 0} {
5186 set diffcontext $diffcontextstring
5192 proc getblobdiffs {ids} {
5193 global diffopts blobdifffd diffids env
5194 global diffinhdr treediffs
5197 set env(GIT_DIFF_OPTS) $diffopts
5198 if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5199 puts "error getting diffs: $err"
5203 fconfigure $bdf -blocking 0
5204 set blobdifffd($ids) $bdf
5205 filerun $bdf [list getblobdiffline $bdf $diffids]
5208 proc setinlist {var i val} {
5211 while {[llength [set $var]] < $i} {
5214 if {[llength [set $var]] == $i} {
5221 proc makediffhdr {fname ids} {
5222 global ctext curdiffstart treediffs
5224 set i [lsearch -exact $treediffs($ids) $fname]
5226 setinlist difffilestart $i $curdiffstart
5228 set l [expr {(78 - [string length $fname]) / 2}]
5229 set pad [string range "----------------------------------------" 1 $l]
5230 $ctext insert $curdiffstart "$pad $fname $pad" filesep
5233 proc getblobdiffline {bdf ids} {
5234 global diffids blobdifffd ctext curdiffstart
5235 global diffnexthead diffnextnote difffilestart
5236 global diffinhdr treediffs
5239 $ctext conf -state normal
5240 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5241 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5245 if {![string compare -length 11 "diff --git " $line]} {
5246 # trim off "diff --git "
5247 set line [string range $line 11 end]
5249 # start of a new file
5250 $ctext insert end "\n"
5251 set curdiffstart [$ctext index "end - 1c"]
5252 $ctext insert end "\n" filesep
5253 # If the name hasn't changed the length will be odd,
5254 # the middle char will be a space, and the two bits either
5255 # side will be a/name and b/name, or "a/name" and "b/name".
5256 # If the name has changed we'll get "rename from" and
5257 # "rename to" or "copy from" and "copy to" lines following this,
5258 # and we'll use them to get the filenames.
5259 # This complexity is necessary because spaces in the filename(s)
5260 # don't get escaped.
5261 set l [string length $line]
5262 set i [expr {$l / 2}]
5263 if {!(($l & 1) && [string index $line $i] eq " " &&
5264 [string range $line 2 [expr {$i - 1}]] eq \
5265 [string range $line [expr {$i + 3}] end])} {
5268 # unescape if quoted and chop off the a/ from the front
5269 if {[string index $line 0] eq "\""} {
5270 set fname [string range [lindex $line 0] 2 end]
5272 set fname [string range $line 2 [expr {$i - 1}]]
5274 makediffhdr $fname $ids
5276 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5277 $line match f1l f1c f2l f2c rest]} {
5278 $ctext insert end "$line\n" hunksep
5281 } elseif {$diffinhdr} {
5282 if {![string compare -length 12 "rename from " $line] ||
5283 ![string compare -length 10 "copy from " $line]} {
5284 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5285 if {[string index $fname 0] eq "\""} {
5286 set fname [lindex $fname 0]
5288 set i [lsearch -exact $treediffs($ids) $fname]
5290 setinlist difffilestart $i $curdiffstart
5292 } elseif {![string compare -length 10 $line "rename to "] ||
5293 ![string compare -length 8 $line "copy to "]} {
5294 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5295 if {[string index $fname 0] eq "\""} {
5296 set fname [lindex $fname 0]
5298 makediffhdr $fname $ids
5299 } elseif {[string compare -length 3 $line "---"] == 0} {
5302 } elseif {[string compare -length 3 $line "+++"] == 0} {
5306 $ctext insert end "$line\n" filesep
5309 set x [string range $line 0 0]
5310 if {$x == "-" || $x == "+"} {
5311 set tag [expr {$x == "+"}]
5312 $ctext insert end "$line\n" d$tag
5313 } elseif {$x == " "} {
5314 $ctext insert end "$line\n"
5316 # "\ No newline at end of file",
5317 # or something else we don't recognize
5318 $ctext insert end "$line\n" hunksep
5322 $ctext conf -state disabled
5327 return [expr {$nr >= 1000? 2: 1}]
5330 proc changediffdisp {} {
5331 global ctext diffelide
5333 $ctext tag conf d0 -elide [lindex $diffelide 0]
5334 $ctext tag conf d1 -elide [lindex $diffelide 1]
5338 global difffilestart ctext
5339 set prev [lindex $difffilestart 0]
5340 set here [$ctext index @0,0]
5341 foreach loc $difffilestart {
5342 if {[$ctext compare $loc >= $here]} {
5352 global difffilestart ctext
5353 set here [$ctext index @0,0]
5354 foreach loc $difffilestart {
5355 if {[$ctext compare $loc > $here]} {
5362 proc clear_ctext {{first 1.0}} {
5363 global ctext smarktop smarkbot
5366 set l [lindex [split $first .] 0]
5367 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5370 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5373 $ctext delete $first end
5374 if {$first eq "1.0"} {
5375 catch {unset pendinglinks}
5379 proc incrsearch {name ix op} {
5380 global ctext searchstring searchdirn
5382 $ctext tag remove found 1.0 end
5383 if {[catch {$ctext index anchor}]} {
5384 # no anchor set, use start of selection, or of visible area
5385 set sel [$ctext tag ranges sel]
5387 $ctext mark set anchor [lindex $sel 0]
5388 } elseif {$searchdirn eq "-forwards"} {
5389 $ctext mark set anchor @0,0
5391 $ctext mark set anchor @0,[winfo height $ctext]
5394 if {$searchstring ne {}} {
5395 set here [$ctext search $searchdirn -- $searchstring anchor]
5404 global sstring ctext searchstring searchdirn
5407 $sstring icursor end
5408 set searchdirn -forwards
5409 if {$searchstring ne {}} {
5410 set sel [$ctext tag ranges sel]
5412 set start "[lindex $sel 0] + 1c"
5413 } elseif {[catch {set start [$ctext index anchor]}]} {
5416 set match [$ctext search -count mlen -- $searchstring $start]
5417 $ctext tag remove sel 1.0 end
5423 set mend "$match + $mlen c"
5424 $ctext tag add sel $match $mend
5425 $ctext mark unset anchor
5429 proc dosearchback {} {
5430 global sstring ctext searchstring searchdirn
5433 $sstring icursor end
5434 set searchdirn -backwards
5435 if {$searchstring ne {}} {
5436 set sel [$ctext tag ranges sel]
5438 set start [lindex $sel 0]
5439 } elseif {[catch {set start [$ctext index anchor]}]} {
5440 set start @0,[winfo height $ctext]
5442 set match [$ctext search -backwards -count ml -- $searchstring $start]
5443 $ctext tag remove sel 1.0 end
5449 set mend "$match + $ml c"
5450 $ctext tag add sel $match $mend
5451 $ctext mark unset anchor
5455 proc searchmark {first last} {
5456 global ctext searchstring
5460 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5461 if {$match eq {}} break
5462 set mend "$match + $mlen c"
5463 $ctext tag add found $match $mend
5467 proc searchmarkvisible {doall} {
5468 global ctext smarktop smarkbot
5470 set topline [lindex [split [$ctext index @0,0] .] 0]
5471 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5472 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5473 # no overlap with previous
5474 searchmark $topline $botline
5475 set smarktop $topline
5476 set smarkbot $botline
5478 if {$topline < $smarktop} {
5479 searchmark $topline [expr {$smarktop-1}]
5480 set smarktop $topline
5482 if {$botline > $smarkbot} {
5483 searchmark [expr {$smarkbot+1}] $botline
5484 set smarkbot $botline
5489 proc scrolltext {f0 f1} {
5492 .bleft.sb set $f0 $f1
5493 if {$searchstring ne {}} {
5499 global linespc charspc canvx0 canvy0 mainfont
5500 global xspc1 xspc2 lthickness
5502 set linespc [font metrics $mainfont -linespace]
5503 set charspc [font measure $mainfont "m"]
5504 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5505 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5506 set lthickness [expr {int($linespc / 9) + 1}]
5507 set xspc1(0) $linespc
5515 set ymax [lindex [$canv cget -scrollregion] 3]
5516 if {$ymax eq {} || $ymax == 0} return
5517 set span [$canv yview]
5520 allcanvs yview moveto [lindex $span 0]
5522 if {[info exists selectedline]} {
5523 selectline $selectedline 0
5524 allcanvs yview moveto [lindex $span 0]
5528 proc incrfont {inc} {
5529 global mainfont textfont ctext canv phase cflist showrefstop
5530 global charspc tabstop
5531 global stopped entries
5533 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5534 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5536 $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5537 $cflist conf -font $textfont
5538 $ctext tag conf filesep -font [concat $textfont bold]
5539 foreach e $entries {
5540 $e conf -font $mainfont
5542 if {$phase eq "getcommits"} {
5543 $canv itemconf textitems -font $mainfont
5545 if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5546 $showrefstop.list conf -font $mainfont
5552 global sha1entry sha1string
5553 if {[string length $sha1string] == 40} {
5554 $sha1entry delete 0 end
5558 proc sha1change {n1 n2 op} {
5559 global sha1string currentid sha1but
5560 if {$sha1string == {}
5561 || ([info exists currentid] && $sha1string == $currentid)} {
5566 if {[$sha1but cget -state] == $state} return
5567 if {$state == "normal"} {
5568 $sha1but conf -state normal -relief raised -text "Goto: "
5570 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5574 proc gotocommit {} {
5575 global sha1string currentid commitrow tagids headids
5576 global displayorder numcommits curview
5578 if {$sha1string == {}
5579 || ([info exists currentid] && $sha1string == $currentid)} return
5580 if {[info exists tagids($sha1string)]} {
5581 set id $tagids($sha1string)
5582 } elseif {[info exists headids($sha1string)]} {
5583 set id $headids($sha1string)
5585 set id [string tolower $sha1string]
5586 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5588 foreach i $displayorder {
5589 if {[string match $id* $i]} {
5593 if {$matches ne {}} {
5594 if {[llength $matches] > 1} {
5595 error_popup "Short SHA1 id $id is ambiguous"
5598 set id [lindex $matches 0]
5602 if {[info exists commitrow($curview,$id)]} {
5603 selectline $commitrow($curview,$id) 1
5606 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5611 error_popup "$type $sha1string is not known"
5614 proc lineenter {x y id} {
5615 global hoverx hovery hoverid hovertimer
5616 global commitinfo canv
5618 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5622 if {[info exists hovertimer]} {
5623 after cancel $hovertimer
5625 set hovertimer [after 500 linehover]
5629 proc linemotion {x y id} {
5630 global hoverx hovery hoverid hovertimer
5632 if {[info exists hoverid] && $id == $hoverid} {
5635 if {[info exists hovertimer]} {
5636 after cancel $hovertimer
5638 set hovertimer [after 500 linehover]
5642 proc lineleave {id} {
5643 global hoverid hovertimer canv
5645 if {[info exists hoverid] && $id == $hoverid} {
5647 if {[info exists hovertimer]} {
5648 after cancel $hovertimer
5656 global hoverx hovery hoverid hovertimer
5657 global canv linespc lthickness
5658 global commitinfo mainfont
5660 set text [lindex $commitinfo($hoverid) 0]
5661 set ymax [lindex [$canv cget -scrollregion] 3]
5662 if {$ymax == {}} return
5663 set yfrac [lindex [$canv yview] 0]
5664 set x [expr {$hoverx + 2 * $linespc}]
5665 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5666 set x0 [expr {$x - 2 * $lthickness}]
5667 set y0 [expr {$y - 2 * $lthickness}]
5668 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5669 set y1 [expr {$y + $linespc + 2 * $lthickness}]
5670 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5671 -fill \#ffff80 -outline black -width 1 -tags hover]
5673 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5678 proc clickisonarrow {id y} {
5681 set ranges [rowranges $id]
5682 set thresh [expr {2 * $lthickness + 6}]
5683 set n [expr {[llength $ranges] - 1}]
5684 for {set i 1} {$i < $n} {incr i} {
5685 set row [lindex $ranges $i]
5686 if {abs([yc $row] - $y) < $thresh} {
5693 proc arrowjump {id n y} {
5696 # 1 <-> 2, 3 <-> 4, etc...
5697 set n [expr {(($n - 1) ^ 1) + 1}]
5698 set row [lindex [rowranges $id] $n]
5700 set ymax [lindex [$canv cget -scrollregion] 3]
5701 if {$ymax eq {} || $ymax <= 0} return
5702 set view [$canv yview]
5703 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5704 set yfrac [expr {$yt / $ymax - $yspan / 2}]
5708 allcanvs yview moveto $yfrac
5711 proc lineclick {x y id isnew} {
5712 global ctext commitinfo children canv thickerline curview commitrow
5714 if {![info exists commitinfo($id)] && ![getcommit $id]} return
5719 # draw this line thicker than normal
5723 set ymax [lindex [$canv cget -scrollregion] 3]
5724 if {$ymax eq {}} return
5725 set yfrac [lindex [$canv yview] 0]
5726 set y [expr {$y + $yfrac * $ymax}]
5728 set dirn [clickisonarrow $id $y]
5730 arrowjump $id $dirn $y
5735 addtohistory [list lineclick $x $y $id 0]
5737 # fill the details pane with info about this line
5738 $ctext conf -state normal
5740 $ctext insert end "Parent:\t"
5741 $ctext insert end $id link0
5743 set info $commitinfo($id)
5744 $ctext insert end "\n\t[lindex $info 0]\n"
5745 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5746 set date [formatdate [lindex $info 2]]
5747 $ctext insert end "\tDate:\t$date\n"
5748 set kids $children($curview,$id)
5750 $ctext insert end "\nChildren:"
5752 foreach child $kids {
5754 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5755 set info $commitinfo($child)
5756 $ctext insert end "\n\t"
5757 $ctext insert end $child link$i
5758 setlink $child link$i
5759 $ctext insert end "\n\t[lindex $info 0]"
5760 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5761 set date [formatdate [lindex $info 2]]
5762 $ctext insert end "\n\tDate:\t$date\n"
5765 $ctext conf -state disabled
5769 proc normalline {} {
5771 if {[info exists thickerline]} {
5779 global commitrow curview
5780 if {[info exists commitrow($curview,$id)]} {
5781 selectline $commitrow($curview,$id) 1
5787 if {![info exists startmstime]} {
5788 set startmstime [clock clicks -milliseconds]
5790 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5793 proc rowmenu {x y id} {
5794 global rowctxmenu commitrow selectedline rowmenuid curview
5795 global nullid nullid2 fakerowmenu mainhead
5798 if {![info exists selectedline]
5799 || $commitrow($curview,$id) eq $selectedline} {
5804 if {$id ne $nullid && $id ne $nullid2} {
5805 set menu $rowctxmenu
5806 $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5808 set menu $fakerowmenu
5810 $menu entryconfigure "Diff this*" -state $state
5811 $menu entryconfigure "Diff selected*" -state $state
5812 $menu entryconfigure "Make patch" -state $state
5813 tk_popup $menu $x $y
5816 proc diffvssel {dirn} {
5817 global rowmenuid selectedline displayorder
5819 if {![info exists selectedline]} return
5821 set oldid [lindex $displayorder $selectedline]
5822 set newid $rowmenuid
5824 set oldid $rowmenuid
5825 set newid [lindex $displayorder $selectedline]
5827 addtohistory [list doseldiff $oldid $newid]
5828 doseldiff $oldid $newid
5831 proc doseldiff {oldid newid} {
5835 $ctext conf -state normal
5838 $ctext insert end "From "
5839 $ctext insert end $oldid link0
5840 setlink $oldid link0
5841 $ctext insert end "\n "
5842 $ctext insert end [lindex $commitinfo($oldid) 0]
5843 $ctext insert end "\n\nTo "
5844 $ctext insert end $newid link1
5845 setlink $newid link1
5846 $ctext insert end "\n "
5847 $ctext insert end [lindex $commitinfo($newid) 0]
5848 $ctext insert end "\n"
5849 $ctext conf -state disabled
5850 $ctext tag remove found 1.0 end
5851 startdiff [list $oldid $newid]
5855 global rowmenuid currentid commitinfo patchtop patchnum
5857 if {![info exists currentid]} return
5858 set oldid $currentid
5859 set oldhead [lindex $commitinfo($oldid) 0]
5860 set newid $rowmenuid
5861 set newhead [lindex $commitinfo($newid) 0]
5864 catch {destroy $top}
5866 label $top.title -text "Generate patch"
5867 grid $top.title - -pady 10
5868 label $top.from -text "From:"
5869 entry $top.fromsha1 -width 40 -relief flat
5870 $top.fromsha1 insert 0 $oldid
5871 $top.fromsha1 conf -state readonly
5872 grid $top.from $top.fromsha1 -sticky w
5873 entry $top.fromhead -width 60 -relief flat
5874 $top.fromhead insert 0 $oldhead
5875 $top.fromhead conf -state readonly
5876 grid x $top.fromhead -sticky w
5877 label $top.to -text "To:"
5878 entry $top.tosha1 -width 40 -relief flat
5879 $top.tosha1 insert 0 $newid
5880 $top.tosha1 conf -state readonly
5881 grid $top.to $top.tosha1 -sticky w
5882 entry $top.tohead -width 60 -relief flat
5883 $top.tohead insert 0 $newhead
5884 $top.tohead conf -state readonly
5885 grid x $top.tohead -sticky w
5886 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5887 grid $top.rev x -pady 10
5888 label $top.flab -text "Output file:"
5889 entry $top.fname -width 60
5890 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5892 grid $top.flab $top.fname -sticky w
5894 button $top.buts.gen -text "Generate" -command mkpatchgo
5895 button $top.buts.can -text "Cancel" -command mkpatchcan
5896 grid $top.buts.gen $top.buts.can
5897 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5898 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5899 grid $top.buts - -pady 10 -sticky ew
5903 proc mkpatchrev {} {
5906 set oldid [$patchtop.fromsha1 get]
5907 set oldhead [$patchtop.fromhead get]
5908 set newid [$patchtop.tosha1 get]
5909 set newhead [$patchtop.tohead get]
5910 foreach e [list fromsha1 fromhead tosha1 tohead] \
5911 v [list $newid $newhead $oldid $oldhead] {
5912 $patchtop.$e conf -state normal
5913 $patchtop.$e delete 0 end
5914 $patchtop.$e insert 0 $v
5915 $patchtop.$e conf -state readonly
5920 global patchtop nullid nullid2
5922 set oldid [$patchtop.fromsha1 get]
5923 set newid [$patchtop.tosha1 get]
5924 set fname [$patchtop.fname get]
5925 set cmd [diffcmd [list $oldid $newid] -p]
5926 lappend cmd >$fname &
5927 if {[catch {eval exec $cmd} err]} {
5928 error_popup "Error creating patch: $err"
5930 catch {destroy $patchtop}
5934 proc mkpatchcan {} {
5937 catch {destroy $patchtop}
5942 global rowmenuid mktagtop commitinfo
5946 catch {destroy $top}
5948 label $top.title -text "Create tag"
5949 grid $top.title - -pady 10
5950 label $top.id -text "ID:"
5951 entry $top.sha1 -width 40 -relief flat
5952 $top.sha1 insert 0 $rowmenuid
5953 $top.sha1 conf -state readonly
5954 grid $top.id $top.sha1 -sticky w
5955 entry $top.head -width 60 -relief flat
5956 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5957 $top.head conf -state readonly
5958 grid x $top.head -sticky w
5959 label $top.tlab -text "Tag name:"
5960 entry $top.tag -width 60
5961 grid $top.tlab $top.tag -sticky w
5963 button $top.buts.gen -text "Create" -command mktaggo
5964 button $top.buts.can -text "Cancel" -command mktagcan
5965 grid $top.buts.gen $top.buts.can
5966 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5967 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5968 grid $top.buts - -pady 10 -sticky ew
5973 global mktagtop env tagids idtags
5975 set id [$mktagtop.sha1 get]
5976 set tag [$mktagtop.tag get]
5978 error_popup "No tag name specified"
5981 if {[info exists tagids($tag)]} {
5982 error_popup "Tag \"$tag\" already exists"
5987 set fname [file join $dir "refs/tags" $tag]
5988 set f [open $fname w]
5992 error_popup "Error creating tag: $err"
5996 set tagids($tag) $id
5997 lappend idtags($id) $tag
6004 proc redrawtags {id} {
6005 global canv linehtag commitrow idpos selectedline curview
6006 global mainfont canvxmax iddrawn
6008 if {![info exists commitrow($curview,$id)]} return
6009 if {![info exists iddrawn($id)]} return
6010 drawcommits $commitrow($curview,$id)
6011 $canv delete tag.$id
6012 set xt [eval drawtags $id $idpos($id)]
6013 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6014 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6015 set xr [expr {$xt + [font measure $mainfont $text]}]
6016 if {$xr > $canvxmax} {
6020 if {[info exists selectedline]
6021 && $selectedline == $commitrow($curview,$id)} {
6022 selectline $selectedline 0
6029 catch {destroy $mktagtop}
6038 proc writecommit {} {
6039 global rowmenuid wrcomtop commitinfo wrcomcmd
6041 set top .writecommit
6043 catch {destroy $top}
6045 label $top.title -text "Write commit to file"
6046 grid $top.title - -pady 10
6047 label $top.id -text "ID:"
6048 entry $top.sha1 -width 40 -relief flat
6049 $top.sha1 insert 0 $rowmenuid
6050 $top.sha1 conf -state readonly
6051 grid $top.id $top.sha1 -sticky w
6052 entry $top.head -width 60 -relief flat
6053 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6054 $top.head conf -state readonly
6055 grid x $top.head -sticky w
6056 label $top.clab -text "Command:"
6057 entry $top.cmd -width 60 -textvariable wrcomcmd
6058 grid $top.clab $top.cmd -sticky w -pady 10
6059 label $top.flab -text "Output file:"
6060 entry $top.fname -width 60
6061 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6062 grid $top.flab $top.fname -sticky w
6064 button $top.buts.gen -text "Write" -command wrcomgo
6065 button $top.buts.can -text "Cancel" -command wrcomcan
6066 grid $top.buts.gen $top.buts.can
6067 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6068 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6069 grid $top.buts - -pady 10 -sticky ew
6076 set id [$wrcomtop.sha1 get]
6077 set cmd "echo $id | [$wrcomtop.cmd get]"
6078 set fname [$wrcomtop.fname get]
6079 if {[catch {exec sh -c $cmd >$fname &} err]} {
6080 error_popup "Error writing commit: $err"
6082 catch {destroy $wrcomtop}
6089 catch {destroy $wrcomtop}
6094 global rowmenuid mkbrtop
6097 catch {destroy $top}
6099 label $top.title -text "Create new branch"
6100 grid $top.title - -pady 10
6101 label $top.id -text "ID:"
6102 entry $top.sha1 -width 40 -relief flat
6103 $top.sha1 insert 0 $rowmenuid
6104 $top.sha1 conf -state readonly
6105 grid $top.id $top.sha1 -sticky w
6106 label $top.nlab -text "Name:"
6107 entry $top.name -width 40
6108 grid $top.nlab $top.name -sticky w
6110 button $top.buts.go -text "Create" -command [list mkbrgo $top]
6111 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6112 grid $top.buts.go $top.buts.can
6113 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6114 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6115 grid $top.buts - -pady 10 -sticky ew
6120 global headids idheads
6122 set name [$top.name get]
6123 set id [$top.sha1 get]
6125 error_popup "Please specify a name for the new branch"
6128 catch {destroy $top}
6132 exec git branch $name $id
6137 set headids($name) $id
6138 lappend idheads($id) $name
6147 proc cherrypick {} {
6148 global rowmenuid curview commitrow
6151 set oldhead [exec git rev-parse HEAD]
6152 set dheads [descheads $rowmenuid]
6153 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6154 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6155 included in branch $mainhead -- really re-apply it?"]
6160 # Unfortunately git-cherry-pick writes stuff to stderr even when
6161 # no error occurs, and exec takes that as an indication of error...
6162 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6167 set newhead [exec git rev-parse HEAD]
6168 if {$newhead eq $oldhead} {
6170 error_popup "No changes committed"
6173 addnewchild $newhead $oldhead
6174 if {[info exists commitrow($curview,$oldhead)]} {
6175 insertrow $commitrow($curview,$oldhead) $newhead
6176 if {$mainhead ne {}} {
6177 movehead $newhead $mainhead
6178 movedhead $newhead $mainhead
6187 global mainheadid mainhead rowmenuid confirm_ok resettype
6188 global showlocalchanges
6191 set w ".confirmreset"
6194 wm title $w "Confirm reset"
6195 message $w.m -text \
6196 "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6197 -justify center -aspect 1000
6198 pack $w.m -side top -fill x -padx 20 -pady 20
6199 frame $w.f -relief sunken -border 2
6200 message $w.f.rt -text "Reset type:" -aspect 1000
6201 grid $w.f.rt -sticky w
6203 radiobutton $w.f.soft -value soft -variable resettype -justify left \
6204 -text "Soft: Leave working tree and index untouched"
6205 grid $w.f.soft -sticky w
6206 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6207 -text "Mixed: Leave working tree untouched, reset index"
6208 grid $w.f.mixed -sticky w
6209 radiobutton $w.f.hard -value hard -variable resettype -justify left \
6210 -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6211 grid $w.f.hard -sticky w
6212 pack $w.f -side top -fill x
6213 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6214 pack $w.ok -side left -fill x -padx 20 -pady 20
6215 button $w.cancel -text Cancel -command "destroy $w"
6216 pack $w.cancel -side right -fill x -padx 20 -pady 20
6217 bind $w <Visibility> "grab $w; focus $w"
6219 if {!$confirm_ok} return
6220 if {[catch {set fd [open \
6221 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6225 set w ".resetprogress"
6226 filerun $fd [list readresetstat $fd $w]
6229 wm title $w "Reset progress"
6230 message $w.m -text "Reset in progress, please wait..." \
6231 -justify center -aspect 1000
6232 pack $w.m -side top -fill x -padx 20 -pady 5
6233 canvas $w.c -width 150 -height 20 -bg white
6234 $w.c create rect 0 0 0 20 -fill green -tags rect
6235 pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6240 proc readresetstat {fd w} {
6241 global mainhead mainheadid showlocalchanges
6243 if {[gets $fd line] >= 0} {
6244 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6245 set x [expr {($m * 150) / $n}]
6246 $w.c coords rect 0 0 $x 20
6252 if {[catch {close $fd} err]} {
6255 set oldhead $mainheadid
6256 set newhead [exec git rev-parse HEAD]
6257 if {$newhead ne $oldhead} {
6258 movehead $newhead $mainhead
6259 movedhead $newhead $mainhead
6260 set mainheadid $newhead
6264 if {$showlocalchanges} {
6270 # context menu for a head
6271 proc headmenu {x y id head} {
6272 global headmenuid headmenuhead headctxmenu mainhead
6275 set headmenuhead $head
6277 if {$head eq $mainhead} {
6280 $headctxmenu entryconfigure 0 -state $state
6281 $headctxmenu entryconfigure 1 -state $state
6282 tk_popup $headctxmenu $x $y
6286 global headmenuid headmenuhead mainhead headids
6287 global showlocalchanges mainheadid
6289 # check the tree is clean first??
6290 set oldmainhead $mainhead
6295 exec git checkout -q $headmenuhead
6301 set mainhead $headmenuhead
6302 set mainheadid $headmenuid
6303 if {[info exists headids($oldmainhead)]} {
6304 redrawtags $headids($oldmainhead)
6306 redrawtags $headmenuid
6308 if {$showlocalchanges} {
6314 global headmenuid headmenuhead mainhead
6317 set head $headmenuhead
6319 # this check shouldn't be needed any more...
6320 if {$head eq $mainhead} {
6321 error_popup "Cannot delete the currently checked-out branch"
6324 set dheads [descheads $id]
6325 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6326 # the stuff on this branch isn't on any other branch
6327 if {![confirm_popup "The commits on branch $head aren't on any other\
6328 branch.\nReally delete branch $head?"]} return
6332 if {[catch {exec git branch -D $head} err]} {
6337 removehead $id $head
6338 removedhead $id $head
6345 # Display a list of tags and heads
6347 global showrefstop bgcolor fgcolor selectbgcolor mainfont
6348 global bglist fglist uifont reflistfilter reflist maincursor
6351 set showrefstop $top
6352 if {[winfo exists $top]} {
6358 wm title $top "Tags and heads: [file tail [pwd]]"
6359 text $top.list -background $bgcolor -foreground $fgcolor \
6360 -selectbackground $selectbgcolor -font $mainfont \
6361 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6362 -width 30 -height 20 -cursor $maincursor \
6363 -spacing1 1 -spacing3 1 -state disabled
6364 $top.list tag configure highlight -background $selectbgcolor
6365 lappend bglist $top.list
6366 lappend fglist $top.list
6367 scrollbar $top.ysb -command "$top.list yview" -orient vertical
6368 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6369 grid $top.list $top.ysb -sticky nsew
6370 grid $top.xsb x -sticky ew
6372 label $top.f.l -text "Filter: " -font $uifont
6373 entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6374 set reflistfilter "*"
6375 trace add variable reflistfilter write reflistfilter_change
6376 pack $top.f.e -side right -fill x -expand 1
6377 pack $top.f.l -side left
6378 grid $top.f - -sticky ew -pady 2
6379 button $top.close -command [list destroy $top] -text "Close" \
6382 grid columnconfigure $top 0 -weight 1
6383 grid rowconfigure $top 0 -weight 1
6384 bind $top.list <1> {break}
6385 bind $top.list <B1-Motion> {break}
6386 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6391 proc sel_reflist {w x y} {
6392 global showrefstop reflist headids tagids otherrefids
6394 if {![winfo exists $showrefstop]} return
6395 set l [lindex [split [$w index "@$x,$y"] "."] 0]
6396 set ref [lindex $reflist [expr {$l-1}]]
6397 set n [lindex $ref 0]
6398 switch -- [lindex $ref 1] {
6399 "H" {selbyid $headids($n)}
6400 "T" {selbyid $tagids($n)}
6401 "o" {selbyid $otherrefids($n)}
6403 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6406 proc unsel_reflist {} {
6409 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6410 $showrefstop.list tag remove highlight 0.0 end
6413 proc reflistfilter_change {n1 n2 op} {
6414 global reflistfilter
6416 after cancel refill_reflist
6417 after 200 refill_reflist
6420 proc refill_reflist {} {
6421 global reflist reflistfilter showrefstop headids tagids otherrefids
6422 global commitrow curview commitinterest
6424 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6426 foreach n [array names headids] {
6427 if {[string match $reflistfilter $n]} {
6428 if {[info exists commitrow($curview,$headids($n))]} {
6429 lappend refs [list $n H]
6431 set commitinterest($headids($n)) {run refill_reflist}
6435 foreach n [array names tagids] {
6436 if {[string match $reflistfilter $n]} {
6437 if {[info exists commitrow($curview,$tagids($n))]} {
6438 lappend refs [list $n T]
6440 set commitinterest($tagids($n)) {run refill_reflist}
6444 foreach n [array names otherrefids] {
6445 if {[string match $reflistfilter $n]} {
6446 if {[info exists commitrow($curview,$otherrefids($n))]} {
6447 lappend refs [list $n o]
6449 set commitinterest($otherrefids($n)) {run refill_reflist}
6453 set refs [lsort -index 0 $refs]
6454 if {$refs eq $reflist} return
6456 # Update the contents of $showrefstop.list according to the
6457 # differences between $reflist (old) and $refs (new)
6458 $showrefstop.list conf -state normal
6459 $showrefstop.list insert end "\n"
6462 while {$i < [llength $reflist] || $j < [llength $refs]} {
6463 if {$i < [llength $reflist]} {
6464 if {$j < [llength $refs]} {
6465 set cmp [string compare [lindex $reflist $i 0] \
6466 [lindex $refs $j 0]]
6468 set cmp [string compare [lindex $reflist $i 1] \
6469 [lindex $refs $j 1]]
6479 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6487 set l [expr {$j + 1}]
6488 $showrefstop.list image create $l.0 -align baseline \
6489 -image reficon-[lindex $refs $j 1] -padx 2
6490 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6496 # delete last newline
6497 $showrefstop.list delete end-2c end-1c
6498 $showrefstop.list conf -state disabled
6501 # Stuff for finding nearby tags
6502 proc getallcommits {} {
6503 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6504 global idheads idtags idotherrefs allparents tagobjid
6506 if {![info exists allcommits]} {
6512 set allccache [file join [gitdir] "gitk.cache"]
6514 set f [open $allccache r]
6523 set cmd [list | git rev-list --parents]
6524 set allcupdate [expr {$seeds ne {}}]
6528 set refs [concat [array names idheads] [array names idtags] \
6529 [array names idotherrefs]]
6532 foreach name [array names tagobjid] {
6533 lappend tagobjs $tagobjid($name)
6535 foreach id [lsort -unique $refs] {
6536 if {![info exists allparents($id)] &&
6537 [lsearch -exact $tagobjs $id] < 0} {
6548 set fd [open [concat $cmd $ids] r]
6549 fconfigure $fd -blocking 0
6552 filerun $fd [list getallclines $fd]
6558 # Since most commits have 1 parent and 1 child, we group strings of
6559 # such commits into "arcs" joining branch/merge points (BMPs), which
6560 # are commits that either don't have 1 parent or don't have 1 child.
6562 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6563 # arcout(id) - outgoing arcs for BMP
6564 # arcids(a) - list of IDs on arc including end but not start
6565 # arcstart(a) - BMP ID at start of arc
6566 # arcend(a) - BMP ID at end of arc
6567 # growing(a) - arc a is still growing
6568 # arctags(a) - IDs out of arcids (excluding end) that have tags
6569 # archeads(a) - IDs out of arcids (excluding end) that have heads
6570 # The start of an arc is at the descendent end, so "incoming" means
6571 # coming from descendents, and "outgoing" means going towards ancestors.
6573 proc getallclines {fd} {
6574 global allparents allchildren idtags idheads nextarc
6575 global arcnos arcids arctags arcout arcend arcstart archeads growing
6576 global seeds allcommits cachedarcs allcupdate
6579 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6580 set id [lindex $line 0]
6581 if {[info exists allparents($id)]} {
6586 set olds [lrange $line 1 end]
6587 set allparents($id) $olds
6588 if {![info exists allchildren($id)]} {
6589 set allchildren($id) {}
6594 if {[llength $olds] == 1 && [llength $a] == 1} {
6595 lappend arcids($a) $id
6596 if {[info exists idtags($id)]} {
6597 lappend arctags($a) $id
6599 if {[info exists idheads($id)]} {
6600 lappend archeads($a) $id
6602 if {[info exists allparents($olds)]} {
6603 # seen parent already
6604 if {![info exists arcout($olds)]} {
6607 lappend arcids($a) $olds
6608 set arcend($a) $olds
6611 lappend allchildren($olds) $id
6612 lappend arcnos($olds) $a
6616 foreach a $arcnos($id) {
6617 lappend arcids($a) $id
6624 lappend allchildren($p) $id
6625 set a [incr nextarc]
6626 set arcstart($a) $id
6633 if {[info exists allparents($p)]} {
6634 # seen it already, may need to make a new branch
6635 if {![info exists arcout($p)]} {
6638 lappend arcids($a) $p
6642 lappend arcnos($p) $a
6647 global cached_dheads cached_dtags cached_atags
6648 catch {unset cached_dheads}
6649 catch {unset cached_dtags}
6650 catch {unset cached_atags}
6653 return [expr {$nid >= 1000? 2: 1}]
6657 fconfigure $fd -blocking 1
6660 # got an error reading the list of commits
6661 # if we were updating, try rereading the whole thing again
6667 error_popup "Error reading commit topology information;\
6668 branch and preceding/following tag information\
6669 will be incomplete.\n($err)"
6672 if {[incr allcommits -1] == 0} {
6682 proc recalcarc {a} {
6683 global arctags archeads arcids idtags idheads
6687 foreach id [lrange $arcids($a) 0 end-1] {
6688 if {[info exists idtags($id)]} {
6691 if {[info exists idheads($id)]} {
6696 set archeads($a) $ah
6700 global arcnos arcids nextarc arctags archeads idtags idheads
6701 global arcstart arcend arcout allparents growing
6704 if {[llength $a] != 1} {
6705 puts "oops splitarc called but [llength $a] arcs already"
6709 set i [lsearch -exact $arcids($a) $p]
6711 puts "oops splitarc $p not in arc $a"
6714 set na [incr nextarc]
6715 if {[info exists arcend($a)]} {
6716 set arcend($na) $arcend($a)
6718 set l [lindex $allparents([lindex $arcids($a) end]) 0]
6719 set j [lsearch -exact $arcnos($l) $a]
6720 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6722 set tail [lrange $arcids($a) [expr {$i+1}] end]
6723 set arcids($a) [lrange $arcids($a) 0 $i]
6725 set arcstart($na) $p
6727 set arcids($na) $tail
6728 if {[info exists growing($a)]} {
6734 if {[llength $arcnos($id)] == 1} {
6737 set j [lsearch -exact $arcnos($id) $a]
6738 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6742 # reconstruct tags and heads lists
6743 if {$arctags($a) ne {} || $archeads($a) ne {}} {
6748 set archeads($na) {}
6752 # Update things for a new commit added that is a child of one
6753 # existing commit. Used when cherry-picking.
6754 proc addnewchild {id p} {
6755 global allparents allchildren idtags nextarc
6756 global arcnos arcids arctags arcout arcend arcstart archeads growing
6757 global seeds allcommits
6759 if {![info exists allcommits]} return
6760 set allparents($id) [list $p]
6761 set allchildren($id) {}
6764 lappend allchildren($p) $id
6765 set a [incr nextarc]
6766 set arcstart($a) $id
6769 set arcids($a) [list $p]
6771 if {![info exists arcout($p)]} {
6774 lappend arcnos($p) $a
6775 set arcout($id) [list $a]
6778 # This implements a cache for the topology information.
6779 # The cache saves, for each arc, the start and end of the arc,
6780 # the ids on the arc, and the outgoing arcs from the end.
6781 proc readcache {f} {
6782 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6783 global idtags idheads allparents cachedarcs possible_seeds seeds growing
6788 if {$lim - $a > 500} {
6789 set lim [expr {$a + 500}]
6793 # finish reading the cache and setting up arctags, etc.
6795 if {$line ne "1"} {error "bad final version"}
6797 foreach id [array names idtags] {
6798 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6799 [llength $allparents($id)] == 1} {
6800 set a [lindex $arcnos($id) 0]
6801 if {$arctags($a) eq {}} {
6806 foreach id [array names idheads] {
6807 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6808 [llength $allparents($id)] == 1} {
6809 set a [lindex $arcnos($id) 0]
6810 if {$archeads($a) eq {}} {
6815 foreach id [lsort -unique $possible_seeds] {
6816 if {$arcnos($id) eq {}} {
6822 while {[incr a] <= $lim} {
6824 if {[llength $line] != 3} {error "bad line"}
6825 set s [lindex $line 0]
6827 lappend arcout($s) $a
6828 if {![info exists arcnos($s)]} {
6829 lappend possible_seeds $s
6832 set e [lindex $line 1]
6837 if {![info exists arcout($e)]} {
6841 set arcids($a) [lindex $line 2]
6842 foreach id $arcids($a) {
6843 lappend allparents($s) $id
6845 lappend arcnos($id) $a
6847 if {![info exists allparents($s)]} {
6848 set allparents($s) {}
6853 set nextarc [expr {$a - 1}]
6866 global nextarc cachedarcs possible_seeds
6870 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
6871 # make sure it's an integer
6872 set cachedarcs [expr {int([lindex $line 1])}]
6873 if {$cachedarcs < 0} {error "bad number of arcs"}
6875 set possible_seeds {}
6883 proc dropcache {err} {
6884 global allcwait nextarc cachedarcs seeds
6886 #puts "dropping cache ($err)"
6887 foreach v {arcnos arcout arcids arcstart arcend growing \
6888 arctags archeads allparents allchildren} {
6899 proc writecache {f} {
6900 global cachearc cachedarcs allccache
6901 global arcstart arcend arcnos arcids arcout
6905 if {$lim - $a > 1000} {
6906 set lim [expr {$a + 1000}]
6909 while {[incr a] <= $lim} {
6910 if {[info exists arcend($a)]} {
6911 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
6913 puts $f [list $arcstart($a) {} $arcids($a)]
6918 catch {file delete $allccache}
6919 #puts "writing cache failed ($err)"
6922 set cachearc [expr {$a - 1}]
6923 if {$a > $cachedarcs} {
6932 global nextarc cachedarcs cachearc allccache
6934 if {$nextarc == $cachedarcs} return
6936 set cachedarcs $nextarc
6938 set f [open $allccache w]
6939 puts $f [list 1 $cachedarcs]
6944 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6945 # or 0 if neither is true.
6946 proc anc_or_desc {a b} {
6947 global arcout arcstart arcend arcnos cached_isanc
6949 if {$arcnos($a) eq $arcnos($b)} {
6950 # Both are on the same arc(s); either both are the same BMP,
6951 # or if one is not a BMP, the other is also not a BMP or is
6952 # the BMP at end of the arc (and it only has 1 incoming arc).
6953 # Or both can be BMPs with no incoming arcs.
6954 if {$a eq $b || $arcnos($a) eq {}} {
6957 # assert {[llength $arcnos($a)] == 1}
6958 set arc [lindex $arcnos($a) 0]
6959 set i [lsearch -exact $arcids($arc) $a]
6960 set j [lsearch -exact $arcids($arc) $b]
6961 if {$i < 0 || $i > $j} {
6968 if {![info exists arcout($a)]} {
6969 set arc [lindex $arcnos($a) 0]
6970 if {[info exists arcend($arc)]} {
6971 set aend $arcend($arc)
6975 set a $arcstart($arc)
6979 if {![info exists arcout($b)]} {
6980 set arc [lindex $arcnos($b) 0]
6981 if {[info exists arcend($arc)]} {
6982 set bend $arcend($arc)
6986 set b $arcstart($arc)
6996 if {[info exists cached_isanc($a,$bend)]} {
6997 if {$cached_isanc($a,$bend)} {
7001 if {[info exists cached_isanc($b,$aend)]} {
7002 if {$cached_isanc($b,$aend)} {
7005 if {[info exists cached_isanc($a,$bend)]} {
7010 set todo [list $a $b]
7013 for {set i 0} {$i < [llength $todo]} {incr i} {
7014 set x [lindex $todo $i]
7015 if {$anc($x) eq {}} {
7018 foreach arc $arcnos($x) {
7019 set xd $arcstart($arc)
7021 set cached_isanc($a,$bend) 1
7022 set cached_isanc($b,$aend) 0
7024 } elseif {$xd eq $aend} {
7025 set cached_isanc($b,$aend) 1
7026 set cached_isanc($a,$bend) 0
7029 if {![info exists anc($xd)]} {
7030 set anc($xd) $anc($x)
7032 } elseif {$anc($xd) ne $anc($x)} {
7037 set cached_isanc($a,$bend) 0
7038 set cached_isanc($b,$aend) 0
7042 # This identifies whether $desc has an ancestor that is
7043 # a growing tip of the graph and which is not an ancestor of $anc
7044 # and returns 0 if so and 1 if not.
7045 # If we subsequently discover a tag on such a growing tip, and that
7046 # turns out to be a descendent of $anc (which it could, since we
7047 # don't necessarily see children before parents), then $desc
7048 # isn't a good choice to display as a descendent tag of
7049 # $anc (since it is the descendent of another tag which is
7050 # a descendent of $anc). Similarly, $anc isn't a good choice to
7051 # display as a ancestor tag of $desc.
7053 proc is_certain {desc anc} {
7054 global arcnos arcout arcstart arcend growing problems
7057 if {[llength $arcnos($anc)] == 1} {
7058 # tags on the same arc are certain
7059 if {$arcnos($desc) eq $arcnos($anc)} {
7062 if {![info exists arcout($anc)]} {
7063 # if $anc is partway along an arc, use the start of the arc instead
7064 set a [lindex $arcnos($anc) 0]
7065 set anc $arcstart($a)
7068 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7071 set a [lindex $arcnos($desc) 0]
7077 set anclist [list $x]
7081 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7082 set x [lindex $anclist $i]
7087 foreach a $arcout($x) {
7088 if {[info exists growing($a)]} {
7089 if {![info exists growanc($x)] && $dl($x)} {
7095 if {[info exists dl($y)]} {
7099 if {![info exists done($y)]} {
7102 if {[info exists growanc($x)]} {
7106 for {set k 0} {$k < [llength $xl]} {incr k} {
7107 set z [lindex $xl $k]
7108 foreach c $arcout($z) {
7109 if {[info exists arcend($c)]} {
7111 if {[info exists dl($v)] && $dl($v)} {
7113 if {![info exists done($v)]} {
7116 if {[info exists growanc($v)]} {
7126 } elseif {$y eq $anc || !$dl($x)} {
7137 foreach x [array names growanc] {
7146 proc validate_arctags {a} {
7147 global arctags idtags
7151 foreach id $arctags($a) {
7153 if {![info exists idtags($id)]} {
7154 set na [lreplace $na $i $i]
7161 proc validate_archeads {a} {
7162 global archeads idheads
7165 set na $archeads($a)
7166 foreach id $archeads($a) {
7168 if {![info exists idheads($id)]} {
7169 set na [lreplace $na $i $i]
7173 set archeads($a) $na
7176 # Return the list of IDs that have tags that are descendents of id,
7177 # ignoring IDs that are descendents of IDs already reported.
7178 proc desctags {id} {
7179 global arcnos arcstart arcids arctags idtags allparents
7180 global growing cached_dtags
7182 if {![info exists allparents($id)]} {
7185 set t1 [clock clicks -milliseconds]
7187 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7188 # part-way along an arc; check that arc first
7189 set a [lindex $arcnos($id) 0]
7190 if {$arctags($a) ne {}} {
7192 set i [lsearch -exact $arcids($a) $id]
7194 foreach t $arctags($a) {
7195 set j [lsearch -exact $arcids($a) $t]
7203 set id $arcstart($a)
7204 if {[info exists idtags($id)]} {
7208 if {[info exists cached_dtags($id)]} {
7209 return $cached_dtags($id)
7216 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7217 set id [lindex $todo $i]
7219 set ta [info exists hastaggedancestor($id)]
7223 # ignore tags on starting node
7224 if {!$ta && $i > 0} {
7225 if {[info exists idtags($id)]} {
7228 } elseif {[info exists cached_dtags($id)]} {
7229 set tagloc($id) $cached_dtags($id)
7233 foreach a $arcnos($id) {
7235 if {!$ta && $arctags($a) ne {}} {
7237 if {$arctags($a) ne {}} {
7238 lappend tagloc($id) [lindex $arctags($a) end]
7241 if {$ta || $arctags($a) ne {}} {
7242 set tomark [list $d]
7243 for {set j 0} {$j < [llength $tomark]} {incr j} {
7244 set dd [lindex $tomark $j]
7245 if {![info exists hastaggedancestor($dd)]} {
7246 if {[info exists done($dd)]} {
7247 foreach b $arcnos($dd) {
7248 lappend tomark $arcstart($b)
7250 if {[info exists tagloc($dd)]} {
7253 } elseif {[info exists queued($dd)]} {
7256 set hastaggedancestor($dd) 1
7260 if {![info exists queued($d)]} {
7263 if {![info exists hastaggedancestor($d)]} {
7270 foreach id [array names tagloc] {
7271 if {![info exists hastaggedancestor($id)]} {
7272 foreach t $tagloc($id) {
7273 if {[lsearch -exact $tags $t] < 0} {
7279 set t2 [clock clicks -milliseconds]
7282 # remove tags that are descendents of other tags
7283 for {set i 0} {$i < [llength $tags]} {incr i} {
7284 set a [lindex $tags $i]
7285 for {set j 0} {$j < $i} {incr j} {
7286 set b [lindex $tags $j]
7287 set r [anc_or_desc $a $b]
7289 set tags [lreplace $tags $j $j]
7292 } elseif {$r == -1} {
7293 set tags [lreplace $tags $i $i]
7300 if {[array names growing] ne {}} {
7301 # graph isn't finished, need to check if any tag could get
7302 # eclipsed by another tag coming later. Simply ignore any
7303 # tags that could later get eclipsed.
7306 if {[is_certain $t $origid]} {
7310 if {$tags eq $ctags} {
7311 set cached_dtags($origid) $tags
7316 set cached_dtags($origid) $tags
7318 set t3 [clock clicks -milliseconds]
7319 if {0 && $t3 - $t1 >= 100} {
7320 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7321 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7327 global arcnos arcids arcout arcend arctags idtags allparents
7328 global growing cached_atags
7330 if {![info exists allparents($id)]} {
7333 set t1 [clock clicks -milliseconds]
7335 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7336 # part-way along an arc; check that arc first
7337 set a [lindex $arcnos($id) 0]
7338 if {$arctags($a) ne {}} {
7340 set i [lsearch -exact $arcids($a) $id]
7341 foreach t $arctags($a) {
7342 set j [lsearch -exact $arcids($a) $t]
7348 if {![info exists arcend($a)]} {
7352 if {[info exists idtags($id)]} {
7356 if {[info exists cached_atags($id)]} {
7357 return $cached_atags($id)
7365 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7366 set id [lindex $todo $i]
7368 set td [info exists hastaggeddescendent($id)]
7372 # ignore tags on starting node
7373 if {!$td && $i > 0} {
7374 if {[info exists idtags($id)]} {
7377 } elseif {[info exists cached_atags($id)]} {
7378 set tagloc($id) $cached_atags($id)
7382 foreach a $arcout($id) {
7383 if {!$td && $arctags($a) ne {}} {
7385 if {$arctags($a) ne {}} {
7386 lappend tagloc($id) [lindex $arctags($a) 0]
7389 if {![info exists arcend($a)]} continue
7391 if {$td || $arctags($a) ne {}} {
7392 set tomark [list $d]
7393 for {set j 0} {$j < [llength $tomark]} {incr j} {
7394 set dd [lindex $tomark $j]
7395 if {![info exists hastaggeddescendent($dd)]} {
7396 if {[info exists done($dd)]} {
7397 foreach b $arcout($dd) {
7398 if {[info exists arcend($b)]} {
7399 lappend tomark $arcend($b)
7402 if {[info exists tagloc($dd)]} {
7405 } elseif {[info exists queued($dd)]} {
7408 set hastaggeddescendent($dd) 1
7412 if {![info exists queued($d)]} {
7415 if {![info exists hastaggeddescendent($d)]} {
7421 set t2 [clock clicks -milliseconds]
7424 foreach id [array names tagloc] {
7425 if {![info exists hastaggeddescendent($id)]} {
7426 foreach t $tagloc($id) {
7427 if {[lsearch -exact $tags $t] < 0} {
7434 # remove tags that are ancestors of other tags
7435 for {set i 0} {$i < [llength $tags]} {incr i} {
7436 set a [lindex $tags $i]
7437 for {set j 0} {$j < $i} {incr j} {
7438 set b [lindex $tags $j]
7439 set r [anc_or_desc $a $b]
7441 set tags [lreplace $tags $j $j]
7444 } elseif {$r == 1} {
7445 set tags [lreplace $tags $i $i]
7452 if {[array names growing] ne {}} {
7453 # graph isn't finished, need to check if any tag could get
7454 # eclipsed by another tag coming later. Simply ignore any
7455 # tags that could later get eclipsed.
7458 if {[is_certain $origid $t]} {
7462 if {$tags eq $ctags} {
7463 set cached_atags($origid) $tags
7468 set cached_atags($origid) $tags
7470 set t3 [clock clicks -milliseconds]
7471 if {0 && $t3 - $t1 >= 100} {
7472 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7473 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7478 # Return the list of IDs that have heads that are descendents of id,
7479 # including id itself if it has a head.
7480 proc descheads {id} {
7481 global arcnos arcstart arcids archeads idheads cached_dheads
7484 if {![info exists allparents($id)]} {
7488 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7489 # part-way along an arc; check it first
7490 set a [lindex $arcnos($id) 0]
7491 if {$archeads($a) ne {}} {
7492 validate_archeads $a
7493 set i [lsearch -exact $arcids($a) $id]
7494 foreach t $archeads($a) {
7495 set j [lsearch -exact $arcids($a) $t]
7500 set id $arcstart($a)
7506 for {set i 0} {$i < [llength $todo]} {incr i} {
7507 set id [lindex $todo $i]
7508 if {[info exists cached_dheads($id)]} {
7509 set ret [concat $ret $cached_dheads($id)]
7511 if {[info exists idheads($id)]} {
7514 foreach a $arcnos($id) {
7515 if {$archeads($a) ne {}} {
7516 validate_archeads $a
7517 if {$archeads($a) ne {}} {
7518 set ret [concat $ret $archeads($a)]
7522 if {![info exists seen($d)]} {
7529 set ret [lsort -unique $ret]
7530 set cached_dheads($origid) $ret
7531 return [concat $ret $aret]
7534 proc addedtag {id} {
7535 global arcnos arcout cached_dtags cached_atags
7537 if {![info exists arcnos($id)]} return
7538 if {![info exists arcout($id)]} {
7539 recalcarc [lindex $arcnos($id) 0]
7541 catch {unset cached_dtags}
7542 catch {unset cached_atags}
7545 proc addedhead {hid head} {
7546 global arcnos arcout cached_dheads
7548 if {![info exists arcnos($hid)]} return
7549 if {![info exists arcout($hid)]} {
7550 recalcarc [lindex $arcnos($hid) 0]
7552 catch {unset cached_dheads}
7555 proc removedhead {hid head} {
7556 global cached_dheads
7558 catch {unset cached_dheads}
7561 proc movedhead {hid head} {
7562 global arcnos arcout cached_dheads
7564 if {![info exists arcnos($hid)]} return
7565 if {![info exists arcout($hid)]} {
7566 recalcarc [lindex $arcnos($hid) 0]
7568 catch {unset cached_dheads}
7571 proc changedrefs {} {
7572 global cached_dheads cached_dtags cached_atags
7573 global arctags archeads arcnos arcout idheads idtags
7575 foreach id [concat [array names idheads] [array names idtags]] {
7576 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7577 set a [lindex $arcnos($id) 0]
7578 if {![info exists donearc($a)]} {
7584 catch {unset cached_dtags}
7585 catch {unset cached_atags}
7586 catch {unset cached_dheads}
7589 proc rereadrefs {} {
7590 global idtags idheads idotherrefs mainhead
7592 set refids [concat [array names idtags] \
7593 [array names idheads] [array names idotherrefs]]
7594 foreach id $refids {
7595 if {![info exists ref($id)]} {
7596 set ref($id) [listrefs $id]
7599 set oldmainhead $mainhead
7602 set refids [lsort -unique [concat $refids [array names idtags] \
7603 [array names idheads] [array names idotherrefs]]]
7604 foreach id $refids {
7605 set v [listrefs $id]
7606 if {![info exists ref($id)] || $ref($id) != $v ||
7607 ($id eq $oldmainhead && $id ne $mainhead) ||
7608 ($id eq $mainhead && $id ne $oldmainhead)} {
7615 proc listrefs {id} {
7616 global idtags idheads idotherrefs
7619 if {[info exists idtags($id)]} {
7623 if {[info exists idheads($id)]} {
7627 if {[info exists idotherrefs($id)]} {
7628 set z $idotherrefs($id)
7630 return [list $x $y $z]
7633 proc showtag {tag isnew} {
7634 global ctext tagcontents tagids linknum tagobjid
7637 addtohistory [list showtag $tag 0]
7639 $ctext conf -state normal
7642 if {![info exists tagcontents($tag)]} {
7644 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7647 if {[info exists tagcontents($tag)]} {
7648 set text $tagcontents($tag)
7650 set text "Tag: $tag\nId: $tagids($tag)"
7652 appendwithlinks $text {}
7653 $ctext conf -state disabled
7665 global maxwidth maxgraphpct diffopts
7666 global oldprefs prefstop showneartags showlocalchanges
7667 global bgcolor fgcolor ctext diffcolors selectbgcolor
7668 global uifont tabstop
7672 if {[winfo exists $top]} {
7676 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7677 set oldprefs($v) [set $v]
7680 wm title $top "Gitk preferences"
7681 label $top.ldisp -text "Commit list display options"
7682 $top.ldisp configure -font $uifont
7683 grid $top.ldisp - -sticky w -pady 10
7684 label $top.spacer -text " "
7685 label $top.maxwidthl -text "Maximum graph width (lines)" \
7687 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7688 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7689 label $top.maxpctl -text "Maximum graph width (% of pane)" \
7691 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7692 grid x $top.maxpctl $top.maxpct -sticky w
7693 frame $top.showlocal
7694 label $top.showlocal.l -text "Show local changes" -font optionfont
7695 checkbutton $top.showlocal.b -variable showlocalchanges
7696 pack $top.showlocal.b $top.showlocal.l -side left
7697 grid x $top.showlocal -sticky w
7699 label $top.ddisp -text "Diff display options"
7700 $top.ddisp configure -font $uifont
7701 grid $top.ddisp - -sticky w -pady 10
7702 label $top.diffoptl -text "Options for diff program" \
7704 entry $top.diffopt -width 20 -textvariable diffopts
7705 grid x $top.diffoptl $top.diffopt -sticky w
7707 label $top.ntag.l -text "Display nearby tags" -font optionfont
7708 checkbutton $top.ntag.b -variable showneartags
7709 pack $top.ntag.b $top.ntag.l -side left
7710 grid x $top.ntag -sticky w
7711 label $top.tabstopl -text "tabstop" -font optionfont
7712 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7713 grid x $top.tabstopl $top.tabstop -sticky w
7715 label $top.cdisp -text "Colors: press to choose"
7716 $top.cdisp configure -font $uifont
7717 grid $top.cdisp - -sticky w -pady 10
7718 label $top.bg -padx 40 -relief sunk -background $bgcolor
7719 button $top.bgbut -text "Background" -font optionfont \
7720 -command [list choosecolor bgcolor 0 $top.bg background setbg]
7721 grid x $top.bgbut $top.bg -sticky w
7722 label $top.fg -padx 40 -relief sunk -background $fgcolor
7723 button $top.fgbut -text "Foreground" -font optionfont \
7724 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7725 grid x $top.fgbut $top.fg -sticky w
7726 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7727 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7728 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7729 [list $ctext tag conf d0 -foreground]]
7730 grid x $top.diffoldbut $top.diffold -sticky w
7731 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7732 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7733 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7734 [list $ctext tag conf d1 -foreground]]
7735 grid x $top.diffnewbut $top.diffnew -sticky w
7736 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7737 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7738 -command [list choosecolor diffcolors 2 $top.hunksep \
7739 "diff hunk header" \
7740 [list $ctext tag conf hunksep -foreground]]
7741 grid x $top.hunksepbut $top.hunksep -sticky w
7742 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7743 button $top.selbgbut -text "Select bg" -font optionfont \
7744 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7745 grid x $top.selbgbut $top.selbgsep -sticky w
7748 button $top.buts.ok -text "OK" -command prefsok -default active
7749 $top.buts.ok configure -font $uifont
7750 button $top.buts.can -text "Cancel" -command prefscan -default normal
7751 $top.buts.can configure -font $uifont
7752 grid $top.buts.ok $top.buts.can
7753 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7754 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7755 grid $top.buts - - -pady 10 -sticky ew
7756 bind $top <Visibility> "focus $top.buts.ok"
7759 proc choosecolor {v vi w x cmd} {
7762 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7763 -title "Gitk: choose color for $x"]
7764 if {$c eq {}} return
7765 $w conf -background $c
7771 global bglist cflist
7773 $w configure -selectbackground $c
7775 $cflist tag configure highlight \
7776 -background [$cflist cget -selectbackground]
7777 allcanvs itemconf secsel -fill $c
7784 $w conf -background $c
7792 $w conf -foreground $c
7794 allcanvs itemconf text -fill $c
7795 $canv itemconf circle -outline $c
7799 global maxwidth maxgraphpct diffopts
7800 global oldprefs prefstop showneartags showlocalchanges
7802 foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7803 set $v $oldprefs($v)
7805 catch {destroy $prefstop}
7810 global maxwidth maxgraphpct
7811 global oldprefs prefstop showneartags showlocalchanges
7812 global charspc ctext tabstop
7814 catch {destroy $prefstop}
7816 $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7817 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7818 if {$showlocalchanges} {
7824 if {$maxwidth != $oldprefs(maxwidth)
7825 || $maxgraphpct != $oldprefs(maxgraphpct)} {
7827 } elseif {$showneartags != $oldprefs(showneartags)} {
7832 proc formatdate {d} {
7833 global datetimeformat
7835 set d [clock format $d -format $datetimeformat]
7840 # This list of encoding names and aliases is distilled from
7841 # http://www.iana.org/assignments/character-sets.
7842 # Not all of them are supported by Tcl.
7843 set encoding_aliases {
7844 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7845 ISO646-US US-ASCII us IBM367 cp367 csASCII }
7846 { ISO-10646-UTF-1 csISO10646UTF1 }
7847 { ISO_646.basic:1983 ref csISO646basic1983 }
7848 { INVARIANT csINVARIANT }
7849 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7850 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7851 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7852 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7853 { NATS-DANO iso-ir-9-1 csNATSDANO }
7854 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7855 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7856 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7857 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7858 { ISO-2022-KR csISO2022KR }
7860 { ISO-2022-JP csISO2022JP }
7861 { ISO-2022-JP-2 csISO2022JP2 }
7862 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7864 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7865 { IT iso-ir-15 ISO646-IT csISO15Italian }
7866 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7867 { ES iso-ir-17 ISO646-ES csISO17Spanish }
7868 { greek7-old iso-ir-18 csISO18Greek7Old }
7869 { latin-greek iso-ir-19 csISO19LatinGreek }
7870 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7871 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7872 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7873 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7874 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7875 { BS_viewdata iso-ir-47 csISO47BSViewdata }
7876 { INIS iso-ir-49 csISO49INIS }
7877 { INIS-8 iso-ir-50 csISO50INIS8 }
7878 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7879 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7880 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7881 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7882 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7883 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7885 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7886 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7887 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7888 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7889 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7890 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7891 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7892 { greek7 iso-ir-88 csISO88Greek7 }
7893 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7894 { iso-ir-90 csISO90 }
7895 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7896 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7897 csISO92JISC62991984b }
7898 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7899 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7900 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7901 csISO95JIS62291984handadd }
7902 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7903 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7904 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7905 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7907 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7908 { T.61-7bit iso-ir-102 csISO102T617bit }
7909 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7910 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7911 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7912 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7913 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7914 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7915 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7916 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7917 arabic csISOLatinArabic }
7918 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7919 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7920 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7921 greek greek8 csISOLatinGreek }
7922 { T.101-G2 iso-ir-128 csISO128T101G2 }
7923 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7925 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7926 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7927 { CSN_369103 iso-ir-139 csISO139CSN369103 }
7928 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7929 { ISO_6937-2-add iso-ir-142 csISOTextComm }
7930 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7931 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7932 csISOLatinCyrillic }
7933 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7934 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7935 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7936 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7937 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7938 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7939 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7940 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7941 { ISO_10367-box iso-ir-155 csISO10367Box }
7942 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7943 { latin-lap lap iso-ir-158 csISO158Lap }
7944 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7945 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7948 { JIS_X0201 X0201 csHalfWidthKatakana }
7949 { KSC5636 ISO646-KR csKSC5636 }
7950 { ISO-10646-UCS-2 csUnicode }
7951 { ISO-10646-UCS-4 csUCS4 }
7952 { DEC-MCS dec csDECMCS }
7953 { hp-roman8 roman8 r8 csHPRoman8 }
7954 { macintosh mac csMacintosh }
7955 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7957 { IBM038 EBCDIC-INT cp038 csIBM038 }
7958 { IBM273 CP273 csIBM273 }
7959 { IBM274 EBCDIC-BE CP274 csIBM274 }
7960 { IBM275 EBCDIC-BR cp275 csIBM275 }
7961 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7962 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7963 { IBM280 CP280 ebcdic-cp-it csIBM280 }
7964 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7965 { IBM284 CP284 ebcdic-cp-es csIBM284 }
7966 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7967 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7968 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7969 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7970 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7971 { IBM424 cp424 ebcdic-cp-he csIBM424 }
7972 { IBM437 cp437 437 csPC8CodePage437 }
7973 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7974 { IBM775 cp775 csPC775Baltic }
7975 { IBM850 cp850 850 csPC850Multilingual }
7976 { IBM851 cp851 851 csIBM851 }
7977 { IBM852 cp852 852 csPCp852 }
7978 { IBM855 cp855 855 csIBM855 }
7979 { IBM857 cp857 857 csIBM857 }
7980 { IBM860 cp860 860 csIBM860 }
7981 { IBM861 cp861 861 cp-is csIBM861 }
7982 { IBM862 cp862 862 csPC862LatinHebrew }
7983 { IBM863 cp863 863 csIBM863 }
7984 { IBM864 cp864 csIBM864 }
7985 { IBM865 cp865 865 csIBM865 }
7986 { IBM866 cp866 866 csIBM866 }
7987 { IBM868 CP868 cp-ar csIBM868 }
7988 { IBM869 cp869 869 cp-gr csIBM869 }
7989 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7990 { IBM871 CP871 ebcdic-cp-is csIBM871 }
7991 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7992 { IBM891 cp891 csIBM891 }
7993 { IBM903 cp903 csIBM903 }
7994 { IBM904 cp904 904 csIBBM904 }
7995 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7996 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7997 { IBM1026 CP1026 csIBM1026 }
7998 { EBCDIC-AT-DE csIBMEBCDICATDE }
7999 { EBCDIC-AT-DE-A csEBCDICATDEA }
8000 { EBCDIC-CA-FR csEBCDICCAFR }
8001 { EBCDIC-DK-NO csEBCDICDKNO }
8002 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8003 { EBCDIC-FI-SE csEBCDICFISE }
8004 { EBCDIC-FI-SE-A csEBCDICFISEA }
8005 { EBCDIC-FR csEBCDICFR }
8006 { EBCDIC-IT csEBCDICIT }
8007 { EBCDIC-PT csEBCDICPT }
8008 { EBCDIC-ES csEBCDICES }
8009 { EBCDIC-ES-A csEBCDICESA }
8010 { EBCDIC-ES-S csEBCDICESS }
8011 { EBCDIC-UK csEBCDICUK }
8012 { EBCDIC-US csEBCDICUS }
8013 { UNKNOWN-8BIT csUnknown8BiT }
8014 { MNEMONIC csMnemonic }
8019 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8020 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8021 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8022 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8023 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8024 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8025 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8026 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8027 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8028 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8029 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8030 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8031 { IBM1047 IBM-1047 }
8032 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8033 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8034 { UNICODE-1-1 csUnicode11 }
8037 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8038 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8040 { ISO-8859-15 ISO_8859-15 Latin-9 }
8041 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8042 { GBK CP936 MS936 windows-936 }
8043 { JIS_Encoding csJISEncoding }
8044 { Shift_JIS MS_Kanji csShiftJIS }
8045 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8047 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8048 { ISO-10646-UCS-Basic csUnicodeASCII }
8049 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8050 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8051 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8052 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8053 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8054 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8055 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8056 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8057 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8058 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8059 { Adobe-Standard-Encoding csAdobeStandardEncoding }
8060 { Ventura-US csVenturaUS }
8061 { Ventura-International csVenturaInternational }
8062 { PC8-Danish-Norwegian csPC8DanishNorwegian }
8063 { PC8-Turkish csPC8Turkish }
8064 { IBM-Symbols csIBMSymbols }
8065 { IBM-Thai csIBMThai }
8066 { HP-Legal csHPLegal }
8067 { HP-Pi-font csHPPiFont }
8068 { HP-Math8 csHPMath8 }
8069 { Adobe-Symbol-Encoding csHPPSMath }
8070 { HP-DeskTop csHPDesktop }
8071 { Ventura-Math csVenturaMath }
8072 { Microsoft-Publishing csMicrosoftPublishing }
8073 { Windows-31J csWindows31J }
8078 proc tcl_encoding {enc} {
8079 global encoding_aliases
8080 set names [encoding names]
8081 set lcnames [string tolower $names]
8082 set enc [string tolower $enc]
8083 set i [lsearch -exact $lcnames $enc]
8085 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8086 if {[regsub {^iso[-_]} $enc iso encx]} {
8087 set i [lsearch -exact $lcnames $encx]
8091 foreach l $encoding_aliases {
8092 set ll [string tolower $l]
8093 if {[lsearch -exact $ll $enc] < 0} continue
8094 # look through the aliases for one that tcl knows about
8096 set i [lsearch -exact $lcnames $e]
8098 if {[regsub {^iso[-_]} $e iso ex]} {
8099 set i [lsearch -exact $lcnames $ex]
8108 return [lindex $names $i]
8115 set diffopts "-U 5 -p"
8116 set wrcomcmd "git diff-tree --stdin -p --pretty"
8120 set gitencoding [exec git config --get i18n.commitencoding]
8122 if {$gitencoding == ""} {
8123 set gitencoding "utf-8"
8125 set tclencoding [tcl_encoding $gitencoding]
8126 if {$tclencoding == {}} {
8127 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8130 set mainfont {Helvetica 9}
8131 set textfont {Courier 9}
8132 set uifont {Helvetica 9 bold}
8134 set findmergefiles 0
8142 set cmitmode "patch"
8143 set wrapcomment "none"
8147 set showlocalchanges 1
8148 set datetimeformat "%Y-%m-%d %H:%M:%S"
8150 set colors {green red blue magenta darkgrey brown orange}
8153 set diffcolors {red "#00a000" blue}
8155 set selectbgcolor gray85
8157 catch {source ~/.gitk}
8159 font create optionfont -family sans-serif -size -12
8161 # check that we can find a .git directory somewhere...
8162 if {[catch {set gitdir [gitdir]}]} {
8163 show_error {} . "Cannot find a git repository here."
8166 if {![file isdirectory $gitdir]} {
8167 show_error {} . "Cannot find the git directory \"$gitdir\"."
8172 set cmdline_files {}
8177 "-d" { set datemode 1 }
8179 set cmdline_files [lrange $argv [expr {$i + 1}] end]
8183 lappend revtreeargs $arg
8189 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8190 # no -- on command line, but some arguments (other than -d)
8192 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8193 set cmdline_files [split $f "\n"]
8194 set n [llength $cmdline_files]
8195 set revtreeargs [lrange $revtreeargs 0 end-$n]
8196 # Unfortunately git rev-parse doesn't produce an error when
8197 # something is both a revision and a filename. To be consistent
8198 # with git log and git rev-list, check revtreeargs for filenames.
8199 foreach arg $revtreeargs {
8200 if {[file exists $arg]} {
8201 show_error {} . "Ambiguous argument '$arg': both revision\
8207 # unfortunately we get both stdout and stderr in $err,
8208 # so look for "fatal:".
8209 set i [string first "fatal:" $err]
8211 set err [string range $err [expr {$i + 6}] end]
8213 show_error {} . "Bad arguments to gitk:\n$err"
8218 set nullid "0000000000000000000000000000000000000000"
8219 set nullid2 "0000000000000000000000000000000000000001"
8227 set highlight_paths {}
8228 set searchdirn -forwards
8232 set markingmatches 0
8233 set linkentercount 0
8234 set need_redisplay 0
8240 set selectedhlview None
8249 set lookingforhead 0
8255 # wait for the window to become visible
8257 wm title . "[file tail $argv0]: [file tail [pwd]]"
8260 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8261 # create a view for the files/dirs specified on the command line
8265 set viewname(1) "Command line"
8266 set viewfiles(1) $cmdline_files
8267 set viewargs(1) $revtreeargs
8270 .bar.view entryconf Edit* -state normal
8271 .bar.view entryconf Delete* -state normal
8274 if {[info exists permviews]} {
8275 foreach v $permviews {
8278 set viewname($n) [lindex $v 0]
8279 set viewfiles($n) [lindex $v 1]
8280 set viewargs($n) [lindex $v 2]